Updated 2012-08-31 15:15:27 by RLE
 # scan.tcl - Copyright (C) 2003 Pat Thoyts <[email protected]>
 # Scan for services using TCP.
 # This illustrates use of the writable fileevent handler
 # $Id: 9829,v 1.5 2006-12-06 19:00:09 jcw Exp $
 # Scan a subnet for servers on the specified port.
 proc scan {base port} {
     global hosts nodes
     catch {unset hosts}
     array set hosts {}
     for {set ip 1} {$ip < 250} {incr ip} {
         connect "$base.$ip" $port
     set nodes $ip
 # Connect asynchronously to a TCP service on the given port.
 # Once connected (or once we fail) the handler will be called.
 # If a host is up it returns pretty quickly. So use a short timout
 # to give up on the others.
 proc connect {host port} {
     set s [socket -async $host $port]
     fileevent $s writable [list ::connected $host $port $s]
     after 2000 [list shutdown $s]
 # Connection handler for the port scanner. This is called both
 # for a successful connection and a failed connection. We can
 # check by trying to operate on the socket. A failed connection
 # raises an error for fconfigure -peername. As we have no other
 # work to do, we can close the socket here.
 proc connected {host port sock} {
     global hosts
     fileevent $sock writable {}
     set r [catch {fconfigure $sock -peername} msg]
     if { ! $r } { set hosts($host) $msg }
     shutdown $sock
 proc shutdown {sock} {
     global nodes
     incr nodes -1
     catch {close $sock}
 proc wait {varname} {
     while {[set $varname] > 1} {
         vwait $varname
 if {$::tcl_interactive} {
     puts "call 'scan 192.168.0 port' then examine the hosts array"
 } else {
     eval [list scan] $argv
     wait ::nodes
     parray hosts

JMN 2010-02-19

The line:
 set s [socket -async $host $port]

Can sometimes raise the error: "couldn't open socket: connection refused" whereas the comments in the code above (and even the socket man page) imply that even for a failed connection we should get a socket handle.

The error was intermittently raised on a multicore 2009 vintage machine running an 8.6b1.1 tclsh on FreeBSD and attempting to connect to a closed port on localhost. Perhaps whether an error is raised is related to the speed at which the connection fails.

Should we be expected to look out for this error - or is this a bug in 'socket -async'?

hae 2010-02-19

The C level function call of socket can fail. Why shouldn't the tcl call to socket fail? There is an OS limitation on how many sockets or file descriptors can be open by one process. http://linux.die.net/man/2/socket has some information.

jmn Raising an error for process limits/security/memory/etc issues I can understand. It just feels a little odd in this case because it seems like a candidate for the sort of thing that should be abstracted away from the Tcl level. I didn't detect any significant timing difference between catching an error directly from the socket command, and getting the 'connection refused' error from 'fconfigure $sock -error' instead. Perhaps there is a performance difference that may show up in some circumstances.

If it is useful to maintain such different response mechanisms for 'connection refused' - then I think some words on the manpage are warranted to clarify the 2(?) different ways in which 'socket -async' may fail due to a non-listening target port.

This is presumably only an issue on localhost (or also fast networks?) and only for certain machines (I couldn't duplicate it on my windows box) - hence it's surely likely to be a situation that some coders haven't anticipated and don't necessarily encounter in testing.

See also:

Zarutian 29 april 2005: this might be useful for finding other peers in peer-to-peer applications.

kostix 06 Dec 2006: this technique has proven useful for connects to some well-known TCP services which are likely to be unavailable. The particular case is TCP DNS lookups: the DNS server may drop packets requesting TCP connections for DNS lookups causing the synchronous socket call to block for some pretty long time.

To prevent the program from hanging while waiting until the TCP connection attempt times out, one can use the described technique with async connect, but instead of
 after 2000 [list shutdown $s]

in the connect procedure one should use something like
 after 2000 timed_out $s

which can be implemented like this
 proc timed_out {sock} {
   shutdown $sock
   # Take whatever action here to let the program know
   # the service is unavailable

By the way, such approach is implemented in the dns module of Tcllib (since 1.10) -- see [1]

kostix 07 Aug 2007: also there's more elegant solution to detecting/reporting errors that might have occured during async connect: using -error option of fconfigure. The returned value will be an empty string if there was no error (so the socket is connected) or the error message corresponding to the error code returned by TCP/IP stack (so the connection attempt failed).

Using something like -peername isn't so good since the error it generates (if the socket isn't connected) inclues the text regarding the operation requested (getting peer's name in that case) which has no sense to the client code.

So the proposed solution is this:
 proc connected {host port sock} {
     global hosts
     fileevent $sock writable {}
     set err [fconfigure $sock -error]
     if { $err ne "" } { set hosts($host) $err }
     shutdown $sock