What version of Tcl are you using?
Their have been known bugs in the way Tcl closes pipes where it waits
on the children when it ought not to. Can you try this with Tcl 8.3 ?
>>>"Schmidgall, Jay" said:
> I'm seeing an unusual hanging problem, and I don't know if I'm hitting some
> sort of race condition or am just misunderstanding what I'm trying to do.
> I'm seeing this on both Windows NT and Solaris 2.5.7.
>
> What's happening is that when I access a particular URL, I have tcl-httpd
> spawn off a new process. I then establish a fileevent to grab output so I
> can keep track of when the spawned process exits.
>
> The problem I'm seeing is that if that process produces output immediately
> but does not exit, tcl-httpd hangs until the process exits. If no output is
> produced or the process exits, everything is fine.
>
> I've managed to hack up config file which duplicates the problem. If you
> save the bottom of this email as bug.rc, and run
>
> wish httpd.tcl -config bug.rc
>
> you can try accessing /nohang1, /nohang2, and /hang. The last one will
> reproduce the problem. If you try this under NT, you'll need something like
> MKS or the GNU utils to have a sleep and ls command available.
>
> # bug.rc
> #
> # This is the default configuration file for TclHttpd, the Tcl Web Server
>
> # The Config array is set from the command line options or
> # from defaults defined in httpd
> # You can set them here, but then they smash any command-line values
>
> # Config Array
> # Element Default
> # host [info hostname]
> # port 8015
> # debug 0
> # docRoot [file join $home htdocs]
> # ipaddr {}
> # webmaster webmaster@[info hostname]
> # uid 50
> # gid 100
>
> # Force running with wish
>
> if { ! [ info exists tk_version ] } {
> puts {Please run this with wish, not tclsh}
> exit
> }
>
> # Add a text widget so we can see some output
>
> text .text -width 30 -height 10 \
> -yscrollcommand { .textvsb set }
> scrollbar .textvsb -command { .text yview }
> grid configure .text .textvsb -sticky news
>
> # These packages are required for "normal" web servers
>
> package require doc ;# Basic file URLS
> package require include ;# Server side includes
> package require cgi ;# Standard CGI
> package require dirlist ;# Directory listings
>
> # These packages are for special things built right into the server
>
> package require direct ;# Application Direct URLs
> package require status ;# Built in status counters
> package require mail ;# Crude email support
> package require admin ;# Url-based administration
> package require session ;# Session state module (better Safe-Tcl)
> package require debug ;# Debug utilites
>
> # This is currently broken
> if {0} {
> package require safetcl ;# External process running safetcl shells
> }
>
> # These packages are for the SNMP demo application
>
> if {[catch {
> package require snmp ;# SNMP form creation
> package require Tnm ;# Low level network stuff
> }]} {
> puts "No SNMP support"
> }
>
> # For information about these calls, see htdocs/reference.html
>
> Doc_Root $Config(docRoot)
> Doc_IndexFile index.{tml,html,shtml,thtml,htm,subst}
> Doc_PublicHtml public_html
> Cgi_Directory /cgi-bin
> Status_Url /status
> Debug_Url /debug
> Mail_Url /mail
> Admin_Url /admin
> Doc_TemplateInterp {}
> Doc_CheckTemplates 1
> Doc_TemplateLibrary [file join $Config(docRoot) libtml]
> Doc_ErrorPage /error.html
> Doc_NotFoundPage /notfound.html
> Doc_Webmaster $Config(webmaster)
> if {[catch {
> Auth_AccessFile .htaccess ;# Enable Basic Auth
> } err]} {
> puts "No Basic Authentication support: $err"
> }
>
> Log_SetFile C:/Temp/log$Config(port)_
> Log_FlushMinutes 1
>
> # Establish mapping for URLs to test
>
> Direct_Url /hang hang
> Direct_Url /nohang1 nohang1
> Direct_Url /nohang2 nohang2
>
> proc nohang1 {} {
> textout nohang1 entered
> if { 0 == [ catch { open "| sleep 5 " } spawned ] } {
> fileevent $spawned readable [ list output $spawned nohang1 ]
> }
> textout nohang1 leaving
> return nohang1
> }
>
> proc nohang2 {} {
> textout nohang2 entered
> if { 0 == [ catch { open "| ls " } spawned ] } {
> fileevent $spawned readable [ list output $spawned nohang2 ]
> }
> textout nohang2 leaving
> return nohang2
> }
>
> proc hang {} {
> textout hang entered
> if { 0 == [ catch { open "| sleep 5 | ls " } spawned ] } {
> textout About to hang -- you cannot depress
> textout the Quit button now.
> update
> fileevent $spawned readable [ list output $spawned hang]
> }
> textout hang leaving
> return hang
> }
>
> proc output { channel which } {
> if { [ eof $channel ] } {
> close $channel
> textout $which exited.
> } else {
> set out [ read $channel ]
> textout $which output: $out
> }
> }
>
> proc textout { args } {
> set time [ clock format [ clock seconds ] -format "%H:%M:%S " ]
> .text insert end $time$args
> .text insert end \n
> }
>
-- Brent Welch <[EMAIL PROTECTED]>
http://www.scriptics.com
Scriptics: The Tcl Platform Company
