7616d8d8b2873ed3138ef820fc603964ea62482d
3 # Copyright (c) 2012-2015, The Trusted Domain Project. All rights reserved.
5 # Script to generate regular DMARC reports.
19 use Net
::Domain
qw(hostfqdn hostdomain);
22 use IO
::Compress
::Zip
qw(zip);
29 require HTTP
::Request
;
32 my $progname = basename
($0);
33 my $version = "1.3.1";
105 my $report_maxbytes_global = 15728640; # default: 15M, per spec
117 my $def_dbhost = "localhost";
118 my $def_dbname = "opendmarc";
119 my $def_dbuser = "opendmarc";
120 my $def_dbpasswd = "opendmarc";
121 my $def_dbport = "3306";
122 my $def_interval = "86400";
129 my $dbscheme = "mysql";
131 my $repdom = hostdomain
();
132 my $repemail = "postmaster@" . $repdom;
134 my $smtp_server = '127.0.0.1';
141 ### NO user-serviceable parts beyond this point
146 print STDERR
"$progname: usage: $progname [options]\n";
147 print STDERR
"\t--day send yesterday's data\n";
148 print STDERR
"\t--dbhost=host database host [$def_dbhost]\n";
149 print STDERR
"\t--dbname=name database name [$def_dbname]\n";
150 print STDERR
"\t--dbpasswd=passwd database password [$def_dbpasswd]\n";
151 print STDERR
"\t--dbport=port database port [$def_dbport]\n";
152 print STDERR
"\t--dbuser=user database user [$def_dbuser]\n";
153 print STDERR
"\t--domain=name force a report for named domain\n";
154 print STDERR
"\t--help print help and exit\n";
155 print STDERR
"\t--interval=secs report interval [$def_interval]\n";
156 print STDERR
"\t--keepfiles keep xml files (in local directory)\n";
157 print STDERR
"\t -n synonym for --test\n";
158 print STDERR
"\t--nodomain=name omit a report for named domain\n";
159 print STDERR
"\t--noupdate don't record report transmission\n";
160 print STDERR
"\t--report-email reporting contact [$repemail]\n";
161 print STDERR
"\t--report-org reporting organization [$repdom]\n";
162 print STDERR
"\t--smtp-port smtp server port [$smtp_port]\n";
163 print STDERR
"\t--smtp-server smtp server [$smtp_server]\n";
164 print STDERR
"\t--test don't send reports\n";
165 print STDERR
"\t--utc operate in UTC\n";
166 print STDERR
"\t (implies --keepfiles --noupdate)\n";
167 print STDERR
"\t--verbose verbose output\n";
168 print STDERR
"\t (repeat for increased output)\n";
169 print STDERR
"\t--version print version and exit\n";
173 setlocale
(LC_ALL
, 'C');
175 # parse command line arguments
176 my $opt_retval = &Getopt
::Long
::GetOptions
('day!' => \
$daybound,
177 'dbhost=s' => \
$dbhost,
178 'dbname=s' => \
$dbname,
179 'dbpasswd=s' => \
$dbpasswd,
180 'dbport=s' => \
$dbport,
181 'dbuser=s' => \
$dbuser,
182 'domain=s' => \
$forcedomain,
183 'help!' => \
$helponly,
184 'interval=i' => \
$interval,
185 'keepfiles' => \
$keepfiles,
186 'n|test' => \
$testmode,
187 'nodomain=s' => \
@skipdomains,
188 'report-email=s' => \
$repemail,
189 'report-org=s' => \
$repdom,
190 'smtp-server=s' => \
$smtp_server,
191 'smtp-port=i' => \
$smtp_port,
192 'update!' => \
$doupdate,
194 'verbose+' => \
$verbose,
195 'version!' => \
$showversion,
198 if (!$opt_retval || $helponly)
214 print STDOUT
"$progname v$version\n";
219 if (!defined($dbhost))
221 if (defined($ENV{'OPENDMARC_DBHOST'}))
223 $dbhost = $ENV{'OPENDMARC_DBHOST'};
227 $dbhost = $def_dbhost;
231 if (!defined($dbname))
233 if (defined($ENV{'OPENDMARC_DB'}))
235 $dbname = $ENV{'OPENDMARC_DB'};
239 $dbname = $def_dbname;
243 if (!defined($dbpasswd))
245 if (defined($ENV{'OPENDMARC_PASSWORD'}))
247 $dbpasswd = $ENV{'OPENDMARC_PASSWORD'};
251 $dbpasswd = $def_dbpasswd;
255 if (!defined($dbport))
257 if (defined($ENV{'OPENDMARC_PORT'}))
259 $dbport = $ENV{'OPENDMARC_PORT'};
263 $dbport = $def_dbport;
267 if (!defined($dbuser))
269 if (defined($ENV{'OPENDMARC_USER'}))
271 $dbuser = $ENV{'OPENDMARC_USER'};
275 $dbuser = $def_dbuser;
279 if (!defined($interval))
281 $interval = $def_interval;
284 # Test mode requested, don't update last sent and keep xml files
285 $doupdate = ($testmode == 1) ?
0 : $doupdate;
286 $keepfiles = ($testmode == 1) ?
1 : $keepfiles;
290 print STDERR
"$progname: started at " . localtime() . "\n";
293 my $dbi_dsn = "DBI:" . $dbscheme . ":database=" . $dbname .
294 ";host=" . $dbhost . ";port=" . $dbport;
296 $dbi_h = DBI
->connect($dbi_dsn, $dbuser, $dbpasswd, { PrintError
=> 0 });
297 if (!defined($dbi_h))
299 print STDERR
"$progname: unable to connect to database: $DBI::errstr\n";
305 print STDERR
"$progname: connected to database\n";
310 $dbi_s = $dbi_h->prepare("SET TIME_ZONE='+00:00'");
312 if (!$dbi_s->execute())
314 print STDERR
"$progname: failed to change to UTC: " . $dbi_h->errstr . "\n";
322 # Select domains on which to report
329 print STDERR
"$progname: selecting target domains\n";
332 if (defined($forcedomain))
334 $dbi_s = $dbi_h->prepare("SELECT name FROM domains WHERE name = ?");
336 if (!$dbi_s->execute($forcedomain))
338 print STDERR
"$progname: failed to test for database entry: " . $dbi_h->errstr . "\n";
346 $dbi_s = $dbi_h->prepare("SELECT domains.name FROM requests JOIN domains ON requests.domain = domains.id WHERE DATE(lastsent) < DATE(FROM_UNIXTIME(?))");
348 if (!$dbi_s->execute($now))
350 print STDERR
"$progname: failed to collect domain names: " . $dbi_h->errstr . "\n";
358 $dbi_s = $dbi_h->prepare("SELECT domains.name FROM requests JOIN domains ON requests.domain = domains.id WHERE lastsent <= DATE_SUB(FROM_UNIXTIME(?), INTERVAL ? SECOND)");
360 if (!$dbi_s->execute($now, $interval))
362 print STDERR
"$progname: failed to collect domain names: " . $dbi_h->errstr . "\n";
369 $domainset = $dbi_s->fetchall_arrayref([0]);
374 print STDERR
"$progname: selected " . scalar(@
$domainset) . " domain(s)\n";
379 # -- extract reporting address
380 # -- extract messages/signatures to report
381 # -- generate and send report
382 # -- update "last sent" timestamp
385 $smtp = Net
::SMTP
->new($smtp_server,
386 'Port' => $smtp_port,
387 'Helo' => hostfqdn
());
390 print STDERR
"$progname: open SMTP server $smtp_server:$smtp_port failed\n";
394 foreach (@
$domainset)
398 if (!defined($domain))
403 if (@skipdomains && grep({$_ eq $domain} @skipdomains) != 0)
410 print STDERR
"$progname: processing $domain\n";
413 # extract this domain's reporting parameters
414 $dbi_s = $dbi_h->prepare("SELECT id FROM domains WHERE name = ?");
415 if (!$dbi_s->execute($domain))
417 print STDERR
"$progname: can't get ID for domain $domain: " . $dbi_h->errstr . "\n";
424 while ($dbi_a = $dbi_s->fetchrow_arrayref())
426 if (defined($dbi_a->[0]))
428 $domainid = $dbi_a->[0];
433 if (!defined($domainid))
435 print STDERR
"$progname: ID for domain $domain not found\n";
439 $dbi_s = $dbi_h->prepare("SELECT repuri, adkim, aspf, policy, spolicy, pct, UNIX_TIMESTAMP(lastsent) FROM requests WHERE domain = ?");
440 if (!$dbi_s->execute($domainid))
442 print STDERR
"$progname: can't get reporting URI for domain $domain: " . $dbi_h->errstr . "\n";
450 while ($dbi_a = $dbi_s->fetchrow_arrayref())
452 if (defined($dbi_a->[0]))
454 $repuri = $dbi_a->[0];
456 if (defined($dbi_a->[1]))
458 $adkim = $dbi_a->[1];
460 if (defined($dbi_a->[2]))
464 if (defined($dbi_a->[3]))
466 $policy = $dbi_a->[3];
468 if (defined($dbi_a->[4]))
470 $spolicy = $dbi_a->[4];
472 if (defined($dbi_a->[5]))
476 if (defined($dbi_a->[6]))
478 $lastsent = $dbi_a->[6];
484 if (!defined($repuri) || ("" eq $repuri))
488 print STDERR
"$progname: no reporting URI for domain $domain; skipping\n";
494 # construct the temporary file
495 $repfile = $repdom . "!" . $domain . "!" . $lastsent . "!" . time() . ".xml";
496 $zipfile = $repdom . "!" . $domain . "!" . $lastsent . "!" . time() . ".zip";
497 if (!open($tmpout, ">", $repfile))
499 print STDERR
"$progname: can't create report file for domain $domain\n";
505 case
ord("r") { $adkimstr = "r"; }
506 case
ord("s") { $adkimstr = "s"; }
507 else { $adkimstr = "unknown"; }
512 case
ord("r") { $aspfstr = "r"; }
513 case
ord("s") { $aspfstr = "s"; }
514 else { $aspfstr = "unknown"; }
519 case
ord("n") { $policystr = "none"; }
520 case
ord("q") { $policystr = "quarantine"; }
521 case
ord("r") { $policystr = "reject"; }
522 else { $policystr = "unknown"; }
527 case
ord("n") { $spolicystr = "none"; }
528 case
ord("q") { $spolicystr = "quarantine"; }
529 case
ord("r") { $spolicystr = "reject"; }
534 $dbi_s = $dbi_h->prepare("SELECT UNIX_TIMESTAMP(MIN(date)), UNIX_TIMESTAMP(MAX(date)) FROM messages WHERE from_domain = ? AND DATE(date) >= DATE(FROM_UNIXTIME(?)) AND DATE(date) < DATE(FROM_UNIXTIME(?))");
538 $dbi_s = $dbi_h->prepare("SELECT UNIX_TIMESTAMP(MIN(date)), UNIX_TIMESTAMP(MAX(date)) FROM messages WHERE from_domain = ? AND UNIX_TIMESTAMP(date) > ? AND UNIX_TIMESTAMP(date) <= ?");
541 if (!$dbi_s->execute($domainid, $lastsent, $now))
543 print STDERR
"$progname: can't extract begin/end times for domain $domain: " . $dbi_h->errstr . "\n";
552 while ($dbi_a = $dbi_s->fetchrow_arrayref())
554 if (defined($dbi_a->[0]))
556 $repstart = $dbi_a->[0];
558 if (defined($dbi_a->[1]))
560 $repend = $dbi_a->[1];
566 print $tmpout "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
567 print $tmpout "<feedback>\n";
569 print $tmpout " <report_metadata>\n";
570 print $tmpout " <org_name>$repdom</org_name>\n";
571 print $tmpout " <email>$repemail</email>\n";
572 print $tmpout " <report_id>$domain:$now</report_id>\n";
573 print $tmpout " <date_range>\n";
574 print $tmpout " <begin>$repstart</begin>\n";
575 print $tmpout " <end>$repend</end>\n";
576 print $tmpout " </date_range>\n";
577 print $tmpout " </report_metadata>\n";
579 print $tmpout " <policy_published>\n";
580 print $tmpout " <domain>$domain</domain>\n";
581 print $tmpout " <adkim>$adkimstr</adkim>\n";
582 print $tmpout " <aspf>$aspfstr</aspf>\n";
583 print $tmpout " <p>$policystr</p>\n";
584 if (defined($spolicystr))
586 print $tmpout " <sp>$spolicystr</sp>\n";
588 print $tmpout " <pct>$pct</pct>\n";
589 print $tmpout " </policy_published>\n";
593 $dbi_s = $dbi_h->prepare("SELECT messages.id, ipaddr.addr, messages.disp, d1.name, d2.name, messages.spf, messages.align_spf, messages.align_dkim FROM messages JOIN ipaddr ON messages.ip = ipaddr.id JOIN domains d1 ON messages.from_domain = d1.id JOIN domains d2 ON messages.env_domain = d2.id WHERE messages.from_domain = ? AND DATE(messages.date) >= DATE(FROM_UNIXTIME(?)) AND DATE(messages.date) < DATE(FROM_UNIXTIME(?))");
597 $dbi_s = $dbi_h->prepare("SELECT messages.id, ipaddr.addr, messages.disp, d1.name, d2.name, messages.spf, messages.align_spf, messages.align_dkim FROM messages JOIN ipaddr ON messages.ip = ipaddr.id JOIN domains d1 ON messages.from_domain = d1.id JOIN domains d2 ON messages.env_domain = d2.id WHERE messages.from_domain = ? AND messages.date > FROM_UNIXTIME(?) AND messages.date <= FROM_UNIXTIME(?)");
600 if (!$dbi_s->execute($domainid, $lastsent, $now))
602 print STDERR
"$progname: can't extract report for domain $domain: " . $dbi_h->errstr . "\n";
610 while ($dbi_a = $dbi_s->fetchrow_arrayref())
614 if (defined($dbi_a->[0]))
616 $msgid = $dbi_a->[0];
618 if (defined($dbi_a->[1]))
620 $ipaddr = $dbi_a->[1];
622 if (defined($dbi_a->[2]))
626 if (defined($dbi_a->[3]))
628 $fromdomain = $dbi_a->[3];
630 if (defined($dbi_a->[4]))
632 $envdomain = $dbi_a->[4];
634 if (defined($dbi_a->[5]))
636 $spfresult = $dbi_a->[5];
638 if (defined($dbi_a->[6]))
640 $align_spf = $dbi_a->[6];
642 if (defined($dbi_a->[7]))
644 $align_dkim = $dbi_a->[7];
647 if (!defined($msgid))
656 case
0 { $dispstr = "reject"; }
657 case
1 { $dispstr = "reject"; }
658 case
2 { $dispstr = "none"; }
659 case
4 { $dispstr = "quarantine"; }
660 else { $dispstr = "unknown"; }
665 case
0 { $spfresultstr = "pass"; }
666 case
2 { $spfresultstr = "softfail"; }
667 case
3 { $spfresultstr = "neutral"; }
668 case
4 { $spfresultstr = "temperror"; }
669 case
5 { $spfresultstr = "permerror"; }
670 case
6 { $spfresultstr = "none"; }
671 case
7 { $spfresultstr = "fail"; }
672 case
8 { $spfresultstr = "policy"; }
673 case
9 { $spfresultstr = "nxdomain"; }
674 case
10 { $spfresultstr = "signed"; }
675 case
12 { $spfresultstr = "discard"; }
676 else { $spfresultstr = "unknown"; }
681 case
4 { $align_dkimstr = "pass"; }
682 case
5 { $align_dkimstr = "fail"; }
683 else { $align_dkimstr = "unknown"; }
688 case
4 { $align_spfstr = "pass"; }
689 case
5 { $align_spfstr = "fail"; }
690 else { $align_spfstr = "unknown"; }
693 print $tmpout " <record>\n";
694 print $tmpout " <row>\n";
695 print $tmpout " <source_ip>$ipaddr</source_ip>\n";
696 print $tmpout " <count>1</count>\n";
697 print $tmpout " <policy_evaluated>\n";
698 print $tmpout " <disposition>$dispstr</disposition>\n";
699 print $tmpout " <dkim>$align_dkimstr</dkim>\n";
700 print $tmpout " <spf>$align_spfstr</spf>\n";
701 print $tmpout " </policy_evaluated>\n";
702 print $tmpout " </row>\n";
703 print $tmpout " <identifiers>\n";
704 print $tmpout " <header_from>$fromdomain</header_from>\n";
705 print $tmpout " </identifiers>\n";
706 print $tmpout " <auth_results>\n";
707 print $tmpout " <spf>\n";
708 print $tmpout " <domain>$envdomain</domain>\n";
709 print $tmpout " <result>$spfresultstr</result>\n";
710 print $tmpout " </spf>\n";
712 $dbi_d = $dbi_h->prepare("SELECT domains.name, pass FROM signatures JOIN domains ON signatures.domain = domains.id WHERE signatures.message = ?");
713 if (!$dbi_d->execute($msgid))
715 print STDERR
"$progname: can't extract report for message $msgid: " . $dbi_h->errstr . "\n";
722 while ($dbi_a = $dbi_d->fetchrow_arrayref())
726 if (defined($dbi_a->[0]))
728 $dkimdomain = $dbi_a->[0];
730 if (defined($dbi_a->[1]))
732 $dkimresult = $dbi_a->[1];
736 if (!defined($dkimdomain))
743 case
0 { $dkimresultstr = "pass"; }
744 case
2 { $dkimresultstr = "softfail"; }
745 case
3 { $dkimresultstr = "neutral"; }
746 case
4 { $dkimresultstr = "temperror"; }
747 case
5 { $dkimresultstr = "permerror"; }
748 case
6 { $dkimresultstr = "none"; }
749 case
7 { $dkimresultstr = "fail"; }
750 case
8 { $dkimresultstr = "policy"; }
751 case
9 { $dkimresultstr = "nxdomain"; }
752 case
10 { $dkimresultstr = "signed"; }
753 case
12 { $dkimresultstr = "discard"; }
754 else { $dkimresultstr = "unknown"; }
757 print $tmpout " <dkim>\n";
758 print $tmpout " <domain>$dkimdomain</domain>\n";
759 print $tmpout " <result>$dkimresultstr</result>\n";
760 print $tmpout " </dkim>\n";
765 print $tmpout " </auth_results>\n";
766 print $tmpout " </record>\n";
771 print $tmpout "</feedback>\n";
779 print STDERR
"$progname: no activity selected for $domain; skipping\n";
787 if (!zip
[ $repfile ] => $zipfile)
789 print STDERR
"$progname: can't zip report for domain $domain: $!\n";
795 print STDERR
"$progname: keeping report file \"$repfile\"\n";
799 @repuris = split(',', $repuri);
801 for $repuri (@repuris)
803 $uri = URI
->new($repuri);
804 if (!defined($uri) ||
805 !defined($uri->scheme) ||
808 print STDERR
"$progname: can't parse reporting URI for domain $domain\n";
814 $repdest = $uri->opaque;
815 my $report_maxbytes = $report_maxbytes_global;
817 # check for max report size
818 if ($repdest =~ m/^(\S+)!(\d{1,15})([kmgt])?$/i)
821 $report_maxbytes = $2;
827 $report_maxbytes = $report_maxbytes * 1024;
831 $report_maxbytes = $report_maxbytes * 1048576;
835 $report_maxbytes = $report_maxbytes * (2**30);
839 $report_maxbytes = $report_maxbytes * (2**40);
844 # Test mode, just report what would have been done
847 print STDERR
"$progname: would email $domain report for " .
848 "$rowcount records to " . $uri->opaque . "\n";
850 # ensure a scheme is present
851 elsif (!defined($uri->scheme))
855 print STDERR
"$progname: unknown URI scheme in '$repuri' for domain $domain\n";
863 elsif ($uri->scheme eq "mailto")
868 if (!open($zipin, $zipfile))
870 print STDERR
"$progname: can't read zipped report for $domain: $!\n";
876 $boundary = "report_section";
878 $report_id = $domain . "-" . $now . "@" . $repdom;
879 $datestr = strftime
("%a, %e %b %Y %H:%M:%S %z (%Z)",
882 $mailout = "To: $repdest\n";
883 $mailout .= "From: $repemail\n";
884 $mailout .= "Subject: Report Domain: " . $domain . " Submitter: " . $repdom . " Report-ID: " . $report_id . "\n";
885 $mailout .= "X-Mailer: " . $progname . " v" . $version ."\n";
886 $mailout .= "Date: " . $datestr . "\n";
887 $mailout .= "Message-ID: <$report_id>\n";
888 $mailout .= "Auto-Submitted: auto-generated\n";
889 $mailout .= "MIME-Version: 1.0\n";
890 $mailout .= "Content-Type: multipart/mixed; boundary=\"$boundary\"\n";
892 $mailout .= "This is a MIME-encapsulated message.\n";
894 $mailout .= "--$boundary\n";
895 $mailout .= "Content-Type: text/plain;\n";
897 $mailout .= "This is a DMARC aggregate report for $domain\n";
898 $mailout .= "generated at " . localtime() . "\n";
900 $mailout .= "--$boundary\n";
901 $mailout .= "Content-Type: application/zip\n";
902 $mailout .= "Content-Disposition: attachment; filename=\"$zipfile\"\n";
903 $mailout .= "Content-Transfer-Encoding: base64\n";
906 while (read($zipin, $buf, 60*57))
908 $mailout .= encode_base64
($buf);
912 $mailout .= "--$boundary--\n";
913 my $reportsize = length($mailout);
915 if ($reportsize > $report_maxbytes)
917 # XXX -- generate an error report here
918 print STDERR
"$progname: report was too large ($reportsize bytes) per limitation of URI " . $uri->opaque . " for domain $domain\n";
922 $smtpstatus = "sent";
924 if (!$smtp->mail($repemail) ||
925 !$smtp->to($repdest) ||
927 !$smtp->datasend($mailout) ||
931 $smtpstatus = "failed to send";
934 if ($verbose || $smtpfail)
937 $answer = ${${*$smtp}{'net_cmd_resp'}}[1];
939 print STDERR
"$progname: $smtpstatus report for $domain to $repdest ($answer)\n";
949 print STDERR
"$progname: unsupported reporting URI scheme " . $uri->scheme . " for domain $domain\n";
956 # update "last sent" timestamp
959 $dbi_s = $dbi_h->prepare("UPDATE requests SET lastsent = FROM_UNIXTIME(?) WHERE domain = ?");
960 if (!$dbi_s->execute($now, $domainid))
962 print STDERR
"$progname: can't update last sent time for domain $domain: " . $dbi_h->errstr . "\n";
986 print STDERR
"$progname: terminating at " . localtime() . "\n";