OriginalBugID: 2322 Bug
Version: 8.1.1
SubmitDate: '1999-07-06'
LastModified: '1999-08-05'
Severity: CRIT
Status: Closed
Submitter: techsupp
ChangedBy: hobbs
RelatedBugIDs: 2328
OS: Windows 95
Machine: X86
FixedDate: '2000-10-25'
ClosedDate: '1999-08-05'
Name:
Martin Conrad
CustomShell:
no
ReproducibleScript:
I developed 2 scripts. One implements a command server, one a client.
The server offers a command shell to the client, running on the server.
The command shell is command (Win 95), cmd (Win NT) or sh (Unix/Linux).
Whenever at least one connection from a client has been established, the
server can't be stopped. This is true after legal disconnect (see the
server script), as <Cntrl-C> doesn't work. In that case, you can only
use the task manager to stop the application, but shutdown hangs.
To start the scripts, you need two command windows. In one, type
tclsh81 cmdserver.tc 4711
In the other, type
tclsh81 cmdclient.tc name 4711
where "name" is the host name (e.g."localhost", if you test on one
computer). 4711 is the port number, you can use any free port number,
4711 is only one example.
On the client, you can type in a command, "exit" to finish the
communication.
Here the two scripts:
----------------------------------------------------- CmdServer.tc:
#! /usr/local/bin/tclsh
if {$argc != 1} {
puts {Syntax: cmdserver port}
exit
}
if [catch {expr [lindex $argv 0] + 0} port] {
puts {Syntax: cmdserver port}
exit
}
puts "cmdserver 0.1"
proc service {fdx host port} {
global X SH tcl_platform fds fd1 Y
set fds $fdx
puts "Connect from $host:$port"
fconfigure $fds -blocking 0 -buffering none -translation {auto lf}
if {[string compare "$tcl_platform(platform)" "windows"] == 0} {
set fd1 [open "| cmd" r+]
} else {
set fd1 [open {| sh -c "exec sh -i 2>&1"} r+]
}
fconfigure $fd1 -blocking 0 -buffering none -translation {auto auto}
fileevent $fd1 readable {
set xxx [read $fd1 100]
puts -nonewline $fds $xxx
if [eof $fd1] {
fileevent $fds readable {}
fileevent $fd1 readable {}
set Y 1
}
}
fileevent $fds readable {
set yyy [read $fds 100]
puts -nonewline $fd1 $yyy
if [eof $fds] {
fileevent $fds readable {}
fileevent $fd1 readable {}
set Y 2
}
}
vwait Y
if {$Y == 1} {
puts "Disconnecting $host:$port"
} else {
puts "Disconnect from $host:$port"
}
catch {close $fd1}
close $fds
}
# setup global variables used from service proc
set fds 0
set fd1 1
set Y 0
set X 1
set fd [socket -server service [lindex $argv 0]]
vwait X
----------------------------------------------------- CmdClient.tc:
#! /usr/local/bin/tclsh
if {$argc != 2} {
puts {Syntax: cmdclient host port}
exit
}
if [catch {expr [lindex $argv 1] + 0} port] {
puts {Syntax: cmdclient host port [cr|lf|crlf]}
exit
}
puts "cmdclient 0.1"
set fd [socket [lindex $argv 0] [lindex $argv 1]]
fconfigure $fd -blocking 0 -buffering none -translation {binary binary}
fconfigure stdin -blocking 0 -buffering none -translation auto
fconfigure stdout -blocking 0 -buffering none -translation crlf
fileevent $fd readable {
set yyy [read $fd 100]
puts -nonewline $yyy
if [eof $fd] {
puts "Connection lost"
exit
}
}
fileevent stdin readable {
set xxx [read stdin 100]
puts -nonewline $fd $xxx
if [eof stdin] {
exit
}
}
set FOREVER 0
vwait FOREVER
-----------------------------------------------------
Best regards,
Martin
ObservedBehavior:
It isn't possible to stop the server script: <Cntrl-C> doesn't work.
Shutdown is hanging.
DesiredBehavior:
<Cntrl-C> should stop the server script. As bad alternative, it would be
acceptable, that the task manager must be used to kill the application.
The shutdown must not hang.
