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.