I recently asked a question about reopening stdin in C after passing EOF and now want the same behavior when using Tcl.
I can't seem to find a Tcl commmand doing what C clearerr would do. How can I pass ctrl+d to stdin at one time and later "reopen" stdin from the Tcl script? (Compiling an external library using C is cheating!)
Currently using Windows and thus ctrl+z but I assume they work similarly enough not to make a difference in this case. Here is some sample code:
set var {}; # declare var to hold the line
gets stdin var; # read a line
if {[string length $var]>0} {puts $var}; # print if read
if {[eof stdin]} { # if end-of-file reached
puts {read from stdin was canceled. reopening just for fun}; # some debug message
puts -nonewline "eof reached for stdin. enter something more to echo: "; flush stdout
# clearerr() ???
gets stdin var
if {[string length $var]>0} {puts $var}
}
EDIT: Reading about fileevent I believe I can come up with a solution where user does not enter EOF at all to transition between stdin and GUI control.
How can I pass ctrl+d to stdin at one time and later "reopen" stdin from the Tcl script?
I am not sure whether this expectation makes sense from a Tcl POV. If [eof] is caught on a channel, the Tcl channel for stdin is not closed (unless done so explicitly using [close], or Tcl shuts down completely), so there is no need to reopen it. Watch:
proc isReadable { f } {
# The channel is readable; try to read it.
set status [catch { gets $f line } result]
if { $status != 0 } {
# Error on the channel
puts "error reading $f: $result"
set ::DONE 2
} elseif { $result >= 0 } {
# Successfully read the channel
puts "got: $line"
} elseif { [eof $f] } {
# End of file on the channel
puts "end of file; just continue working"
# set ::DONE 1
} elseif { [fblocked $f] } {
# Read blocked. Just return
} else {
# Something else
puts "can't happen"
set ::DONE 3
}
}
fconfigure stdin -blocking false
fileevent stdin readable [list isReadable stdin]
# Launch the event loop and wait for the file events to finish
vwait ::DONE
This is just a standard snippet from Tcl documentation, also used in How to check if stdin is readable in TCL?. Aside, some comments from the answers and comments to your question at How to restart stdin after Ctrl+D? apply to Tcl as well. See Brad's comment using open or seek stdin 0 end, provided that the source of stdin is seekable.
I believe I have a found a pure-TCL way around this problem: change the EOF character to something other than Ctrl-Z, read a dummy line (to remove the Ctrl-Z from the input buffer) and then reset the EOF character back to Ctrl-Z. Wrapped up in a procedure:
proc clearEOF {} {
fconfigure stdin -eofchar { "\x01" "" }
gets stdin dummy
fconfigure stdin -eofchar { "\x1a" "" }
}
The choice of \x01 is somewhat arbitrary: essentially anything that is not likely to be in the input buffer alongside the Ctrl-Z should do.
Note: This has only been tested on Windows 10 with TCL 8.6.9.
Original Test Program
puts "Enter lines then Ctrl-Z <RETURN> to end"
while { [ gets stdin line ] >= 0 } {
puts "Read: $line"
}
puts "Reached EOF"
puts "eof=[eof stdin]"
puts "Enter another line"
puts "gets=[gets stdin line]"
puts "Read: $line"
The wish is that after having read a number of lines, terminated by the EOF-marker (Ctrl-Z), you can then read another line. In practice, the EOF-state is not cleared, and the second call to gets does not wait for input and immediately returns -1 (=EOF):
Enter lines then Ctrl-Z <RETURN>
Line1
Read: Line1
Line2
Read: Line2
^Z
Reached EOF
eof=1
Enter another line <-- This does not wait
gets=-1
Read:
Note: despite the TCL documentation including (my emphasis):
read ?-nonewline? fileID
Reads all the remaining bytes from fileID, and returns that string. If -nonewline is set, then the last character will be discarded if it is a newline. Any existing end of file condition is cleared before the read command is executed.
replacing the gets with something like set line [ read stdin ] makes no difference. Both commands return immediately. Having multiple repetitions of either command makes no difference: once TCL (and/or Windows1) thinks we've hit EOF, we stay at EOF!
My Solution
After some playing around, trying every file-manipulation command I could find that TCL posses, I came up with the following:
puts "Enter lines then Ctrl-Z <RETURN>"
while { [ gets stdin line ] >= 0 } {
puts "Read: $line"
}
puts "Reached EOF"
puts "eof=[eof stdin]"
puts "Reset EOF char"
fconfigure stdin -eofchar { "\x01" "" }
puts "eof=[eof stdin]"
puts "Reading dummy line"
puts "gets=[gets stdin line]"
fconfigure stdin -eofchar { "\x1a" "" }
puts "Enter another line"
puts "gets=[gets stdin line]"
puts "Read: $line"
The output of this version does wait for more input:
Enter lines then Ctrl-Z <RETURN>
Line 1
Read: Line 1
Line 2
Read: Line 2
^Z
Reached EOF
eof=1
Reset EOF char
eof=0 <-- EOF has been cleared
Reading dummy line
gets=1 <-- Read 1 character: the Ctrl-Z
Enter another line
More text <-- Waits for this to be typed
gets=9
Read: More text
My assumption of what's happening is that changing the EOF-character does reset the EOF status (whether this happens "in TCL" or "in Windows" I'm unsure). With a different EOF-marker in place, we can read the line containing the Ctrl-Z that has been left in the input buffer. (Depending on what you entered either side of the Ctrl-Z, this would normally also contain an end-of-line marker). With the Ctrl-Z disposed of, we can reset the EOF-character back to Ctrl-Z and carry on reading from stdin as normal.
1 This issue on Microsoft's WSL GitHub page suggests that it could be Windows that is at fault: once the Ctrl-Z in the buffer, it always returns EOF, even when clearerr() is used. My reading of "Another bane for xplat programmers for the last 30 years, Ctrl-D on Unix and Ctrl-Z on Windows don't work the same." is that although the issue is against WSL, the problem is in Windows itself. Interestingly, the final comment (at time of writing) states "Fixed in Windows Insider Build 18890", but one might still need to call clearerr().
Related
Question is extension of what is answered in link. While trying to use it to print output with delay, cat file_name on the shell doesn't display the content of the file during the delay time using after. Here's the code:
proc foo {times} {
while {$times >0} {
puts "hello$times"
incr times -1
after 20000
puts "hello world"
}
}
proc reopenStdout {file} {
close stdout
open $file w ;# The standard channels are special
}
reopenStdout ./bar
foo 10
The data you're writing is being buffered in memory and you're not writing enough of it to flush the internal buffer to disk. Add a flush stdout inside the loop in foo, or do something like set up the newly opened channel to be line-buffered:
proc reopenStdout {file} {
close stdout
set ch [open $file w] ;# The standard channels are special
chan configure $ch -buffering line
}
You can play with chan configure's -buffering and -buffersize options to get the behavior that works best for your needs if line buffering isn't enough.
I am running tclsh some.tcl and it exits after it hits eof. I want it not to exit and gives control to user for interaction. Note that we can do this by invoking shell and sourcing script but that doesn't solve my problem as it cannot be used in automation.
If you can load the TclX package (old but still useful) then you can do:
package require Tclx; # Lower case at the end for historical reasons
# Your stuff here
commandloop
That's very much like how Tcl's own interactive command line works.
Otherwise, here's a scripted version that does most of what an interactive command session does:
if {![info exists tcl_prompt1]} {
set tcl_prompt1 {puts -nonewline "% ";flush stdout}
}
if {![info exists tcl_prompt2]} {
# Note that tclsh actually defaults to not printing anything for this prompt
set tcl_prompt2 {puts -nonewline "> ";flush stdout}
}
set script ""
set prompt $tcl_prompt1
while {![eof stdin]} {
eval $prompt; # Print the prompt by running its script
if {[gets stdin line] >= 0} {
append script $line "\n"; # The newline is important
if {[info complete $script]} { # Magic! Parse for syntactic completeness
if {[catch $script msg]} { # Evaluates the script and catches the result
puts stderr $msg
} elseif {$msg ne ""} { # Don't print empty results
puts stdout $msg
}
# Accumulate the next command
set script ""
set prompt $tcl_prompt1
} else {
# We have a continuation line
set prompt $tcl_prompt2
}
}
}
Getting the remaining bits right (e.g., the interaction with the event loop when the Tk package is loaded) would require quite a bit more complexity...
Hi I am using this piece of code for inserting pipe in TCL. Can anybody please let me understand when this condition [gets $pipe line] >= 0 fails.
For eg: only when [gets $pipe line] is a negative number this will fail.
In my case it is never returning a negative number and the TestEngine hangs forever
set pipeline [open "|Certify.exe filename" "r+"]
fileevent $pipeline readable [list handlePipeReadable $pipeline]
fconfigure $pipeline -blocking 0
proc handlePipeReadable {pipe} {
if {[gets $pipe line] >= 0} {
# Managed to actually read a line; stored in $line now
} elseif {[eof $pipe]} {
# Pipeline was closed; get exit code, etc.
if {[catch {close $pipe} msg opt]} {
set exitinfo [dict get $opt -errorcode]
} else {
# Successful termination
set exitinfo ""
}
# Stop the waiting in [vwait], below
set ::donepipe $pipe
} else {
puts ""
# Partial read; things will be properly buffered up for now...
}
}
vwait ::donepipe
The gets command (when given a variable to receive the line) returns a negative number when it is in a minor error condition. There are two such conditions:
When the channel has reached end-of-file. After the gets the eof command (applied to the channel) will report a true value in this case.
When the channel is blocked, i.e., when it has some bytes but not a complete line (Tcl has internal buffering to handle this; you can get the number of pending bytes with chan pending). You only see this when the channel is in non-blocking mode (because otherwise the gets will wait indefinitely). In this case, the fblocked command (applied to the channel) will return true.
Major error conditions (such as the channel being closed) result in Tcl errors.
If the other command only produces partial output or does something weird with buffering, you can get an eternally blocked pipeline. It's more likely with a bidirectional pipe, such as you're using, as the Certify command is probably waiting for you to close the other end. Can you use it read-only? There are many complexities to interacting correctly with a process bidirectionally! (For example, you probably want to make the pipe's output buffering mode be unbuffered, fconfigure $pipeline -buffering none.)
Please find the way the certify process is being triggered from the command prompt and the print statements are given just for the understanding. At the end the process hangs and the control is not transferred back to the TCL
From the documentation for gets:
If varName is specified and an empty string is returned in varName because of end-of-file or because of insufficient data in nonblocking mode, then the return count is -1.
Your script is working completely fine. checked with set pipeline [open "|du /usr" "r+"]
instead of your pipe and included puts "Line: $line" to check the result. So its clear that there is some problem in Certify command. Can you share your command, how do you use on terminal and how did you use with exec?
################### edited by Drektz
set pipeline [open "|du /usr" "r+"]
fileevent $pipeline readable [list handlePipeReadable $pipeline]
fconfigure $pipeline -blocking 0
proc handlePipeReadable {pipe} {
if {[gets $pipe line] >= 0} {
# Managed to actually read a line; stored in $line now
################### included by Drektz
puts "Line: $line"
} elseif {[eof $pipe]} {
# Pipeline was closed; get exit code, etc.
if {[catch {close $pipe} msg opt]} {
set exitinfo [dict get $opt -errorcode]
} else {
# Successful termination
set exitinfo ""
}
# Stop the waiting in [vwait], below
set ::donepipe $pipe
} else {
puts ""
# Partial read; things will be properly buffered up for now...
}
}
vwait ::donepipe
you can see it in the CMDwith& screenshot mentioned.Is there any workaround that I have to overcome the issue
Please see the issue when run with the help of exec executable args &
EDIT: Original example and alternative solution framework modified for clarity.
The line buffering behaviour might behave differently than expected in Tcl 8.6. The following code blocks without any output, unless the "chan close" line is uncommented:
set data {one two four}
set stream [open |[list cat -n] r+]
chan configure $stream -buffering line
chan puts $stream "$data\n"
chan puts $stream "\n"
chan flush $stream
#chan close $stream write
set out [chan read $stream]
puts "output: $out"
chan close $stream
So this simplistic solution does not work for interactive I/O, and this might be related to synchronization problems at both ends of the pipe.
Using a channel event structure (e.g., based on http://www.beedub.com/book/2nd/event.doc.html), seems to be preferable:
proc chanReader { pipe } {
global extState
while 1 {
set len [chan gets $pipe line]
if { $len > 0 } {
puts "<< $line."
continue
} else {
if { [chan blocked $pipe] } {
set extState 1
return
} elseif { [chan eof $pipe] } {
set extState 2
return
}
}
}
}
set data {one two foure}
set timeout 5000
#set stream [open [list | cat -n] r+]
#set stream [open [list | ispell -a] r+]
set stream [open [list | tr a-z A-Z] r+]
#set stream [open [list | fmt -] r+]
chan configure $stream -blocking 0 -buffering line
set extState 0
chan event $stream readable [list chanReader $stream]
foreach word $data {
puts "> $word\n"
chan puts $stream "$word\n"
chan flush $stream
#chan close $stream write
set aID [after $timeout {set extState 3}]
vwait extState
if { $extState == 1 } {
# Got regular output.
after cancel $aID
puts "Cancel $aID."
continue
} elseif { $extState == 2 } {
puts "External program closed."
chan close $stream
exit 2
} elseif { $extState == 3 } {
puts "Timeout."
chan close $stream
exit 3
}
}
puts "End of task."
chan close $stream
exit 0
This code fragment works with the "cat -n" and "ispell -a" external programs (commented lines), but still fails with other external programs. For instance it does not work with the "tr a-z A-Z" and "fmt" examples above.
If the line "chan close $stream write" above is uncommented, we receive output from the external program, but this terminates the interaction with it. How to reliably connect (interactively) to these external programs?
I'm guessing that the core issue here is that there's two sources of buffering going on, and Tcl only has control over one of them. But both stem from the fact that virtually all output, when not going to an “interactive” destination (i.e., a terminal), is buffered. There's basically a call in the C standard library that determines this and enables the buffering feature, and Tcl follows that rule too (despite using its entirely independent I/O library). Doing this massively speeds up non-interactive pipeline processing, but means that if you're expecting to see every byte output exactly at the point when the program thinks it is writing it, you're going to be disappointed.
Of course, programs can switch this buffering off if they want. In Tcl, this is done by fconfigure $channel -buffering none (or line for line-oriented buffering). In cat, the -n option makes it do the equivalent (calling setvbuf() in C) and ispell is probably doing the same. But most programs don't. Some instead call fflush() from time to time; that works too, but is also a minority practice. So with a bidirectional pipeline such as you're using, you can easily force the side where you feed into it from Tcl not buffer, but you can't usually get the other side to do the same.
There is a workaround: run the subprocess with Expect. That puts a fake terminal between Tcl and the subprocess (instead of a pipe) and tricks it into thinking it is talking direct to the user. But the consequence of this is that you have to substantially rewrite your Tcl program and you gain a dependency on a (very fine!) external package.
I have a case when the Tcl script runs a process, which does fork(), leaves the forked process to run, and then the main process exits. You can try it out simply by running any program that forks to background, for example gvim, provided that it is configured to run in background after execution: set res [exec gvim].
The main process theoretically exits immediately, the child process runs in background, but somehow the main process hangs up, doesn't exit, stays in zombie state (reports as <defunct> in ps output).
In my case the process I'm starting prints something, I want that something and I want that the process exit and I state it done. The problem is that if I spawn the process using open "|gvim" r, then I cannot also recognize the moment when the process has finished. The fd returned by [open] never reports [eof], even when the program turns into zombie. When I try to [read], just to read everything that the process might print, it hangs up completely.
What is more interesting, is that occasionally both the main process and the forked process print something and when I'm trying to read it using [gets], I get both. If I close the descriptor too early, then [close] throws an exception due to broken pipe. Probably that's why [read] never ends.
I need some method to recognize the moment when the main process exits, while this process could have spawned another child process, but this child process may be completely detached and I'm not interested what it does. I want something that the main process prints before exitting and the script should continue its work while the process running in background is also running and I'm not interested what happens to it.
I have a control over the sources of the process I'm starting. Yes, I did signal(SIGCLD, SIG_IGN) before fork() - didn't help.
Tcl clears up zombies from background process calls the next time it calls exec. Since a zombie really doesn't use much resources (just an entry in the process table; there's nothing else there really) there isn't a particular hurry to clean them up.
The problem you were having with the pipeline was that you'd not put it in non-blocking mode. To detect exit of a pipeline, you're best off using a fileevent which will fire when either there's a byte (or more) to read from the pipe or when the other end of the pipe is closed. To distinguish these cases, you have to actually try to read, and that can block if you over-read and you're not in non-blocking mode. However, Tcl makes working with non-blocking mode easy.
set pipeline [open |… "r"]
fileevent $pipeline readable [list handlePipeReadable $pipeline]
fconfigure $pipeline -blocking false
proc handlePipeReadable {pipe} {
if {[gets $pipe line] >= 0} {
# Managed to actually read a line; stored in $line now
} elseif {[eof $pipe]} {
# Pipeline was closed; get exit code, etc.
if {[catch {close $pipe} msg opt]} {
set exitinfo [dict get $opt -errorcode]
} else {
# Successful termination
set exitinfo ""
}
# Stop the waiting in [vwait], below
set ::donepipe $pipeline
} else {
# Partial read; things will be properly buffered up for now...
}
}
vwait ::donepipe
Be aware that using gvim in a pipeline is… rather more complex than usual, as it is an application that users interact with.
You might find it easier to run a simple exec in a separate thread, provided your version of Tcl is thread-enabled and the Thread package is installed. (That ought to be the case if you're using 8.6, but I don't know if that's true.)
package require Thread
set runner [thread::create {
proc run {caller targetVariable args} {
set res [catch {
exec {*}$args
} msg opt]
set callback [list set $targetVariable [list $res $msg $opt]]
thread::send -async $caller $callback
}
thread::wait
}]
proc runInBackground {completionVariable args} {
global runner
thread::send -async $runner [list run [thread::id] $completionVariable {*}$args]
}
runInBackground resultsVar gvim …
# You can do other things at this point
# Wait until the variable is set (by callback); alternatively, use a variable trace
vwait resultsVar
# Process the results to extract the sense
lassign $resultsVar res msg opt
puts "code: $res"
puts "output: $msg"
puts "status dictionary: $opt"
For all that, for an editor like gvim I'd actually expect it to be run in the foreground (which doesn't require anything like as much complexity) since only one of them can really interact with a particular terminal at once.
Your daemon can also call setsid() and setpgrp() to start a new session and to detach from the process group. But these don't help with your problem either.
You will have to do some process management:
#!/usr/bin/tclsh
proc waitpid {pid} {
set rc [catch {exec -- kill -0 $pid}]
while { $rc == 0 } {
set ::waitflag 0
after 100 [list set ::waitflag 1]
vwait ::waitflag
set rc [catch {exec -- kill -0 $pid}]
}
}
set pid [exec ./t1 &]
waitpid $pid
puts "exit tcl"
exit
Edit: Another unreasonable answer
If the forked child process closes the open channels, Tcl will not wait on it.
Test program:
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <signal.h>
int
main (int argc, char *argv [])
{
int pid;
FILE *o;
signal (SIGCHLD, SIG_IGN);
pid = fork ();
if (pid == 0) {
/* should also call setsid() and setpgrp() to daemonize */
printf ("child\n");
fclose (stdout);
fclose (stderr);
sleep (10);
o = fopen ("/dev/tty", "w");
fprintf (o, "child exit\n");
fclose (o);
} else {
printf ("parent\n");
sleep (2);
}
printf ("t1 exit %d\n", pid);
return 0;
}
Test Tcl program:
#!/usr/bin/tclsh
puts [exec ./t1]
puts "exit tcl"
At first you say:
I need some method to recognize the moment when the main process exits, while this process could have spawned another child process, but this child process may be completely detached and I'm not interested what it does.
later on you say:
If the forked child process closes the open channels, Tcl will not wait on it.
these are two contradictory statements. One one hand you are only interested in the parent process and on the other whether or not the child has finished even thought you also state you aren't interested in child processes that have detached. Last I heard forking and closing the childs copies of the parents stdin,stdout and stderr is detaching (i.e.daemonizing the child process ). I wrote this quick program to run the above included simple c program and as expected tcl knows nothing of the child process. I called the compiled version of the program /tmp/compile/chuck. I did not have gvim so I used emacs but as emacs does not generate text I wrap the exec in its own tcl script and exec that. In both cases, the parent process is waited for and eof is detected. When the parent exits the Runner::getData runs and the clean up is evaluated.
#!/bin/sh
exec /opt/usr8.6.3/bin/tclsh8.6 "$0" ${1+"$#"}
namespace eval Runner {
variable close
variable watch
variable lastpid ""
array set close {}
array set watch {}
proc run { program { message "" } } {
variable watch
variable close
variable lastpid
if { $message ne "" } {
set fname "/tmp/[lindex $program 0 ]-[pid].tcl"
set out [ open $fname "w" ]
puts $out "#![info nameofexecutable]"
puts $out " catch { exec $program } err "
puts $out "puts \"\$err\n$message\""
close $out
file attributes $fname -permissions 00777
set fd [ open "|$fname " "r" ]
set close([pid $fd]) "file delete -force $fname "
} else {
set fd [ open "|$program" "r" ]
set close([pid $fd]) "puts \"cleanup\""
}
fconfigure $fd -blocking 0 -buffering none
fileevent $fd readable [ list Runner::getData [ pid $fd ] $fd ]
}
proc getData { pid chan } {
variable watch
variable close
variable lastpid
set data [read $chan]
append watch($pid) "$data"
if {[eof $chan]} {
catch { close $chan }
eval $close($pid) ; # cleanup
set lastpid $pid
}
}
}
Runner::run /tmp/compile/chuck ""
Runner::run emacs " Emacs complete"
while { 1 } {
vwait Runner::lastpid
set p $Runner::lastpid
catch { exec ps -ef | grep chuck } output
puts "program with pid $p just ended"
puts "$Runner::watch($p)"
puts " processes that match chuck "
puts "$output"
}
Output :
note I exited out of emacs after the child reported that it was exiting.
[user1#linuxrocks workspace]$ ./test.tcl
cleanup
program with pid 27667 just ended
child
parent
t1 exit 27670
processes that match chuck avahi 936 1 0 2016 ?
00:04:35 avahi-daemon: running [linuxrocks.local] admin 27992 1 0
19:37 pts/0 00:00:00 /tmp/compile/chuck admin 28006 27988 0
19:37 pts/0 00:00:00 grep chuck
child exit
program with pid 27669 just ended
Emacs complete
Ok, I found the solution after a long discussion here:
https://groups.google.com/forum/#!topic/comp.lang.tcl/rtaTOC95NJ0
The below script demonstrates how this problem can be solved:
#!/usr/bin/tclsh
lassign [chan pipe] input output
chan configure $input -blocking no -buffering line ;# just for a case :)
puts "Running $argv..."
set ret [exec {*}$argv 2>#stderr >#$output]
puts "Waiting for finished process..."
set line [gets $input]
puts "FIRST LINE: $line"
puts "DONE. PROCESSES:"
puts [exec ps -ef | grep [lindex $argv 0]]
puts "EXITING."
The only problem that remains is that there's still no possibility to know that the process has exited, however the next [exec] (in this particular case probably the [exec ps...] command did this) cleans up the zombie (No universal method for that - the best you can do on POSIX systems is [exec /bin/true]). In my case it was enough that I get one line that the parent process had to print, after which I can simply "let it go".
Still, it would be nice if [exec] can return me somehow the PID of the first process and there's a standard [wait] command that can block until the process exits or check its running state (this command is currently available in TclX).
Note that [chan pipe] is available only in Tcl 8.6, you can use [pipe] from TclX alternatively.