Version 5 of Port scanning in tcl

 # 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]
     return
 }

 # 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
 }

See also Detecting Port Scans in Tcl

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
 }

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
 }

Category Application | Category Internet