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