Few days ago I wanted to implement a routine to quickly test if a particular windows server is alive (that is, up and running). The test should return very quickly because there are a lot of servers to test and the CGI-script should stay responsive. Wiki reading (and a little bit of brain-tweaking) lead to the following procedure which should work almost everywhere, except in companies with a great security paranoia. The trick was to avoid using a synchronous socket-open because the timeout is not configurable anywhere.
proc sockvrfy {sock done} { upvar $done flag if {[string length [fconfigure $sock -error]] == 0} { set flag 1; # { 1 = OK!!!} } else { set flag -2; # {-2 = SockErr, errorinfo get's lost...} } } # (take a look at wiki.tcl.tk/1114) proc socktest {host {port 445} {timeout 1000}} { if {[catch {socket -async $host $port} s]} { return -1; # {-1 = wrong DNS name} }; # else: formally ok set ::done 9; # {9 = undefined} # further testing if socket becomes open fileevent $s writable [list sockvrfy $s ::done] # but don't wait longer than the given amount (in msecs) set aid [after $timeout [list set ::done 0]]; # { 0 = Timeout} # waiting for test to succeed or timeout to happen... vwait ::done; # blocking the caller but keeping eventloop alive! catch {close $s} after cancel $aid return $::done } # Testcase puts "nonexistentserver should return -1 => [socktest nonexistentserver]" puts "runningserver should return 1 => [socktest runningserver ]" puts "offlineserver should return 0 => [socktest offlineserver ]"
The whole thing only works with tcp/ip-networking, of course. Alternatively, one can specify port 139 instead of 445.
See Testing socketports.