Updated 2007-08-14 15:47:59 by LV

Public Repository for SpamMap Development

Welcome to the homepage of The Killer Tcl/Tk App, SpamMap.

A project created specifically to show off the high affinity between beer and Tcl.

When completed, SpamMap will:

  • show a map of the world in sunlight and shadow on a canvas...
  • show the point of origin of each spam you receive as they appear in your mailbox!
  • color code the spam dots to show the kind of spam, i.e. Viagra, Nigeria, Stock Tip, Me And My Friends On The Farm... Chain Letter!
  • print the name of the city your spam came from near the spam spot.
  • show a topical graphic appropriate to the city/country of origin.
  • the language used in the spam (Chang)
  • your idea here!!

See also: Tclworld

See also: TclWorld Gazetteer

## not a bad parser for mailboxes
 proc parsebox { mbox } {
     set headers [ list ]
     set bodies  [ list ]

     ;## read the mailbox
     set fid [ open $mbox r ]
     set data [ read $fid [ file size $mbox ] ]
     close $fid

     ;## first line should be first line of first header
     set data [ split $data \n ]

     while { [ llength $data ] } {
        set header {}
        set body   {}

        while { ! [ regexp {^$} [ lindex $data 0 ] ] } {
           append header "[ lindex $data 0     ]\n"
           set data      [ lrange $data 1 end ]
        }

        while { ! [ regexp {^From }      [ lindex $data 0 ] ] && \
                ! [ regexp {^Received: } [ lindex $data 1 ] ] && \
                ! [ regexp {^     }      [ lindex $data 2 ] ] } {
           append body "[ lindex $data 0     ]\n"
           set data    [ lrange $data 1 end ]
           if { [ llength $data ] == 0 } { break }
        }
        lappend headers $header
        lappend bodies  $body
     }

     return [ list $headers $bodies ]
 }

 ## Returns the oldest valid (maybe) IP address
 ## in the header from a spam

 proc sender { header } {
     set header [ split $header \n ]
     foreach line $header {
        regexp {Received:.+\[([\.\d]+)\]} $line -> IP
     }
     return $IP
 }

# forward and reverse nslookup
 proc nslookup { host } {
     set data {}
     set rx {Name: ([^\s]+) Address: ([^\s]+)}

     set nslookup [ auto_execok nslookup ]

     set data [ exec nslookup $host ]

     regsub -all {[\s\t\r\n]+} $data { } data
     regexp -nocase $rx $data -> hostname ipaddress

     if { [ string equal $host $ipaddress ] } {
        set retval $hostname
     } else {
        set retval $ipaddress
     }

     set retval
 }

Holy Moly! Three Viagra and one Nigeria this morning...

EE: Added a space to the end of {^From } and {^Received: } regular expressions. 2002 October 6.

Category Mail