SLUG_Wiki: PortSentry

 #!/bin/sh
 # the next line restarts using -*-Tcl-*-sh \
 exec tclsh "$0" ${1+"$@"}

 # records all attempts to connect to the ports listed
 # in the portlist.
 # log lines consist of a timestamp, the port number
 # that was connected to, and client peer info.

 set portlist [ list 6667 8080 31337 ]

 proc cfg { cid addr port } {
     fileevent $cid writable "handle $cid"
     fconfigure $cid -blocking  off
 }

 proc handle { cid } {
     set peerinfo [ fconfigure $cid -peername ]
     set port     [ fconfigure $cid -sockname ]
     puts $cid "thank you for your contribution!"
     close $cid
     set port [ lindex $port 2 ]
     set time [ clock format [ clock seconds ] -format "%m/%d/%y-%r %Z" ]
     puts stdout "$time $port $peerinfo"
 }

 proc bgerror { msg } {
     set trace [ list ]
     catch { set trace $::errorInfo }
     if { [ string length $trace ] } {
        set msg $trace
     }
     # if a socket is hosed inside a bgerror it needs to be
     # cleaned up!!  parse the error message for the sock i.d.
     if { [ regexp {\"(sock\d+)\":\s+broken\s+pipe} $msg -> sock ] } {
        catch { ::close $sock }
     }
     set time [ clock format [ clock seconds ] -format "%m/%d/%y-%r %Z" ]
     puts stdout "$time $msg"
 }

 foreach port $portlist {
    socket -server cfg $port
 }   
 vwait enter-mainloop

And the rudiments of a scanner. Just add a main iterator.

 proc connect { host port } {
      if { [ catch {
         set sid [ socket -async $host $port ]
      } err ] } {
         cleanup NULL $host $port
         return {}
      }
      fconfigure $sid -blocking off
      # need a way to bail out!!
      set id \
         [ after 2000 [ list cleanup $sid $host $port ] ]
      fileevent $sid writable "report $sid $host $port $id"
 }

 proc report { sid host port id } {
      after cancel $id
      close $sid
      puts stdout "$host $port UP"
 }

 proc cleanup { sid host port } {
      catch { close $sid }
      puts stdout "$host $port DOWN"
 }