usr/sbin/opendmarc-reports

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (c) 2012-2015, The Trusted Domain Project.  All rights reserved.
   4 #
   5 # Script to generate regular DMARC reports.
   6
   7 ###
   8 ### Setup
   9 ###
  10
  11 use strict;
  12 use warnings;
  13
  14 use Switch;
  15
  16 use DBI;
  17 use File::Basename;
  18 use File::Temp;
  19 use Net::Domain qw(hostfqdn hostdomain);
  20 use Getopt::Long;
  21 use IO::Handle;
  22 use IO::Compress::Zip qw(zip);
  23 use POSIX;
  24 use MIME::Base64;
  25 use Net::SMTP;
  26
  27 require DBD::mysql;
  28
  29 require HTTP::Request;
  30
  31 # general
  32 my $progname      = basename($0);
  33 my $version       = "1.3.1";
  34 my $verbose       = 0;
  35 my $helponly      = 0;
  36 my $showversion   = 0;
  37
  38 my $interval;
  39
  40 my $gen;
  41 my $uri;
  42
  43 my $buf;
  44
  45 my $mailout;
  46 my $boundary;
  47
  48 my $tmpout;
  49
  50 my $repfile;
  51 my $zipfile;
  52
  53 my $zipin;
  54
  55 my $now;
  56
  57 my $repstart;
  58 my $repend;
  59
  60 my $domain;
  61 my $domainid;
  62 my $domainset;
  63 my $forcedomain;
  64 my @skipdomains;
  65
  66 my $policy;
  67 my $spolicy;
  68 my $policystr;
  69 my $spolicystr;
  70 my $pct;
  71
  72 my $repuri;
  73 my @repuris;
  74 my $lastsent;
  75
  76 my $aspf;
  77 my $aspfstr;
  78 my $adkim;
  79 my $adkimstr;
  80 my $align_dkim;
  81 my $align_dkimstr;
  82 my $align_spf;
  83 my $align_spfstr;
  84 my $spfresult;
  85 my $dkimresult;
  86 my $disp;
  87 my $spfresultstr;
  88 my $dkimresultstr;
  89 my $dispstr;
  90 my $ipaddr;
  91 my $fromdomain;
  92 my $envdomain;
  93 my $dkimdomain;
  94
  95 my $repdest;
  96
  97 my $smtpstatus;
  98 my $smtpfail;
  99
 100 my $doupdate = 1;
 101 my $testmode = 0;
 102 my $keepfiles = 0;
 103 my $use_utc = 0;
 104 my $daybound = 0;
 105 my $report_maxbytes_global = 15728640; # default: 15M, per spec
 106
 107 my $msgid;
 108
 109 my $rowcount;
 110
 111 my $dbi_s;
 112 my $dbi_h;
 113 my $dbi_a;
 114 my $dbi_d;
 115
 116 # DB parameters
 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";
 123 my $dbhost;
 124 my $dbname;
 125 my $dbuser;
 126 my $dbpasswd;
 127 my $dbport;
 128
 129 my $dbscheme     = "mysql";
 130
 131 my $repdom       = hostdomain();
 132 my $repemail     = "postmaster@" . $repdom;
 133
 134 my $smtp_server  = '127.0.0.1';
 135 my $smtp_port    = 25;
 136 my $smtp;
 137
 138 my $answer;
 139
 140 ###
 141 ### NO user-serviceable parts beyond this point
 142 ###
 143
 144 sub usage
 145 {
 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";
 170 }
 171
 172 # set locale
 173 setlocale(LC_ALL, 'C');
 174
 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,
 193                                             'utc!' => \$use_utc,
 194                                             'verbose+' => \$verbose,
 195                                             'version!' => \$showversion,
 196                                            );
 197
 198 if (!$opt_retval || $helponly)
 199 {
 200         usage();
 201
 202         if ($helponly)
 203         {
 204                 exit(0);
 205         }
 206         else
 207         {
 208                 exit(1);
 209         }
 210 }
 211
 212 if ($showversion)
 213 {
 214         print STDOUT "$progname v$version\n";
 215         exit(0);
 216 }
 217
 218 # apply defaults
 219 if (!defined($dbhost))
 220 {
 221         if (defined($ENV{'OPENDMARC_DBHOST'}))
 222         {
 223                 $dbhost = $ENV{'OPENDMARC_DBHOST'};
 224         }
 225         else
 226         {
 227                 $dbhost = $def_dbhost;
 228         }
 229 }
 230
 231 if (!defined($dbname))
 232 {
 233         if (defined($ENV{'OPENDMARC_DB'}))
 234         {
 235                 $dbname = $ENV{'OPENDMARC_DB'};
 236         }
 237         else
 238         {
 239                 $dbname = $def_dbname;
 240         }
 241 }
 242
 243 if (!defined($dbpasswd))
 244 {
 245         if (defined($ENV{'OPENDMARC_PASSWORD'}))
 246         {
 247                 $dbpasswd = $ENV{'OPENDMARC_PASSWORD'};
 248         }
 249         else
 250         {
 251                 $dbpasswd = $def_dbpasswd;
 252         }
 253 }
 254
 255 if (!defined($dbport))
 256 {
 257         if (defined($ENV{'OPENDMARC_PORT'}))
 258         {
 259                 $dbport = $ENV{'OPENDMARC_PORT'};
 260         }
 261         else
 262         {
 263                 $dbport = $def_dbport;
 264         }
 265 }
 266
 267 if (!defined($dbuser))
 268 {
 269         if (defined($ENV{'OPENDMARC_USER'}))
 270         {
 271                 $dbuser = $ENV{'OPENDMARC_USER'};
 272         }
 273         else
 274         {
 275                 $dbuser = $def_dbuser;
 276         }
 277 }
 278
 279 if (!defined($interval))
 280 {
 281         $interval = $def_interval;
 282 }
 283
 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;
 287
 288 if ($verbose)
 289 {
 290         print STDERR "$progname: started at " . localtime() . "\n";
 291 }
 292
 293 my $dbi_dsn = "DBI:" . $dbscheme . ":database=" . $dbname .
 294               ";host=" . $dbhost . ";port=" . $dbport;
 295
 296 $dbi_h = DBI->connect($dbi_dsn, $dbuser, $dbpasswd, { PrintError => 0 });
 297 if (!defined($dbi_h))
 298 {
 299         print STDERR "$progname: unable to connect to database: $DBI::errstr\n";
 300         exit(1);
 301 }
 302
 303 if ($verbose >= 2)
 304 {
 305         print STDERR "$progname: connected to database\n";
 306 }
 307
 308 if ($use_utc)
 309 {
 310         $dbi_s = $dbi_h->prepare("SET TIME_ZONE='+00:00'");
 311
 312         if (!$dbi_s->execute())
 313         {
 314                 print STDERR "$progname: failed to change to UTC: " . $dbi_h->errstr . "\n";
 315                 $dbi_s->finish;
 316                 $dbi_h->disconnect;
 317                 exit(1);
 318         }
 319 }
 320
 321 #
 322 # Select domains on which to report
 323 #
 324
 325 $now = time();
 326
 327 if ($verbose >= 2)
 328 {
 329         print STDERR "$progname: selecting target domains\n";
 330 }
 331
 332 if (defined($forcedomain))
 333 {
 334         $dbi_s = $dbi_h->prepare("SELECT name FROM domains WHERE name = ?");
 335
 336         if (!$dbi_s->execute($forcedomain))
 337         {
 338                 print STDERR "$progname: failed to test for database entry: " . $dbi_h->errstr . "\n";
 339                 $dbi_s->finish;
 340                 $dbi_h->disconnect;
 341                 exit(1);
 342         }
 343 }
 344 elsif ($daybound)
 345 {
 346         $dbi_s = $dbi_h->prepare("SELECT domains.name FROM requests JOIN domains ON requests.domain = domains.id WHERE DATE(lastsent) < DATE(FROM_UNIXTIME(?))");
 347
 348         if (!$dbi_s->execute($now))
 349         {
 350                 print STDERR "$progname: failed to collect domain names: " . $dbi_h->errstr . "\n";
 351                 $dbi_s->finish;
 352                 $dbi_h->disconnect;
 353                 exit(1);
 354         }
 355 }
 356 else
 357 {
 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)");
 359
 360         if (!$dbi_s->execute($now, $interval))
 361         {
 362                 print STDERR "$progname: failed to collect domain names: " . $dbi_h->errstr . "\n";
 363                 $dbi_s->finish;
 364                 $dbi_h->disconnect;
 365                 exit(1);
 366         }
 367 }
 368
 369 $domainset = $dbi_s->fetchall_arrayref([0]);
 370 $dbi_s->finish;
 371
 372 if ($verbose)
 373 {
 374         print STDERR "$progname: selected " . scalar(@$domainset) . " domain(s)\n";
 375 }
 376
 377 #
 378 # For each domain:
 379 #       -- extract reporting address
 380 #       -- extract messages/signatures to report
 381 #       -- generate and send report
 382 #       -- update "last sent" timestamp
 383 #
 384
 385 $smtp = Net::SMTP->new($smtp_server,
 386                        'Port' => $smtp_port,
 387                        'Hello' => hostfqdn());
 388 if (!defined($smtp))
 389 {
 390         print STDERR "$progname: open SMTP server $smtp_server:$smtp_port failed\n";
 391         exit(1);
 392 }
 393
 394 foreach (@$domainset)
 395 {
 396         $domain = $_->[0];
 397
 398         if (!defined($domain))
 399         {
 400                 next;
 401         }
 402
 403         if (@skipdomains && grep({$_ eq $domain} @skipdomains) != 0)
 404         {
 405                 next;
 406         }
 407
 408         if ($verbose >= 2)
 409         {
 410                 print STDERR "$progname: processing $domain\n";
 411         }
 412
 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))
 416         {
 417                 print STDERR "$progname: can't get ID for domain $domain: " . $dbi_h->errstr . "\n";
 418                 $dbi_s->finish;
 419                 $dbi_h->disconnect;
 420                 exit(1);
 421         }
 422
 423         undef $domainid;
 424         while ($dbi_a = $dbi_s->fetchrow_arrayref())
 425         {
 426                 if (defined($dbi_a->[0]))
 427                 {
 428                         $domainid = $dbi_a->[0];
 429                 }
 430         }
 431         $dbi_s->finish;
 432
 433         if (!defined($domainid))
 434         {
 435                 print STDERR "$progname: ID for domain $domain not found\n";
 436                 next;
 437         }
 438
 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))
 441         {
 442                 print STDERR "$progname: can't get reporting URI for domain $domain: " . $dbi_h->errstr . "\n";
 443                 $dbi_s->finish;
 444                 $dbi_h->disconnect;
 445                 exit(1);
 446         }
 447
 448         undef $repuri;
 449
 450         while ($dbi_a = $dbi_s->fetchrow_arrayref())
 451         {
 452                 if (defined($dbi_a->[0]))
 453                 {
 454                         $repuri = $dbi_a->[0];
 455                 }
 456                 if (defined($dbi_a->[1]))
 457                 {
 458                         $adkim = $dbi_a->[1];
 459                 }
 460                 if (defined($dbi_a->[2]))
 461                 {
 462                         $aspf = $dbi_a->[2];
 463                 }
 464                 if (defined($dbi_a->[3]))
 465                 {
 466                         $policy = $dbi_a->[3];
 467                 }
 468                 if (defined($dbi_a->[4]))
 469                 {
 470                         $spolicy = $dbi_a->[4];
 471                 }
 472                 if (defined($dbi_a->[5]))
 473                 {
 474                         $pct = $dbi_a->[5];
 475                 }
 476                 if (defined($dbi_a->[6]))
 477                 {
 478                         $lastsent = $dbi_a->[6];
 479                 }
 480         }
 481
 482         $dbi_s->finish;
 483
 484         if (!defined($repuri) || ("" eq $repuri))
 485         {
 486                 if ($verbose >= 2)
 487                 {
 488                         print STDERR "$progname: no reporting URI for domain $domain; skipping\n";
 489                 }
 490
 491                 next;
 492         }
 493
 494         # construct the temporary file
 495         $repfile = $repdom . "!" . $domain . "!" . $lastsent . "!" . time() . ".xml";
 496         $zipfile = $repdom . "!" . $domain . "!" . $lastsent . "!" . time() . ".zip";
 497         if (!open($tmpout, ">", $repfile))
 498         {
 499                 print STDERR "$progname: can't create report file for domain $domain\n";
 500                 next;
 501         }
 502
 503         switch ($adkim)
 504         {
 505                 case ord("r")   { $adkimstr = "r"; }
 506                 case ord("s")   { $adkimstr = "s"; }
 507                 else            { $adkimstr = "unknown"; }
 508         }
 509
 510         switch ($aspf)
 511         {
 512                 case ord("r")   { $aspfstr = "r"; }
 513                 case ord("s")   { $aspfstr = "s"; }
 514                 else            { $aspfstr = "unknown"; }
 515         }
 516
 517         switch ($policy)
 518         {
 519                 case ord("n")   { $policystr = "none"; }
 520                 case ord("q")   { $policystr = "quarantine"; }
 521                 case ord("r")   { $policystr = "reject"; }
 522                 else            { $policystr = "unknown"; }
 523         }
 524
 525         switch ($spolicy)
 526         {
 527                 case ord("n")   { $spolicystr = "none"; }
 528                 case ord("q")   { $spolicystr = "quarantine"; }
 529                 case ord("r")   { $spolicystr = "reject"; }
 530         }
 531
 532         if ($daybound)
 533         {
 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(?))");
 535         }
 536         else
 537         {
 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) <= ?");
 539         }
 540
 541         if (!$dbi_s->execute($domainid, $lastsent, $now))
 542         {
 543                 print STDERR "$progname: can't extract begin/end times for domain $domain: " . $dbi_h->errstr . "\n";
 544                 $dbi_s->finish;
 545                 $dbi_h->disconnect;
 546                 exit(1);
 547         }
 548
 549         $repstart = 0;
 550         $repend = $now;
 551
 552         while ($dbi_a = $dbi_s->fetchrow_arrayref())
 553         {
 554                 if (defined($dbi_a->[0]))
 555                 {
 556                         $repstart = $dbi_a->[0];
 557                 }
 558                 if (defined($dbi_a->[1]))
 559                 {
 560                         $repend = $dbi_a->[1];
 561                 }
 562         }
 563
 564         $dbi_s->finish;
 565
 566         print $tmpout "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
 567         print $tmpout "<feedback>\n";
 568
 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";
 578
 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))
 585         {
 586                 print $tmpout "  <sp>$spolicystr</sp>\n";
 587         }
 588         print $tmpout "  <pct>$pct</pct>\n";
 589         print $tmpout " </policy_published>\n";
 590
 591         if ($daybound)
 592         {
 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(?))");
 594         }
 595         else
 596         {
 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(?)");
 598         }
 599
 600         if (!$dbi_s->execute($domainid, $lastsent, $now))
 601         {
 602                 print STDERR "$progname: can't extract report for domain $domain: " . $dbi_h->errstr . "\n";
 603                 $dbi_s->finish;
 604                 $dbi_h->disconnect;
 605                 exit(1);
 606         }
 607
 608         $rowcount = 0;
 609
 610         while ($dbi_a = $dbi_s->fetchrow_arrayref())
 611         {
 612                 undef $msgid;
 613
 614                 if (defined($dbi_a->[0]))
 615                 {
 616                         $msgid = $dbi_a->[0];
 617                 }
 618                 if (defined($dbi_a->[1]))
 619                 {
 620                         $ipaddr = $dbi_a->[1];
 621                 }
 622                 if (defined($dbi_a->[2]))
 623                 {
 624                         $disp = $dbi_a->[2];
 625                 }
 626                 if (defined($dbi_a->[3]))
 627                 {
 628                         $fromdomain = $dbi_a->[3];
 629                 }
 630                 if (defined($dbi_a->[4]))
 631                 {
 632                         $envdomain = $dbi_a->[4];
 633                 }
 634                 if (defined($dbi_a->[5]))
 635                 {
 636                         $spfresult = $dbi_a->[5];
 637                 }
 638                 if (defined($dbi_a->[6]))
 639                 {
 640                         $align_spf = $dbi_a->[6];
 641                 }
 642                 if (defined($dbi_a->[7]))
 643                 {
 644                         $align_dkim = $dbi_a->[7];
 645                 }
 646
 647                 if (!defined($msgid))
 648                 {
 649                         next;
 650                 }
 651
 652                 $rowcount++;
 653
 654                 switch ($disp)
 655                 {
 656                         case 0  { $dispstr = "reject"; }
 657                         case 1  { $dispstr = "reject"; }
 658                         case 2  { $dispstr = "none"; }
 659                         case 4  { $dispstr = "quarantine"; }
 660                         else    { $dispstr = "unknown"; }
 661                 }
 662
 663                 switch ($spfresult)
 664                 {
 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"; }
 677                 }
 678
 679                 switch ($align_dkim)
 680                 {
 681                         case 4  { $align_dkimstr = "pass"; }
 682                         case 5  { $align_dkimstr = "fail"; }
 683                         else    { $align_dkimstr = "unknown"; }
 684                 }
 685
 686                 switch ($align_spf)
 687                 {
 688                         case 4  { $align_spfstr = "pass"; }
 689                         case 5  { $align_spfstr = "fail"; }
 690                         else    { $align_spfstr = "unknown"; }
 691                 }
 692
 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";
 711
 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))
 714                 {
 715                         print STDERR "$progname: can't extract report for message $msgid: " . $dbi_h->errstr . "\n";
 716                         $dbi_s->finish;
 717                         $dbi_d->finish;
 718                         $dbi_h->disconnect;
 719                         exit(1);
 720                 }
 721
 722                 while ($dbi_a = $dbi_d->fetchrow_arrayref())
 723                 {
 724                         undef $dkimdomain;
 725
 726                         if (defined($dbi_a->[0]))
 727                         {
 728                                 $dkimdomain = $dbi_a->[0];
 729                         }
 730                         if (defined($dbi_a->[1]))
 731                         {
 732                                 $dkimresult = $dbi_a->[1];
 733                         }
 734
 735
 736                         if (!defined($dkimdomain))
 737                         {
 738                                 next;
 739                         }
 740
 741                         switch ($dkimresult)
 742                         {
 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"; }
 755                         }
 756
 757                         print $tmpout "   <dkim>\n";
 758                         print $tmpout "    <domain>$dkimdomain</domain>\n";
 759                         print $tmpout "    <result>$dkimresultstr</result>\n";
 760                         print $tmpout "   </dkim>\n";
 761                 }
 762
 763                 $dbi_d->finish;
 764
 765                 print $tmpout "  </auth_results>\n";
 766                 print $tmpout " </record>\n";
 767         }
 768
 769         $dbi_s->finish;
 770
 771         print $tmpout "</feedback>\n";
 772
 773         close($tmpout);
 774
 775         if ($rowcount == 0)
 776         {
 777                 if ($verbose >= 2)
 778                 {
 779                         print STDERR "$progname: no activity selected for $domain; skipping\n";
 780                 }
 781
 782                 unlink($repfile);
 783                 next;
 784         }
 785
 786         # zip the report
 787         if (!zip [ $repfile ] => $zipfile)
 788         {
 789                 print STDERR "$progname: can't zip report for domain $domain: $!\n";
 790                 next;
 791         }
 792
 793         if ($keepfiles)
 794         {
 795                 print STDERR "$progname: keeping report file \"$repfile\"\n";
 796         }
 797
 798         # decode the URI
 799         @repuris = split(',', $repuri);
 800
 801         for $repuri (@repuris)
 802         {
 803                 $uri = URI->new($repuri);
 804                 if (!defined($uri) ||
 805                     !defined($uri->scheme) ||
 806                     $uri->opaque eq "")
 807                 {
 808                         print STDERR "$progname: can't parse reporting URI for domain $domain\n";
 809                         unlink($zipfile);
 810                         unlink($repfile);
 811                         next;
 812                 }
 813
 814                 $repdest = $uri->opaque;
 815                 my $report_maxbytes = $report_maxbytes_global;
 816
 817                 # check for max report size
 818                 if ($repdest =~ m/^(\S+)!(\d{1,15})([kmgt])?$/i)
 819                 {
 820                         $repdest = $1;
 821                         $report_maxbytes = $2;
 822                         if ($3)
 823                         {
 824                                 my $letter = lc($3);
 825                                 if ($letter eq 'k')
 826                                 {
 827                                         $report_maxbytes = $report_maxbytes * 1024;
 828                                 }
 829                                 if ($letter eq 'm')
 830                                 {
 831                                         $report_maxbytes = $report_maxbytes * 1048576;
 832                                 }
 833                                 if ($letter eq 'g')
 834                                 {
 835                                         $report_maxbytes = $report_maxbytes * (2**30);
 836                                 }
 837                                 if ($letter eq 't')
 838                                 {
 839                                         $report_maxbytes = $report_maxbytes * (2**40);
 840                                 }
 841                         }
 842                 }
 843
 844                 # Test mode, just report what would have been done
 845                 if ($testmode)
 846                 {
 847                         print STDERR "$progname: would email $domain report for " .
 848                                      "$rowcount records to " .  $uri->opaque . "\n";
 849                 }
 850                 # ensure a scheme is present
 851                 elsif (!defined($uri->scheme))
 852                 {
 853                         if ($verbose >= 2)
 854                         {
 855                                 print STDERR "$progname: unknown URI scheme in '$repuri' for domain $domain\n";
 856                         }
 857
 858                         unlink($zipfile);
 859                         unlink($repfile);
 860                         next;
 861                 }
 862                 # send/post report
 863                 elsif ($uri->scheme eq "mailto")
 864                 {
 865                         my $datestr;
 866                         my $report_id;
 867
 868                         if (!open($zipin, $zipfile))
 869                         {
 870                                 print STDERR "$progname: can't read zipped report for $domain: $!\n";
 871                                 unlink($zipfile);
 872                                 unlink($repfile);
 873                                 next;
 874                         }
 875
 876                         $boundary = "report_section";
 877
 878                         $report_id = $domain . "-" . $now . "@" . $repdom;
 879                         $datestr = strftime("%a, %e %b %Y %H:%M:%S %z (%Z)",
 880                                             localtime);
 881
 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";
 891                         $mailout .= "\n";
 892                         $mailout .= "This is a MIME-encapsulated message.\n";
 893                         $mailout .= "\n";
 894                         $mailout .= "--$boundary\n";
 895                         $mailout .= "Content-Type: text/plain;\n";
 896                         $mailout .= "\n";
 897                         $mailout .= "This is a DMARC aggregate report for $domain\n";
 898                         $mailout .= "generated at " . localtime() . "\n";
 899                         $mailout .= "\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";
 904                         $mailout .= "\n";
 905
 906                         while (read($zipin, $buf, 60*57))
 907                         {
 908                                 $mailout .= encode_base64($buf);
 909                         }
 910
 911                         $mailout .= "\n";
 912                         $mailout .= "--$boundary--\n";
 913                         my $reportsize = length($mailout);
 914
 915                         if ($reportsize > $report_maxbytes)
 916                         {
 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";
 919                         }
 920                         else
 921                         {
 922                                 $smtpstatus = "sent";
 923                                 $smtpfail = 0;
 924                                 if (!$smtp->mail($repemail) ||
 925                                     !$smtp->to($repdest) ||
 926                                     !$smtp->data() ||
 927                                     !$smtp->datasend($mailout) ||
 928                                     !$smtp->dataend())
 929                                 {
 930                                         $smtpfail = 1;
 931                                         $smtpstatus = "failed to send";
 932                                 }
 933
 934                                 if ($verbose || $smtpfail)
 935                                 {
 936                                         # now perl voodoo:
 937                                         $answer = ${${*$smtp}{'net_cmd_resp'}}[1];
 938                                         $answer = $smtp->message() if (!defined($answer));
 939                                         chomp($answer);
 940                                         print STDERR "$progname: $smtpstatus report for $domain to $repdest ($answer)\n";
 941                                 }
 942                         }
 943
 944                         $smtp->reset();
 945
 946                         close($zipin);
 947                 }
 948                 else
 949                 {
 950                         print STDERR "$progname: unsupported reporting URI scheme " . $uri->scheme . " for domain $domain\n";
 951                         unlink($zipfile);
 952                         unlink($repfile);
 953                         next;
 954                 }
 955         }
 956
 957         # update "last sent" timestamp
 958         if ($doupdate)
 959         {
 960                 $dbi_s = $dbi_h->prepare("UPDATE requests SET lastsent = FROM_UNIXTIME(?) WHERE domain = ?");
 961                 if (!$dbi_s->execute($now, $domainid))
 962                 {
 963                         print STDERR "$progname: can't update last sent time for domain $domain: " . $dbi_h->errstr . "\n";
 964                         $dbi_s->finish;
 965                         $dbi_h->disconnect;
 966                         exit(1);
 967                 }
 968         }
 969
 970         unlink($zipfile);
 971         if (!$keepfiles)
 972         {
 973                 unlink($repfile);
 974         }
 975 }
 976
 977 $smtp->quit();
 978
 979 #
 980 # all done!
 981 #
 982
 983 $dbi_s->finish;
 984
 985 if ($verbose)
 986 {
 987         print STDERR "$progname: terminating at " . localtime() . "\n";
 988 }
 989
 990 $dbi_h->disconnect;
 991
 992 exit(0);