#!/usr/bin/perl ####################################################### # Modified version of John Levine's rddmarc : http://www.taugh.com/rddmarc # ...to allow direct parsing of zip attachments ####################################################### use strict; use MIME::Parser; use XML::Simple; use DBI; my $dbh = DBI->connect("DBI:mysql:database=dmarc", "dmarc", "xxx") or die "Cannot connect to database\n"; foreach my $i (@ARGV) { print "parsing $i\n"; open(XML,"unzip -p " . $i . " |") or die "cannot unzip $i"; my $xml = ""; $xml .= $_ while ; close XML; my $xs = XML::Simple->new(); my $ref = $xs->XMLin($xml); my %xml = %{$ref}; print join "\n",keys %xml; print "\n"; my $from = $xml{'report_metadata'}->{'date_range'}->{'begin'}; my $to = $xml{'report_metadata'}->{'date_range'}->{'end'}; my $org = $xml{'report_metadata'}->{'org_name'}; my $id = $xml{'report_metadata'}->{'report_id'}; my $domain = $xml{'policy_published'}->{'domain'}; # see if already stored my ($xorg,$xid) = $dbh->selectrow_array(qq{SELECT org,reportid FROM report WHERE reportid=?}, undef, $id); if($xorg) { print "Already have $xorg $xid, skipped\n"; next; } my $sql = qq{INSERT INTO report(serial,mindate,maxdate,domain,org,reportid) VALUES(NULL,FROM_UNIXTIME(?),FROM_UNIXTIME(?),?,?,?)}; $dbh->do($sql, undef, $from, $to, $domain, $org, $id) or die "cannot make report" . $dbh->errstr; my $serial = $dbh->{'mysql_insertid'} || $dbh->{'insertid'}; print " serial $serial "; my $record = $xml{'record'}; sub dorow($$) { my ($serial,$recp) = @_; my %r = %$recp; my $ip = $r{'row'}->{'source_ip'}; print "ip $ip\n"; my $count = $r{'row'}->{'count'}; my $disp = $r{'row'}->{'policy_evaluated'}->{'disposition'}; my ($dkim, $dkimresult, $spf, $spfresult, $reason); my $rp = $r{'auth_results'}->{'dkim'}; if(ref $rp eq "HASH") { $dkim = $rp->{'domain'}; $dkim = undef if ref $dkim eq "HASH"; $dkimresult = $rp->{'result'}; } else { # array # glom sigs together, report first result $dkim = join '/',map { my $d = $_->{'domain'}; ref $d eq "HASH"?"": $d } @$rp; $dkimresult = $rp->[0]->{'result'}; } $rp = $r{'auth_results'}->{'spf'}; if(ref $rp eq "HASH") { $spf = $rp->{'domain'}; $spfresult = $rp->{'result'}; } else { # array # glom domains together, report first result $spf = join '/',map { my $d = $_->{'domain'}; ref $d eq "HASH"? "": $d } @$rp; $spfresult = $rp->[0]->{'result'}; } $rp = $r{'row'}->{'policy_evaluated'}->{'reason'}; if(ref $rp eq "HASH") { $reason = $rp->{'type'}; } else { $reason = join '/',map { $_->{'type'} } @$rp; } print "ip=$ip, count=$count, disp=$disp, r=$reason,"; print "dkim=$dkim/$dkimresult, spf=$spf/$spfresult\n"; $dbh->do(qq{INSERT INTO rptrecord(serial,ip,rcount,disposition,reason,dkimdomain,dkimresult,spfdomain,spfresult) VALUES(?,INET_ATON(?),?,?,?,?,?,?,?)},undef, $serial,$ip,$count,$disp,$reason,$dkim,$dkimresult,$spf,$spfresult) or die "cannot insert record " . $dbh->{'mysql_error'}; } if(ref $record eq "HASH") { print "single record\n"; dorow($serial,$record); } elsif(ref $record eq "ARRAY") { print "multi record\n"; foreach my $row (@$record) { dorow($serial,$row); } } else { print "mystery type " . ref($record) . "\n"; } }