Public Repository for SpamMap Development
## 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...