Updated 2007-11-02 14:25:49 by LV

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.