SpamMap

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!!

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