#Modules
use strict;
use Net::POP3;
use MIME::Parser;
use Shell;
use DBI;
use HTTP::Date;
use MessageData; #Hand written data structure object to hold Message data
#use XML::Parser; #A perl module for parsing XML documents
#use XML::Stream; #Creates and XML Stream connection and parses return data
#use XML::Writer; #thinking about implementing XML in the future to avoid character escape problems.
#use IO::File;
#use Mail::IMAPClient; In Future for moving messages around in the store
#MIME Tools Settings
MIME::Tools->debugging(0);
MIME::Tools->quiet(0);
my $host = "somepopserver";
my $port = "110";
my $user = "someuser";
my $pass = "123456";
my $dbUser = "user";
my $dbPass = "pass";
my $knetUser = "user";
my $knetPass = "pass";
my $pop_server = Net::POP3->new($host); #Use POP3 Protocol
#my $imap_server = Mail::IMAPClient->new(Server => $host,User => $user, Password => $pass) or die "IMAP connect Failed $@\n"; #use IMAP protocol
my $mime_parser = new MIME::Parser;
$mime_parser->output_to_core(1); # keep in memory
$mime_parser->decode_headers(1);#Variables
my $fdnnt40 = DBI->connect('DBI:Sybase:server=fdnnt40', $dbUser, $dbPasswd);
my $tema1 = DBI->connect('DBI:Sybase:server=tema-1',$knetUser,$knetPass);
#Win32 Only
#my $DSN = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=ketemanetDB;Data Source=tema-1";
#my $localConn = Win32::OLE->new("ADODB.Connection"); #connection to local SQL Server
#$localConn->Open($DSN);
$pop_server->login($user, $pass) or die "Login Failed @{[$pop_server->message]}\n";
my $messages = $pop_server->list();
my $msgData = new MessageData(); # make new message data object
my @msgArray = [];
my $indexCounter = 0;
#this subroutine goes through a message until
# all its body parts are dissected and printed
sub getAttachments {
my $numAttachments = $_[0]->parts;
print "This message has $numAttachments attachments\n";
for (my $i = 0; $i < $numAttachments; $i++) {
my $attachment = $_[0]->parts($i);
#print the attachment preamble
my $lineCounter = 0;
my $att_preamble = $attachment->preamble;
foreach (@$att_preamble) {
$msgData->{"attachmentdata"} = $msgData->{"attachmentdata"}."$$att_preamble[$lineCounter++]\n";
}
$lineCounter = 0;
#print the attachment header
my $att_header = $attachment->head;
$msgData->{"attachmentdata"} = $msgData->{"attachmentdata"}.$att_header->as_string;
#print the body
my $att_body = $attachment->bodyhandle;
if (defined($att_body)) {
$msgData->{"attachmentdata"} = $msgData->{"attachmentdata"}.$att_body->as_string;
#print $msgData->{"attachmentdata"}."\n";
$msgData->{"attachmentdata"} =~ s/'/''/mg;
#$msgData->{"attachmentdata"} =~ s/&/$ordValue/mg;
}
if ($attachment->parts() > 0) {
getAttachments($attachment)
}
}
print "Exiting getAttachments Subroutine\n";
}
sub upLoad {
foreach my $record (@msgArray) {
#my $xmldoc = "
#$record->{"msgid"}
#$record->{"subject"}
#$record->{"sourceip"}
#$record->{"from"}
#$record->{"to"}
#$record->{"allheaders"}
#$record->{"preamble"}
#$record->{"body"}
#$record->{"receiveddate"}
#$record->{"attachmentdata"}
#";
#$xmlRecord = $xmlRecord.$xmldoc;
my $executeSQL = "INSERT INTO FDNMail (msgid,subject,sourceip,sourcednsname,[from],[to],allheaders,preamble,body,receiveddate,attachmentdata,
custnum,[X-AOLIP]) VALUES ('".$record->{"msgid"}."','".$record->{"subject"}."','".$record->{"sourceip"}."','".$record->{"sourcednsname"}.
"','".$record->{"from"}."','".$record->{"to"}."','".$record->{"allheaders"}."','".$record->{"preamble"}."','".$record->{"body"}.
"','".$record->{"receiveddate"}."','".$record->{"attachmentdata"}."','".$record->{"custnum"}."','".$record->{"xaolip"}."')";
my $action = $tema1->prepare($executeSQL);
eval($action->execute);
if ($@) {
print "$_\n";
}
}
}
#Loop through Each Message, Parse it, Store it, and Figure out who sent it
if( $messages ) {
#get the key ids of messages in the hash
my $numMessages = keys %$messages;
print "there are $numMessages total messages:\n";
while(my ($msgid, $size) = each %$messages) {
my $fh = $pop_server->getfh($msgid);
my $mime_entity = $mime_parser->parse($fh);
#my $ordValue = ord("&"); Need this when dealing with XML
#print the preamble
my $lineCounter = 0;
my $preamble = $mime_entity->preamble;
foreach (@$preamble) {
$msgData->{"preamble"} = $msgData->{"preamble"} . "$$preamble[$lineCounter++]";
$msgData->{"preamble"} =~ s/'/''/mg;
#$msgData->{"preamble"} =~ s/&/$ordValue/mg;
#$msgData->{"preamble"} =~ s/{"preamble"} =~ s/>/>/mg;
}
$lineCounter = 0;
#print the header
my $header = $mime_entity->head;
$msgData->{"allheaders"} = $header->as_string;
$msgData->{"allheaders"} =~ s/'/''/mg;
#$msgData->{"allheaders"} =~ s/&/$ordValue/mg;
#$msgData->{"allheaders"} =~ s/{"allheaders"} =~ s/>/>/mg;
$msgData->{"msgid"} = $header->get('Message-Id');
$msgData->{"msgid"} =~ s/'/''/mg;
#$msgData->{"msgid"} =~ s/&/$ordValue/mg;
#$msgData->{"msgid"} =~ s/{"msgid"} =~ s/>/>/mg;
$msgData->{"subject"} = $header->get('Subject');
$msgData->{"subject"} =~ s/'/''/mg;
chop($msgData->{"subject"});
#$msgData->{"subject"} =~ s/&/$ordValue/mg;
#$msgData->{"subject"} =~ s/{"subject"} =~ s/>/>/mg;
$msgData->{"from"} = $header->get('From');
$msgData->{"from"} =~ s/'/''/mg;
#$msgData->{"from"} =~ s/&/$ordValue/mg;
#$msgData->{"from"} =~ s/{"from"} =~ s/>/>/mg;
$msgData->{"to"} = $header->get('To');
$msgData->{"to"} =~ s/'/''/mg;
#$msgData->{"to"} =~ s/&/$ordValue/mg;
#$msgData->{"to"} =~ s/{"to"} =~ s/>/>/mg;
$msgData->{"receiveddate"} = HTTP::Date::time2iso(str2time($header->get('Date')));
#print the body
my $body = $mime_entity->bodyhandle;
if (defined($body)) {
$msgData->{"body"} = $body->as_string;
$msgData->{"body"} =~ s/'/''/mg;
#$msgData->{"body"} =~ s/&/$ordValue/mg;
#keep this check here also incase the format of the aol messages changes
if ($msgData->{"subject"} eq "Client TOS Notification" && $msgData->{"body"} =~ /X-AOL-IP: [0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}/m){
$msgData->{"xaolip"} = $&;
}
}
#get any attachments and print those
if ($mime_entity->parts() > 0) {
getAttachments($mime_entity);
}
#after we have all the attachmetn data, many of the messages from AOL appear inthe body, but actually have the offender IP in the
#attachment data, find it, and put it in its own column
if ($msgData->{"subject"} eq "Client TOS Notification" && $msgData->{"attachmentdata"} =~ /X-AOL-IP: [0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}/m){
my $aolLine = $&;
$aolLine =~ /[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}/m;
$msgData->{"xaolip"} = $&;
}
#figure out the source IP of the message sender
#first we will take a look at where the message actually came from, then we attempt to determine what FDN customer the message is talking about
#messages with an X-AOL-IP field will just be looked up, others we have to search the body of the message for an FDN IP. We wil take teh first match until
#better rules are formulated to determine whom the message is taking about. I can implement rules for MyNetwatchman in addition to the aol reports.
my $firstSender = $header->get('Received', $header->count('Received') - 1);
if($firstSender =~ /([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/m) {
$msgData->{"sourceip"} = $1;
}
elsif ($firstSender =~ /from.*by [\w\-\.]*[\s\S]/m) { #reading the first Received Header line
my $sender = $&;
my @fromBy = split(/ /,$sender);
my $firstHop = hostx( substr($fromBy[1],0,length($fromBy[1]) - 2) );
my $secondHop = hostx( $fromBy[2]);
if ($firstHop =~ /([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/m) {
$firstHop = $&;
my @octets = split(/\./, "$&");
my $custNum = "";
if ($octets[0] == '216' && $octets[1] == '199') {
my $commandString = "SELECT netaddr1,netaddr2,netaddr3,netaddr4,assignedto,rqst_no
FROM ( SELECT *
FROM dbo.IPMAP
WHERE (netaddr3 = '$octets[2]')
)as temptable
WHERE netaddr4 = '$octets[3]'";
my $commandString2 = "SELECT top 1 netaddr1,netaddr2,netaddr3,netaddr4,assignedto,rqst_no
FROM ( SELECT *
FROM dbo.IPMAP
WHERE (netaddr3 = '$octets[2]')
)as temptable
WHERE netaddr4 <= '$octets[3]'
ORDER BY netaddr4 desc";
my $action = $fdnnt40->prepare($commandString);
$action->execute;
my @rows = $action->fetchrow_array;
die "Open Failed: $@" if $@;
if (@rows == 0) {
$action = $fdnnt40->prepare($commandString2);
$action->execute;
@rows = $action->fetchrow_array;
if (@rows == 0) {
$custNum = "NOT A CUSTOMER IP";
}
else {
my $fieldnum = 0;
$custNum = $rows[4];
}
}
else {
$custNum = $rows[4];
}
}
$msgData->{"sourceip"} = $&;
$msgData->{"sourcednsname"} = substr($fromBy[1],0,length($fromBy[1]) - 2);
$msgData->{"custnum"} = $custNum;
}
elsif ($secondHop =~ /([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/m) {
$secondHop = $&;
my @octets = split(/\./, "$&");
my $custNum = "";
if ($octets[0] == '216' && $octets[1] == '199') {
my $commandString = "SELECT netaddr1,netaddr2,netaddr3,netaddr4,assignedto,rqst_no
FROM ( SELECT *
FROM dbo.IPMAP
WHERE (netaddr3 = '$octets[2]')
)as temptable
WHERE netaddr4 = '$octets[3]'";
my $commandString2 = "SELECT top 1 netaddr1,netaddr2,netaddr3,netaddr4,assignedto,rqst_no
FROM ( SELECT *
FROM dbo.IPMAP
WHERE (netaddr3 = '$octets[2]')
)as temptable
WHERE netaddr4 <= '$octets[3]'
ORDER BY netaddr4 desc";
my $action = $fdnnt40->prepare($commandString);
$action->execute;
my @rows = $action->fetchrow_array;
die "Open Failed: $@" if $@;
if (@rows == 0) {
$action = $fdnnt40->prepare($commandString2);
$action->execute;
@rows = $action->fetchrow_array;
if (@rows == 0) {
$custNum = "Invalid customer IP";
}
else {
my $fieldnum = 0;
$custNum = $rows[4];
}
}
else {
$custNum = $rows[4];
}
}
$msgData->{"sourceip"} = $&;
$msgData->{"sourcednsname"} = $fromBy[2];
$msgData->{"custnum"} = $custNum;
}
}
else {
$msgData->{"sourceip"} = "fraudsuspect";
$msgData->{"custnum"} = "Invalid customer IP";
}
if ($msgData->{"xaolip"} ne "" && $msgData->{"custnum"} eq "Invalid customer IP") {
my @octets = split(/\./, $msgData->{"xaolip"});
my $custNum = "";
if ($octets[0] == '216' && $octets[1] == '199') {
my $commandString = "SELECT netaddr1,netaddr2,netaddr3,netaddr4,assignedto,rqst_no
FROM ( SELECT *
FROM dbo.IPMAP
WHERE (netaddr3 = '$octets[2]')
)as temptable
WHERE netaddr4 = '$octets[3]'";
my $commandString2 = "SELECT top 1 netaddr1,netaddr2,netaddr3,netaddr4,assignedto,rqst_no
FROM ( SELECT *
FROM dbo.IPMAP
WHERE (netaddr3 = '$octets[2]')
)as temptable
WHERE netaddr4 <= '$octets[3]'
ORDER BY netaddr4 desc";
my $action = $fdnnt40->prepare($commandString);
$action->execute;
my @rows = $action->fetchrow_array;
die "Open Failed: $@" if $@;
if (@rows == 0) {
$action = $fdnnt40->prepare($commandString2);
$action->execute;
@rows = $action->fetchrow_array;
if (@rows == 0) {
$custNum = "Invalid customer IP";
}
else {
my $fieldnum = 0;
$custNum = $rows[4];
}
}
else {
$custNum = $rows[4];
}
}
$msgData->{"custnum"} = $custNum;
}
#add this hash to array of items to be uploaded to database, so we don't have multiple calls to the DB
$msgArray[$indexCounter++] = $msgData;
#added to control amount of messages in local array. Explicitly destroying array and recreating it.
undef($msgData);
if ($indexCounter >= 10) {
upLoad();
splice(@msgArray,0,scalar(@msgArray));
print "Uploaded $indexCounter messages to database\n";
$indexCounter = 0;
}
print $indexCounter."\n";
}
}
$pop_server->quit();
#now we should have an array of MessageData Items. let's build our single Insert statement and make one call to the database to upload
#add this message as a xml record
#will perform this later. For now Insert Each Record individually as text data.
#my $xmlRecord = "'";
#$xmlRecord = $xmlRecord."'";
#win32only
#eval ($localConn->Execute("addMail($xmlRecord)"));
# if (Win32::OLE->LastError()) {
# open DEBUG, ">C:\\Documents and Settings\\Administrator\\My Documents\\Perl Programs\\popmailbox\\debug.txt";
# print DEBUG "---------------------------------------------------------------------------------------\n";
# print DEBUG Win32::OLE->LastError()."\n";
# print DEBUG "---------------------------------------------------------------------------------------\n";
# print DEBUG "-----------------END OF SQL STATEMENT---------------------------\n\n";
# print DEBUG "$xmlRecord\n";
# }
#close DEBUG;
print "Message Data uploaded to database";
1