diff --git b/reports/opendmarc-reports.in a/reports/opendmarc-reports.in index 43be1ff..fff9f8d 100755 --- b/reports/opendmarc-reports.in +++ a/reports/opendmarc-reports.in @@ -24,6 +24,8 @@ use POSIX; use MIME::Base64; use Net::SMTP; use Time::Local; +use Net::DNS; +use Domain::PublicSuffix; require DBD::@SQL_BACKEND@; @@ -39,7 +41,6 @@ my $showversion = 0; my $interval; my $gen; -my $uri; my $buf; @@ -95,8 +96,6 @@ my $dkimdomain; my $reason; my $comment; -my $repdest; - my $smtpstatus; my $smtpfail; @@ -140,6 +139,18 @@ my $smtp; my $answer; +my $suffix; +my $publicsuffixlist = "/etc/opendmarc/public_suffix_list.dat"; +if (-r $publicsuffixlist) { + $suffix = Domain::PublicSuffix->new( + { 'data_file' => $publicsuffixlist } + ); +} +else +{ + $suffix = Domain::PublicSuffix->new(); +} + ### ### NO user-serviceable parts beyond this point ### @@ -172,6 +183,71 @@ sub usage print STDERR "\t--version print version and exit\n"; } +sub check_size_restriction +{ + my ($destination, $size) = @_; + my $report_maxbytes = $report_maxbytes_global; + + # check for max report size + if ($destination =~ m/^(\S+)!(\d{1,15})([kmgt])?$/i) + { + $destination = $1; + $report_maxbytes = $2; + if ($3) + { + my $letter = lc($3); + if ($letter eq 'k') + { + $report_maxbytes = $report_maxbytes * 1024; + } + if ($letter eq 'm') + { + $report_maxbytes = $report_maxbytes * 1048576; + } + if ($letter eq 'g') + { + $report_maxbytes = $report_maxbytes * (2**30); + } + if ($letter eq 't') + { + $report_maxbytes = $report_maxbytes * (2**40); + } + } + + if ($size > $report_maxbytes) + { + return 0; + } + } + return 1; +} + +sub check_uri +{ + my $uri = URI->new($_[0]); + if (!defined($uri) || + !defined($uri->scheme) || + $uri->opaque eq "") + { + print STDERR "$progname: can't parse reporting URI for domain $domain\n"; + return ""; + } + # ensure a scheme is present + elsif (!defined($uri->scheme)) + { + if ($verbose >= 2) + { + print STDERR "$progname: unknown URI scheme in '$repuri' for domain $domain\n"; + } + return ""; + } + elsif ($uri->scheme eq "mailto") + { + return $uri->opaque; + } + return ""; +} + # set locale setlocale(LC_ALL, 'C'); @@ -798,86 +874,181 @@ foreach (@$domainset) print STDERR "$progname: keeping report file \"$repfile\"\n"; } + if (!open($zipin, $zipfile)) + { + print STDERR "$progname: can't read zipped report for $domain: $!\n"; + next; + } + my $encoded_report; + while (read($zipin, $buf, 60*57)) + { + $encoded_report .= encode_base64($buf); + } + close($zipin); + my $reportsize = length($encoded_report); + + my $repdest = ""; + my $repdest_fallback = ""; + # decode the URI @repuris = split(',', $repuri); for $repuri (@repuris) { - $uri = URI->new($repuri); - if (!defined($uri) || - !defined($uri->scheme) || - $uri->opaque eq "") + my $raw_address = check_uri($repuri); + if ($raw_address eq "") { - print STDERR "$progname: can't parse reporting URI for domain $domain\n"; next; } - - $repdest = $uri->opaque; - my $report_maxbytes = $report_maxbytes_global; - - # check for max report size - if ($repdest =~ m/^(\S+)!(\d{1,15})([kmgt])?$/i) + else { - $repdest = $1; - $report_maxbytes = $2; - if ($3) + my $domain_orgdom = $suffix->get_root_domain(lc($domain)); + my $address = $raw_address; + $address =~ s/!\d{1,15}([kmgt])?$//i; + my $repdestdomain = $address; + $repdestdomain =~ s/.*@//; + my $repdest_orgdom = $suffix->get_root_domain(lc($repdestdomain)); + + if (defined($domain_orgdom) && defined($repdest_orgdom) && $domain_orgdom eq $repdest_orgdom) + { + if (check_size_restriction($raw_address, $reportsize)) + { + $repdest .= $address . ", "; + } + else + { + $repdest_fallback .= $address . ", "; + } + } + else { - my $letter = lc($3); - if ($letter eq 'k') + # validate external report destinations: + my $replaced = 0; # external address replaced + my $authorized = 0; # external address authorized + my $temprepuri; + my $res = Net::DNS::Resolver->new(udp_timeout => 15); + my $reply = $res->query("$domain._report._dmarc.$repdestdomain", "TXT"); + if ($reply) { - $report_maxbytes = $report_maxbytes * 1024; + foreach my $txt ($reply->answer) + { + next unless $txt->type eq "TXT"; + my @parts = split(';', $txt->txtdata); + my $type = shift @parts; + next unless $type =~ m/^\s*v\s*=\s*DMARC1\s*/; + $authorized = 1; + # just for debugging: + if ($txt->txtdata ne "v=DMARC1") + { + print STDERR "$progname: DEBUG: $domain._report._dmarc.$repdestdomain: query answer: ", $txt->txtdata, "\n"; + } + foreach my $parts (@parts) + { + if ($parts =~ m/^\s*rua\s*=/) + { + $replaced = 1; + $parts =~ s/^\s*rua\s*=\s*//; + foreach my $tempuri (split(',', $parts)) + { + $raw_address = check_uri($tempuri); + if ($raw_address eq "") + { + next; + } + my $uridomain = lc($raw_address); + $uridomain =~ s/.*@//; + $uridomain =~ s/!\d{15}([kmgt])?$//; + if ($repdestdomain eq $uridomain) + { + $address =~ s/!\d([kmgt])?$//i; + if ($verbose) + { + print STDERR "$progname: adding new reporting URI for domain $domain: $address\n"; + } + if (check_size_restriction($raw_address, $reportsize)) + { + $repdest .= $address . ", "; + } + else + { + $repdest_fallback .= $address . ", "; + } + } + else + { + if ($verbose) + { + print STDERR "$progname: ignoring new reporting URI due to differing host parts: $repdestdomain != $uridomain!\n"; + } + } + } + # there should be only one part with "rua=", so stop here + last; + } + } + # there should be only one TXT record starting with "v=DMARC1", so stop here + last; + } } - if ($letter eq 'm') + else { - $report_maxbytes = $report_maxbytes * 1048576; + switch ($res->errorstring) + { + case "NXDOMAIN" { } # definitely not authorized + case "SERVFAIL" { $authorized = 1; } # not a definite answer, so be kind + case "query timed out" { $authorized = 1; } # not a definite answer, so be kind + else { $authorized = 1; } # for now we authorize anything else + } } - if ($letter eq 'g') + + if ($authorized && !$replaced) { - $report_maxbytes = $report_maxbytes * (2**30); + + $repdest .= $address . ", "; } - if ($letter eq 't') + elsif (!$authorized) { - $report_maxbytes = $report_maxbytes * (2**40); + if ($verbose) + { + print STDERR "$progname: $domain is NOT authorized to send reports to $address, dropping address! (" . $res->errorstring . ")\n"; + } + next; } } } + } + $repdest =~ s/, $//; + $repdest_fallback =~ s/, $//; - # Test mode, just report what would have been done - if ($testmode) + # Test mode, just report what would have been done + if ($testmode) + { + if ($repdest ne "") { print STDERR "$progname: would email $domain report for " . - "$rowcount records to " . $uri->opaque . "\n"; + "$rowcount records to $repdest\n"; } - # ensure a scheme is present - elsif (!defined($uri->scheme)) + elsif ($repdest_fallback ne "") { - if ($verbose >= 2) - { - print STDERR "$progname: unknown URI scheme in '$repuri' for domain $domain\n"; - } - next; + print STDERR "$progname: would email an error report for " . + "$domain to $repdest_fallback\n"; } - # send/post report - elsif ($uri->scheme eq "mailto") + } + else + { + if ($repdest ne "") { - my $datestr; - my $report_id; - - if (!open($zipin, $zipfile)) - { - print STDERR "$progname: can't read zipped report for $domain: $!\n"; - next; - } + # send out the report: + $boundary = hostfqdn() . "/" . time(); - $boundary = "report_section"; - - $report_id = $domain . "-" . $now . "@" . $repdom; - $datestr = strftime("%a, %e %b %Y %H:%M:%S %z (%Z)", - localtime); + my $report_id = $domain . "-" . $now . "@" . $repdom; + my $datestr = strftime("%a, %e %b %Y %H:%M:%S %z (%Z)", localtime); $mailout = "To: $repdest\n"; $mailout .= "From: $repemail\n"; - $mailout .= "Subject: Report Domain: " . $domain . " Submitter: " . $repdom . " Report-ID: " . $report_id . "\n"; + $mailout .= "Subject: Report Domain: " . $domain . "\n"; + $mailout .= " Submitter: " . $repdom . "\n"; + $mailout .= " Report-ID: " . $report_id . "\n"; $mailout .= "X-Mailer: " . $progname . " v" . $version ."\n"; $mailout .= "Date: " . $datestr . "\n"; $mailout .= "Message-ID: <$report_id>\n"; @@ -898,52 +1069,100 @@ foreach (@$domainset) $mailout .= "Content-Disposition: attachment; filename=\"$zipfile\"\n"; $mailout .= "Content-Transfer-Encoding: base64\n"; $mailout .= "\n"; + $mailout .= $encoded_report; + $mailout .= "\n"; + $mailout .= "--$boundary--\n"; + $smtpstatus = "sent"; + $smtpfail = 0; + if (!$smtp->mail($repemail) || + !$smtp->to(split(', ', $repdest), {SkipBad => 1 }) || + !$smtp->data() || + !$smtp->datasend($mailout) || + !$smtp->dataend()) + { + $smtpfail = 1; + $smtpstatus = "failed to send"; + } - while (read($zipin, $buf, 60*57)) + if ($verbose || $smtpfail) { - $mailout .= encode_base64($buf); + # now perl voodoo: + $answer = ${${*$smtp}{'net_cmd_resp'}}[1] || $smtp->message() || 'unknown error'; + chomp($answer); + print STDERR "$progname: $smtpstatus report for $domain to $repdest ($answer)\n"; } + $smtp->reset(); + } + elsif ($repdest_fallback ne "") + { + # send error report to $repdest_fallback: + if ($verbose) + { + print STDERR "$progname: emailing an error report for $domain to $repdest_fallback\n"; + } + $boundary = hostfqdn() . "/" . time(); + + my $report_id = $domain . "-" . $now . "@" . $repdom; + my $datestr = strftime("%a, %e %b %Y %H:%M:%S %z (%Z)", localtime); + + $mailout = "To: $repdest_fallback\n"; + $mailout .= "From: $repemail\n"; + $mailout .= "Subject: Error Report Domain: " . $domain . " Submitter: " . $repdom . " Report-ID: " . $report_id . "\n"; + $mailout .= "X-Mailer: " . $progname . " v" . $version ."\n"; + $mailout .= "Date: " . $datestr . "\n"; + $mailout .= "Message-ID: <$report_id>\n"; + $mailout .= "Auto-Submitted: auto-generated\n"; + $mailout .= "MIME-Version: 1.0\n"; + $mailout .= "Content-Type: multipart/report;\n"; + $mailout .= " report-type=delivery-status;\n"; + $mailout .= " boundary=\"$boundary\"\n"; + $mailout .= "\n"; + $mailout .= "This is a MIME-encapsulated message.\n"; + $mailout .= "\n"; + $mailout .= "--$boundary\n"; + $mailout .= "Content-Description: DMARC Notification\n"; + $mailout .= "Content-Type: text/plain\n"; + $mailout .= "\n"; + $mailout .= "This is a DMARC error report from host " . hostfqdn() . ".\n"; + $mailout .= "\n"; + $mailout .= "I'm sorry to have to inform you that a DMARC aggregate report\n"; + $mailout .= "could not be delivered to any of your URIs mentioned in your DMARC\n"; + $mailout .= "DNS resource records because of size limitations.\n"; + $mailout .= "\n"; + $mailout .= "--$boundary\n"; + $mailout .= "Content-Description: DMARC Error Report\n"; + $mailout .= "Content-Type: text/plain\n"; + $mailout .= "\n"; + $mailout .= "Report-Date: " . strftime("%a, %b %e %Y %H:%M:%S %z (%Z)", localtime()) . "\n"; + $mailout .= "Report-Domain: $domain\n"; + $mailout .= "Report-ID: $report_id\n"; + $mailout .= "Report-Size: $reportsize\n"; + $mailout .= "Submitter: $repdom\n"; + $mailout .= "Submitting-URI: $repdest_fallback\n"; $mailout .= "\n"; $mailout .= "--$boundary--\n"; - my $reportsize = length($mailout); - - if ($reportsize > $report_maxbytes) + $smtpstatus = "sent"; + $smtpfail = 0; + if (!$smtp->mail($repemail) || + !$smtp->to(split(', ', $repdest_fallback), { SkipBad => 1 }) || + !$smtp->data() || + !$smtp->datasend($mailout) || + !$smtp->dataend()) { - # XXX -- generate an error report here - print STDERR "$progname: report was too large ($reportsize bytes) per limitation of URI " . $uri->opaque . " for domain $domain\n"; + $smtpfail = 1; + $smtpstatus = "failed to send"; } - else - { - $smtpstatus = "sent"; - $smtpfail = 0; - if (!$smtp->mail($repemail) || - !$smtp->to($repdest) || - !$smtp->data() || - !$smtp->datasend($mailout) || - !$smtp->dataend()) - { - $smtpfail = 1; - $smtpstatus = "failed to send"; - } - if ($verbose || $smtpfail) - { - # now perl voodoo: - $answer = ${${*$smtp}{'net_cmd_resp'}}[1] || $smtp->message() || 'unknown error'; - chomp($answer); - print STDERR "$progname: $smtpstatus report for $domain to $repdest ($answer)\n"; - } + if ($verbose || $smtpfail) + { + # now perl voodoo: + $answer = ${${*$smtp}{'net_cmd_resp'}}[1] || $smtp->message() || 'unknown error'; + chomp($answer); + print STDERR "$progname: $smtpstatus failure notice for report for $domain to $repdest ($answer)\n"; } $smtp->reset(); - - close($zipin); - } - else - { - print STDERR "$progname: unsupported reporting URI scheme " . $uri->scheme . " for domain $domain\n"; - next; } }