@ -7,7 +7,7 @@
# (C) 2023
#
# @@ Meta Begin
# Application punk::console 0.7.2
# Application punk::console 0.8.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
@ -17,7 +17,7 @@
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::console 0 0.7.2 ]
#[manpage_begin punkshell_module_punk::console 0 0.8.0 ]
#[copyright "2024"]
#[titledesc {punk console}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk console}] [comment {-- Description at end of page heading --}]
@ -5746,6 +5746,599 @@ namespace eval punk::console::check {
}
namespace eval punk::console::system {
#-------------------------------------------------------------------------------------
#G-106: powershell console-mode fallback (raw mode for twapi-less windows runtimes)
#A persistent powershell/pwsh named-pipe server process, shared process-wide via tsv,
#flips the console's line/echo input flags on request (the flags live on the console
#object, so a sibling process attached to the same console can set them for us).
#Started lazily on first use (loading punk::console in a piped/non-console or
#worker-thread context must not spawn processes or emit noise); the server watches this
#process's pid and exits with it, so no orphan pwsh processes are left behind.
#Quiet by default - set env PUNK_PS_CONSOLEMODE_DEBUG=1 for diagnostics on both sides.
#-------------------------------------------------------------------------------------
#module location captured at load time - [info script] is empty later at call time,
#and ::argv0 is absent in secondary threads.
variable module_dir ""
catch {
set module_dir [file dirname [file normalize [info script]]]
}
#Embedded copy of scriptlib/utils/pwsh/consolemode_server_async.ps1 (the canonical
#maintained file) - the last-resort script source so the fallback works from kits and
#unusual cwds with no scriptlib on disk. Leading/trailing whitespace is insignificant
#(the text is delivered to powershell via -c). Keep in sync with the canonical file -
#the console testsuite (psfallback.test) compares them.
variable ps_consolemode_script_embedded {
#!SEMICOLONS must be placed after each command as scriptdata needs to be sent to powershell directly with the -c parameter!
;
# consolemode_server_async.ps1 - punkshell console-mode fallback server (canonical copy) (G-106)
# Persistent named-pipe server used by punk::console when twapi is absent on windows.
# The Tcl side (punk::console::system) resolves this file - or falls back to its embedded copy - and launches:
# pwsh|powershell -nop -nol -noni -c <this text with the <punkshell_*> placeholders substituted>
# The -c (command string) mechanism is deliberate: it needs no script file at run time (kits) and is not
# subject to ExecutionPolicy restrictions that can block -File runs.
# The server process shares the launching process's console; it must NOT have its stdin redirected
# (the console input handle is how it reaches the console), and it never reads stdin.
# Placeholders (each overridable by a positional arg for standalone debug runs):
# <punkshell_consoleid> $args[0] unique id suffix for the pipe name
# <punkshell_parentpid> $args[1] pid of the owning tcl process; the server exits when it does
# <punkshell_psdebug> $args[2] "1" enables diagnostic write-host output (default silent)
# Standalone debug run example (from this directory):
# pwsh -nop -nol -f consolemode_server_async.ps1 test1 0 1
# Protocol (one line per named-pipe connection): enableraw | disableraw | ping | exit
# MAINTENANCE: src/modules/punk/console-0.8.0.tm carries this file's text as
# punk::console::system::ps_consolemode_script_embedded (the last-resort resolution for kits and
# unusual cwds). Keep the two in sync - the console testsuite (psfallback.test) fails when they diverge.
;
# The NativeConsoleMethods C# snippet below derives from posh-git (github.com/dahlbyk/posh-git):
# Copyright (c) 2010-2018 Keith Dahlby, Keith Hill, and contributors - MIT license.
# Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
# The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;
if ($PSVersionTable.PSVersion.Major -le 5) {
# For Windows PowerShell, we want to remove any PowerShell 7 paths from PSModulePath
#snipped from https://github.com/PowerShell/DSC/pull/777/commits/af9b99a4d38e0cf1e54c4bbd89cbb6a8a8598c4e
;
$env:PSModulePath = ($env:PSModulePath -split ';' | Where-Object { $_ -notlike '*\powershell\*' }) -join ';';
};
$consoleModeSource = @"
using System;
using System.Runtime.InteropServices;
public class NativeConsoleMethods
{
[DllImport("kernel32.dll", CharSet = CharSet.Unicode, SetLastError = true)]
public static extern IntPtr GetStdHandle(int handleId);
[DllImport("kernel32.dll", CharSet = CharSet.Unicode, SetLastError = true)]
public static extern bool GetConsoleMode(IntPtr hConsoleOutput, out uint dwMode);
[DllImport("kernel32.dll", CharSet = CharSet.Unicode, SetLastError = true)]
public static extern bool SetConsoleMode(IntPtr hConsoleOutput, uint dwMode);
public static uint GetConsoleMode(bool input = false)
{
var handle = GetStdHandle(input ? -10 : -11);
uint mode;
if (GetConsoleMode(handle, out mode))
{
return mode;
}
return 0xffffffff;
}
public static uint SetConsoleMode(bool input, uint mode)
{
var handle = GetStdHandle(input ? -10 : -11);
if (SetConsoleMode(handle, mode))
{
return GetConsoleMode(input);
}
return 0xffffffff;
}
}
"@
;
[Flags()]
enum ConsoleModeInputFlags
{
ENABLE_PROCESSED_INPUT = 0x0001
ENABLE_LINE_INPUT = 0x0002
ENABLE_ECHO_INPUT = 0x0004
ENABLE_WINDOW_INPUT = 0x0008
ENABLE_MOUSE_INPUT = 0x0010
ENABLE_INSERT_MODE = 0x0020
ENABLE_QUICK_EDIT_MODE = 0x0040
ENABLE_EXTENDED_FLAGS = 0x0080
ENABLE_AUTO_POSITION = 0x0100
ENABLE_VIRTUAL_TERMINAL_INPUT = 0x0200
};
if (!('NativeConsoleMethods' -as [System.Type])) {
Add-Type $consoleModeSource
};
function rawmode {
param (
[validateSet('enable', 'disable')]
[string]$Action
);
if (!('NativeConsoleMethods' -as [System.Type])) {
Add-Type $consoleModeSource
};
$inputFlags = [NativeConsoleMethods]::GetConsoleMode($true);
$resultflags = $inputflags;
if (($inputflags -band [ConsoleModeInputFlags]::ENABLE_LINE_INPUT) -eq [ConsoleModeInputFlags]::ENABLE_LINE_INPUT) {
#cooked mode
$initialstate = "cooked";
if ($action -eq "enable") {
#disable cooked flags
$disable = [uint32](-bnot [uint32][ConsoleModeInputFlags]::ENABLE_LINE_INPUT) -band ( -bnot [uint32][ConsoleModeInputFlags]::ENABLE_ECHO_INPUT);
$adjustedflags = $inputflags -band ($disable);
$resultflags = [NativeConsoleMethods]::SetConsoleMode($true,$adjustedflags);
};
} else {
#raw mode
$initialstate = "raw";
if ($action -eq "disable") {
#set cooked flags
$adjustedflags = $inputflags -bor [ConsoleModeInputFlags]::ENABLE_LINE_INPUT -bor [ConsoleModeInputFlags]::ENABLE_ECHO_INPUT;
$resultflags = [NativeConsoleMethods]::SetConsoleMode($true,$adjustedflags);
};
};
};
$consoleid = $args[0];
if ([string]::IsNullOrEmpty($consoleid)) {
$consoleid = "<punkshell_consoleid>"
};
$parentpidraw = $args[1];
if ([string]::IsNullOrEmpty($parentpidraw)) {
$parentpidraw = "<punkshell_parentpid>"
};
$psdebugraw = $args[2];
if ([string]::IsNullOrEmpty($psdebugraw)) {
$psdebugraw = "<punkshell_psdebug>"
};
$psdebug = ($psdebugraw -eq "1");
$pipeName = "punkshell_ps_consolemode_$consoleid";
function dbg {
param([string]$m);
if ($psdebug) {
write-host "consolemode_server($pipeName): $m"
};
};
dbg "starting - parentpidraw: $parentpidraw";
# Parent-process watch: hold a Process object obtained once by pid (handle-based, so immune to
# pid reuse) and poll HasExited in the main loop. This is the orphan-prevention guarantee - the
# owning tcl process does not need to send exit for this server to go away (G-106).
# An unparseable/zero parent pid (e.g a standalone run with placeholders unsubstituted) disables the watch.
$parentproc = $null;
[int]$parentpidnum = 0;
if ([int]::TryParse($parentpidraw, [ref]$parentpidnum) -and ($parentpidnum -gt 0)) {
try {
$parentproc = [System.Diagnostics.Process]::GetProcessById($parentpidnum);
} catch {
dbg "parent process $parentpidnum not found - exiting";
exit 1;
};
};
$sharedData = [hashtable]::Synchronized(@{});
$scriptblock = {
param($tsv);
Add-Type -AssemblyName System.IO.Pipes;
$keepgoing = $true;
while ($keepgoing) {
$pipeServer = $null;
try {
$pipeServer = New-Object System.IO.Pipes.NamedPipeServerStream($pipeName);
try {
$pipeServer.WaitForConnection();
$reader = New-Object System.IO.StreamReader($pipeServer);
$message = $reader.ReadLine();
if ($message -eq "exit") {
$tsv.State = "done";
[void]$msync.Set();
$keepgoing = $false;
} elseif (($message -eq "enableraw") -or ($message -eq "disableraw")) {
$tsv.Message = $message;
[void]$msync.Set();
} elseif ($message -eq "ping") {
# liveness probe - wake the main loop, no mode action
;
[void]$msync.Set();
};
# A null message (a connection that closed without sending a line - e.g a probe)
# and unknown messages are ignored; only an explicit exit message or
# parent-process death shuts the server down.
# Do NOT Close/Dispose the StreamReader here: that disposes the underlying pipe
# stream and a subsequent Disconnect/Dispose on it throws, killing this listener.
# Disposing the pipe stream (finally below) is the whole per-connection cleanup.
} finally {
if ($null -ne $pipeServer) {
$pipeServer.Dispose();
};
};
} catch {
# unexpected listener failure (e.g pipe name already in use) - shut down rather than spin
;
$tsv.State = "done";
[void]$msync.Set();
$keepgoing = $false;
};
};
};
$exitcode = 0;
try {
# AutoResetEvent: WaitOne consumes the signal atomically, so a Set that lands while the main
# loop is servicing a message is never lost (the next WaitOne returns immediately).
$syncEvent = New-Object System.Threading.AutoResetEvent($false);
$runspace = [runspacefactory]::CreateRunspace();
[void]$runspace.Open();
$runspace.SessionStateProxy.SetVariable("pipeName", $pipeName);
$runspace.SessionStateProxy.SetVariable("msync", $syncEvent);
$powershell = [System.Management.Automation.PowerShell]::Create();
$powershell.Runspace = $runspace;
[void]$powershell.Addscript($scriptblock).AddArgument($sharedData);
$sharedData.State = "running";
$sharedData.Message = "";
$asyncResult = $powershell.BeginInvoke();
dbg "named pipe server started in runspace";
while ($true) {
[void]$syncEvent.WaitOne(5000);
$msg = $sharedData.Message;
$sharedData.Message = "";
if ($msg -eq "enableraw") {
dbg "enableraw";
$null = rawmode 'enable';
} elseif ($msg -eq "disableraw") {
dbg "disableraw";
$null = rawmode 'disable';
};
if ($sharedData.State -eq "done") {
dbg "exit message received";
break;
};
if (($null -ne $parentproc) -and $parentproc.HasExited) {
dbg "parent process $parentpidnum has exited";
break;
};
};
} finally {
# The listener runspace may be parked in WaitForConnection - connect once and send exit to
# unblock it, otherwise the process could linger on a parked runspace thread. Skipped when
# the listener already shut itself down (State done - it exited on an exit message or error).
if ($sharedData.State -ne "done") {
try {
$cli = New-Object System.IO.Pipes.NamedPipeClientStream($pipeName);
$cli.connect(1000);
$writer = new-object System.IO.StreamWriter($cli);
$writer.writeline("exit");
$writer.flush();
$cli.Dispose();
} catch {
dbg "listener unblock skipped: $($PSItem.Exception.Message)";
};
};
try {
if ($null -ne $runspace) {
$runspace.Close();
$runspace.Dispose();
};
} catch {
dbg "runspace tidyup error: $($PSItem.Exception.Message)";
};
try {
if ($null -ne $powershell) {
$powershell.dispose();
};
} catch {
dbg "powershell tidyup error: $($PSItem.Exception.Message)";
};
};
dbg "shutdown complete";
exit $exitcode;
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::console::system::ps_consolemode_script_get
@cmd -name "punk::console::system::ps_consolemode_script_get"\
-summary\
"Resolve the powershell console-mode fallback server script text."\
-help\
"Resolves the consolemode_server_async.ps1 script text used by the
twapi-less windows raw-mode fallback (G-106).
Resolution order: PUNK_PS_CONSOLEMODE_SCRIPT env override (used only
when the named file exists), the argv0-derived project location, then
module-location-derived project locations, then the embedded copy
carried by this module (so kits and unusual cwds always resolve).
Returns a dict with keys: source (env|scriptlib|embedded), path (empty
string for embedded) and contents (raw script text with <punkshell_*>
placeholders unsubstituted)."
}]
lappend PUNKARGS [list {
@id -id ::punk::console::system::ps_consolemode_server_ensure
@cmd -name "punk::console::system::ps_consolemode_server_ensure"\
-summary\
"Ensure the process-wide powershell console-mode server is started."\
-help\
"Ensures a single persistent powershell console-mode server process
exists for this tcl process (windows only). Server identity is shared
across all interps/threads via tsv punk_console ps_server_* entries;
the first caller spawns (pwsh.exe preferred, powershell.exe fallback),
later callers reuse. The server is passed this process's pid and exits
when this process does.
Returns a dict: ok (0|1), and on ok=1 pipename, pid, spawntime
(ms clock) and just_started (1 when this call spawned the server);
on ok=0 an error key describes why."
}]
lappend PUNKARGS [list {
@id -id ::punk::console::system::ps_consolemode_send
@cmd -name "punk::console::system::ps_consolemode_send"\
-summary\
"Send a command to the powershell console-mode server."\
-help\
"Sends one protocol message (enableraw|disableraw|ping|exit) to the
powershell console-mode server, ensuring the server first (spawning it
if required). Connection attempts retry until the deadline - a freshly
spawned server is given a generous window for powershell startup. If
the recorded server proves unreachable the recorded state is cleared
and one respawn is attempted.
Returns a dict: ok (0|1), and on failure an error key."
@opts
-deadlinems -type integer -optional 1 -help\
"Override the per-attempt connection deadline in milliseconds.
Default: 15000 within 15s of server spawn (powershell startup),
2500 thereafter."
@values -min 1 -max 1
msg -type string -help\
"Protocol message: enableraw, disableraw, ping or exit."
}]
lappend PUNKARGS [list {
@id -id ::punk::console::system::ps_consolemode_server_stop
@cmd -name "punk::console::system::ps_consolemode_server_stop"\
-summary\
"Stop the recorded powershell console-mode server, if any."\
-help\
"Best-effort shutdown of the recorded powershell console-mode server:
sends the exit protocol message (short deadline, no respawn) and clears
the recorded tsv state. Not required for orphan prevention - the server
watches this process's pid and exits with it - but useful for tests and
for releasing the server early.
Returns a dict: ok 1, stopped (1 if the exit message was delivered),
and pipename (when a server was recorded)."
}]
}
proc ps_consolemode_script_get {} {
#G-106 - see PUNKARGS definition for behaviour contract
variable module_dir
variable ps_consolemode_script_embedded
set relpath scriptlib/utils/pwsh/consolemode_server_async.ps1
set candidates [list]
if {[info exists ::env(PUNK_PS_CONSOLEMODE_SCRIPT)] && $::env(PUNK_PS_CONSOLEMODE_SCRIPT) ne ""} {
#explicit dev/test override - falls through if the named file is missing
lappend candidates [list env $::env(PUNK_PS_CONSOLEMODE_SCRIPT)]
}
if {[info exists ::argv0] && $::argv0 ne ""} {
#argv0 grandparent as project root: covers src/make.tcl (repo root) and bin/<kit> launches
lappend candidates [list scriptlib [file dirname [file dirname [file normalize $::argv0]]]/$relpath]
}
if {$module_dir ne ""} {
#module in <project>/modules/punk -> project root is 2 up
#module in <project>/src/modules/punk -> project root is 3 up
#(a zipfs kit module path simply fails the file-exists probes)
lappend candidates [list scriptlib [file dirname [file dirname $module_dir]]/$relpath]
lappend candidates [list scriptlib [file dirname [file dirname [file dirname $module_dir]]]/$relpath]
}
foreach cand $candidates {
lassign $cand source path
if {[file exists $path]} {
set readok [expr {![catch {
set fd [open $path r]
chan configure $fd -translation binary
set contents [read $fd]
close $fd
}]}]
if {$readok} {
return [dict create source $source path $path contents $contents]
}
}
}
return [dict create source embedded path "" contents $ps_consolemode_script_embedded]
}
proc ps_consolemode_server_ensure {} {
#G-106 - see PUNKARGS definition for behaviour contract
if {"windows" ne $::tcl_platform(platform)} {
return [dict create ok 0 just_started 0 error "powershell consolemode server is windows-only"]
}
#fast path - another interp/thread (or an earlier call) already started the server
if {[tsv::exists punk_console ps_server_pipename]} {
set result [dict create ok 1 just_started 0]
dict set result pipename [tsv::get punk_console ps_server_pipename]
dict set result pid [tsv::get punk_console ps_server_pid]
dict set result spawntime [tsv::get punk_console ps_server_spawntime]
return $result
}
set ps_cmd [auto_execok pwsh.exe]
if {$ps_cmd eq ""} {
set ps_cmd [auto_execok powershell.exe]
}
if {$ps_cmd eq ""} {
return [dict create ok 0 just_started 0 error "neither pwsh.exe nor powershell.exe found on PATH"]
}
set scriptinfo [::punk::console::system::ps_consolemode_script_get]
set psdebug 0
if {[info exists ::env(PUNK_PS_CONSOLEMODE_DEBUG)] && $::env(PUNK_PS_CONSOLEMODE_DEBUG) ni [list "" 0]} {
set psdebug 1
}
set spawned 0
set spawn_error ""
set pipename ""
set spawnpid ""
set spawntime 0
tsv::lock punk_console {
if {[tsv::exists punk_console ps_server_pipename]} {
#another thread won the race
set pipename [tsv::get punk_console ps_server_pipename]
set spawnpid [tsv::get punk_console ps_server_pid]
set spawntime [tsv::get punk_console ps_server_spawntime]
} else {
set ps_consoleid [pid]-[expr {int(999999 * rand())+1}]
set contents [string map [list <punkshell_consoleid> $ps_consoleid <punkshell_parentpid> [pid] <punkshell_psdebug> $psdebug] [dict get $scriptinfo contents]]
set pipename {\\.\pipe\punkshell_ps_consolemode_}
append pipename $ps_consoleid
#stdin must stay inherited - the console input handle is how the server reaches
#the console. stdout/stderr are silenced unless debugging.
if {$psdebug} {
puts stderr "punk::console: starting persistent powershell consolemode server pipename: $pipename (script source: [dict get $scriptinfo source] [dict get $scriptinfo path])"
set spawncatch [catch {exec {*}$ps_cmd -nop -nol -noni -c $contents &} spawnresult]
} else {
set spawncatch [catch {exec {*}$ps_cmd -nop -nol -noni -c $contents > NUL 2> NUL &} spawnresult]
}
if {$spawncatch} {
set spawn_error $spawnresult
} else {
set spawnpid [lindex $spawnresult 0]
set spawntime [clock milliseconds]
tsv::set punk_console ps_server_pipename $pipename
tsv::set punk_console ps_server_pid $spawnpid
tsv::set punk_console ps_server_spawntime $spawntime
set spawned 1
}
}
}
if {$spawn_error ne ""} {
return [dict create ok 0 just_started 0 error "failed to launch powershell consolemode server: $spawn_error"]
}
set result [dict create ok 1 just_started $spawned]
dict set result pipename $pipename
dict set result pid $spawnpid
dict set result spawntime $spawntime
return $result
}
proc ps_consolemode_send {msg args} {
#G-106 - see PUNKARGS definition for behaviour contract
#manual args parsing - called on raw enable/disable paths
set opt_deadlinems ""
foreach {k v} $args {
switch -- $k {
-deadlinems {
set opt_deadlinems $v
}
default {
error "ps_consolemode_send unknown option '$k' - known options: -deadlinems"
}
}
}
set ensure [::punk::console::system::ps_consolemode_server_ensure]
if {![dict get $ensure ok]} {
return [dict create ok 0 error [dict get $ensure error]]
}
set attempt 0
set errMsg ""
while 1 {
incr attempt
set deadlinems $opt_deadlinems
if {$deadlinems eq ""} {
#a freshly spawned server (from this call or another interp moments ago) can take
#seconds to begin listening (powershell startup) - allow for it
set age [expr {[clock milliseconds] - [dict get $ensure spawntime]}]
if {$age < 15000} {
set deadlinems 15000
} else {
set deadlinems 2500
}
}
set pipename [dict get $ensure pipename]
set endtime [expr {[clock milliseconds] + $deadlinems}]
while {[clock milliseconds] < $endtime} {
set ok_write 0
if {![catch {open $pipename w} pipe]} {
if {![catch {
chan configure $pipe -buffering line
puts -nonewline $pipe "$msg\r\n"
close $pipe
} errMsg]} {
set ok_write 1
} else {
catch {close $pipe}
}
} else {
set errMsg $pipe
}
if {$ok_write} {
return [dict create ok 1 attempt $attempt]
}
after 100
}
if {$attempt >= 2} {
return [dict create ok 0 error "failed to reach powershell consolemode server on $pipename: $errMsg"]
}
#the recorded server may be stale (e.g killed externally) - clear the recorded state
#(only if it still names the pipe we tried) and respawn once
tsv::lock punk_console {
if {[tsv::exists punk_console ps_server_pipename] && [tsv::get punk_console ps_server_pipename] eq $pipename} {
tsv::unset punk_console ps_server_pipename
tsv::unset punk_console ps_server_pid
tsv::unset punk_console ps_server_spawntime
}
}
set ensure [::punk::console::system::ps_consolemode_server_ensure]
if {![dict get $ensure ok]} {
return [dict create ok 0 error [dict get $ensure error]]
}
}
}
proc ps_consolemode_server_stop {} {
#G-106 - see PUNKARGS definition for behaviour contract
if {![tsv::exists punk_console ps_server_pipename]} {
return [dict create ok 1 stopped 0 note "no powershell consolemode server recorded"]
}
set pipename [tsv::get punk_console ps_server_pipename]
#deliberately not via ps_consolemode_send - that would respawn an unreachable server
set sent 0
set endtime [expr {[clock milliseconds] + 1000}]
while {[clock milliseconds] < $endtime} {
if {![catch {open $pipename w} pipe]} {
if {![catch {
chan configure $pipe -buffering line
puts -nonewline $pipe "exit\r\n"
close $pipe
}]} {
set sent 1
break
} else {
catch {close $pipe}
}
}
after 100
}
tsv::lock punk_console {
if {[tsv::exists punk_console ps_server_pipename] && [tsv::get punk_console ps_server_pipename] eq $pipename} {
tsv::unset punk_console ps_server_pipename
tsv::unset punk_console ps_server_pid
tsv::unset punk_console ps_server_spawntime
}
}
return [dict create ok 1 stopped $sent pipename $pipename]
}
proc enableRaw_stty {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
@ -5917,67 +6510,56 @@ namespace eval punk::console::system {
}
proc enableRaw_powershell {{channel stdin}} {
#enableRaw_powershell is a fallback for when twapi is not present.
#It uses a persistent powershell process to set the console mode to raw, by writing commands to a named pipe that the powershell process is listening on.
#This does not need to be used in windows in the rare case where the console is an alternative terminal that supports stty (e.g mintty without winpty)
#- but it is really intended for use in environments where twapi is not present and stty doesn't work (e.g standard windows console).
#puts stderr "punk::console::enableRaw"
#enableRaw_powershell is a fallback for when twapi is not present (G-106).
#It asks the persistent powershell console-mode server (started lazily on first use,
#shared process-wide via tsv, self-terminating with this process - see
#punk::console::system::ps_consolemode_server_ensure) to clear the console's
#line/echo input flags. The channel argument is unused by the server path - the
#server acts on the process console's input handle.
#stty remains as a last resort: it does not *usually* work on windows
#(the msys/cygwin stty is a subprocess - useful to retrieve info but generally unable
#to affect the calling process/console). An exception is an msys/cygwin terminal such
#as mintty configured without winpty (e.g env MSYS = disable_pcon prior to launch).
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
upvar ::punk::console::ps_consolemode_contents ps_consolemode_contents
upvar ::punk::console::ps_pipename ps_pipename
if {[info exists ps_consolemode_contents]} {
#ps_pipename e.g \\.\pipe\punkwinshell_ps_consolemode_12345-1223456
set trynum 0
set wrote 0
while {$trynum < 5} {
incr trynum
if {![catch {
set pipe [open $ps_pipename w]
} errMsg]} {
chan conf $pipe -buffering line
puts -nonewline $pipe "enableraw\r\n"
#flush $pipe
#after 10
#close $pipe
set wrote 1
break
} else {
after 100
if {"windows" eq $::tcl_platform(platform)} {
set sendresult [::punk::console::system::ps_consolemode_send enableraw]
if {[dict get $sendresult ok]} {
tsv::set punk_console is_raw 1
#the server applies the console flags asynchronously (fire-and-forget protocol).
#Where the runtime can read the live mode (tcl9 -inputmode on a console channel),
#wait briefly for the flip so callers can rely on raw being active on return.
set confirmed unknown
if {[dict exists [chan configure $channel] -inputmode]} {
set confirmed 0
set endtime [expr {[clock milliseconds] + 750}]
while {[clock milliseconds] < $endtime} {
if {[dict get [chan configure $channel] -inputmode] eq "raw"} {
set confirmed 1
break
}
after 25
}
}
return [list $channel [list from unknown to raw note "set via powershell consolemode server (confirmed $confirmed)"]]
}
if {$wrote} {
tsv::set punk_console is_raw 1
#after 100
close $pipe
} else {
puts stderr "write to $ps_pipename failed trynum: $trynum\n$errMsg"
}
} elseif {[set sttycmd [auto_execok stty]] ne ""} {
#todo - something else entirely
#this approach does not *usually* work on windows
#the msys/cygwin stty command is launched as a subprocess - can be used to retrieve info
# but seems to be useless as far as affecting the calling process/console
#An exception is when running in an msys/cygwin terminal - e.g mintty *when* it is configured to not use winpty
#(e.g by setting environment variable MSYS = disable_pcon, prior to launch.)
#not normal operation - fall through to stty attempt with an actionable note
puts stderr "punk::console::enableRaw: powershell consolemode server unavailable ([dict get $sendresult error]) - trying stty"
}
if {[set sttycmd [auto_execok stty]] ne ""} {
if {[set previous_stty_state_$channel] eq ""} {
set previous_stty_state_$channel [exec {*}$sttycmd -g <@$channel]
}
exec {*}$sttycmd raw -echo <@$channel
tsv::set punk_console is_raw 1
#review - inconsistent return dict
return [dict create stdin [list from [set previous_stty_state_$channel] to "" note "fixme - to state not shown"]]
} else {
error "punk::console::enableRaw Unable to use twapi or stty to set raw mode - aborting"
error "punk::console::enableRaw Unable to use twapi, the powershell consolemode server, or stty to set raw mode - aborting"
}
}
proc disableRaw_powershell {{channel stdin}} {
#disableRaw powershell version
#disableRaw powershell/fallback version (G-106)
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set ch_state [chan conf $channel]
@ -5986,11 +6568,20 @@ namespace eval punk::console::system {
tsv::set punk_console is_raw 0
return [list $channel [list from [dict get $ch_state -inputmode] to normal]]
} else {
#tcl <= 8.6x doesn't support -inputmode
#tcl <= 8.6x doesn't support -inputmode - ask the powershell consolemode server
#to restore the console's line/echo input flags
if {"windows" eq $::tcl_platform(platform)} {
set sendresult [::punk::console::system::ps_consolemode_send disableraw]
if {[dict get $sendresult ok]} {
tsv::set punk_console is_raw 0
return [list $channel [list from unknown to normal note "set via powershell consolemode server"]]
}
#not normal operation - fall through to stty attempt with an actionable note
puts stderr "punk::console::disableRaw: powershell consolemode server unavailable ([dict get $sendresult error]) - trying stty"
}
if {[set sttycmd [auto_execok stty]] ne ""} {
#this doesn't work on windows
#It may seem to - only because running *any* external utility can exit raw mode
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
@ -6002,7 +6593,7 @@ namespace eval punk::console::system {
#probably not. We should work out how to read the stty result flags and set a result.. or just limit from,to to showing echo and lineedit states.
return [list stdin [list from "[set previous_stty_state_$channel]" to "" note "fixme - to state not shown"]]
} else {
error "punk::console::disableRaw Unable to use twapi or stty to unset raw mode - aborting"
error "punk::console::disableRaw Unable to use twapi, the powershell consolemode server, or stty to unset raw mode - aborting"
}
}
}
@ -6181,52 +6772,14 @@ namespace eval punk::console {
proc disableRaw {{channel stdin}} [info body ::punk::console::system::disableRaw_twapi]
} else {
variable ps_consolemode_pid
variable ps_consolemode_contents
variable ps_pipename
if {![info exists ps_consolemode_contents]} {
#start persistent powershell consolemode_server.ps1 named pipe server
#::argv0 is absent in secondary threads (thread::create workers, codethreads) -
#the module must remain loadable there
if {[info exists ::argv0] && $::argv0 ne ""} {
set pstooldir [file dirname [file dirname [file normalize $::argv0]]]/scriptlib/utils/pwsh
} else {
set pstooldir [pwd]
}
#set ps_script $pstooldir/consolemode_server.ps1
set ps_script $pstooldir/consolemode_server_async.ps1
if {[file exists $ps_script]} {
set fd [open $ps_script r]
chan configure $fd -translation binary
set ps_consoleid [pid]-[expr {int(999 * rand())+1}]
set ps_consolemode_contents [string map [list "<punkshell_consoleid>" $ps_consoleid] [read $fd]]
close $fd
#set ps_consolemode_pipe [twapi::namedpipe_client {//./pipe/punkshell_ps_consolemode} -access write]
#set ps_cmd [auto_execok pwsh.exe]
set ps_cmd [auto_execok pwsh.exe]
if {$ps_cmd eq ""} {
set ps_cmd [auto_execok powershell.exe]
}
if {$ps_cmd ne ""} {
set ps_consolemode_pid [exec {*}$ps_cmd -nop -nol -c $ps_consolemode_contents &]
set ps_pipename {\\.\pipe\punkshell_ps_consolemode_}
append ps_pipename $ps_consoleid
puts stderr "twapi not present, using persistent powershell process: pipename: $ps_pipename pid: $ps_consolemode_pid"
#todo - taskkill /F /PID $ps_consolemode_pid
#when?
#review
#if {[catch {puts "pidinfo: [::tcl::process::status $ps_consolemode_pid]"} errM]} {
# puts stderr "--- failed to get process status for $ps_consolemode_pid\n$errM"
#}
#set p [open {\\.\pipe\punkshell_ps_consolemode} w]
#chan conf $p -buffering none -blocking 1
#puts $p ""
#close $p
}
}
}
#no twapi - use the powershell console-mode fallback (G-106).
#The persistent powershell named-pipe server is started lazily on first
#enableRaw/disableRaw use (punk::console::system::ps_consolemode_server_ensure),
#not at module load: loading punk::console in a piped/non-console or worker-thread
#context must not spawn processes or emit noise. Server state is process-wide
#(tsv punk_console ps_server_*), the server watches this process's pid and exits
#with it, and script resolution no longer depends on argv0 alone
#(see punk::console::system::ps_consolemode_script_get).
proc enableRaw {{channel stdin}} [info body ::punk::console::system::enableRaw_powershell]
proc disableRaw {{channel stdin}} [info body ::punk::console::system::disableRaw_powershell]
@ -6344,7 +6897,7 @@ namespace eval punk::console {
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::argdoc ::punk::console::internal ::punk::console::local ::punk::console::ansi ::punk::console::check
lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::argdoc ::punk::console::internal ::punk::console::local ::punk::console::ansi ::punk::console::check ::punk::console::system ::punk::console::system::argdoc
}
@ -6353,7 +6906,7 @@ namespace eval ::punk::args::register {
## Ready
package provide punk::console [namespace eval punk::console {
variable version
set version 0.7.2
set version 0.8.0
}]
return
