diff options
author | Wolfgang Karall-Ahlborn <wolfgangkarall@users.noreply.github.com> | 2021-03-11 10:20:18 +0300 |
---|---|---|
committer | Wolfgang Karall-Ahlborn <wolfgangkarall@users.noreply.github.com> | 2021-03-11 10:20:18 +0300 |
commit | 73bbb0ff546a332e7d1953d6d76d392d2840857f (patch) | |
tree | ccd2f8d762c195b15a0017543b29994b0e4c4c8d | |
parent | 723467b5e1551fb4c10a6ab79f42c46418b49f04 (diff) |
Improve output of warnings and errors
Use $scriptname prefix, so identifying output is easier if run alongside
other software.
Use $org, $id or $subj to identify the problematic reports or messages
better. (passing $org and $id to sub dorow, as otherwise perl will complain
'variable $org will not stay shared ...')
Use warn for warnings instead of print, to get output to STDERR where it
belongs.
Remove $dbh->errstr from the messages, to avoid duplicating DBI's output.
(defaults to PrintErrors => 1)
-rwxr-xr-x | dmarcts-report-parser.pl | 119 |
1 files changed, 63 insertions, 56 deletions
diff --git a/dmarcts-report-parser.pl b/dmarcts-report-parser.pl index 90447e8..dffd41f 100755 --- a/dmarcts-report-parser.pl +++ b/dmarcts-report-parser.pl @@ -125,6 +125,9 @@ our ($debug, $delete_reports, $delete_failed, $reports_replace, $maxsize_xml, $c $maxsize_xml = 50000; $db_tx_support = 1; +# used in messages +my $scriptname = 'dmarcts-report-parser.pl'; + # Load script configuration options from local config file. The file is expected # to be in the current working directory. my $conf_file = 'dmarcts-report-parser.conf'; @@ -141,7 +144,7 @@ if ( -e $conf_file ) { $conf_file = ( File::Basename::dirname($0) . "/$conf_file" ); } else { show_usage(); - die "Could not read config file '$conf_file' from current working directory or path (" . File::Basename::dirname($0) . ')' + die "$scriptname: Could not read config file '$conf_file' from current working directory or path (" . File::Basename::dirname($0) . ')' } # load conf file with error handling @@ -149,12 +152,12 @@ if ( substr($conf_file, 0, 1) ne '/' and substr($conf_file, 0, 1) ne '.') { $conf_file = "./$conf_file"; } my $conf_return = do $conf_file; -die "couldn't parse $conf_file: $@" if $@; -die "couldn't do $conf_file: $!" unless defined $conf_return; +die "$scriptname: couldn't parse $conf_file: $@" if $@; +die "$scriptname: couldn't do $conf_file: $!" unless defined $conf_return; # check config if (!defined $imapreadfolder ) { - die "\$imapreadfolder not defined. Check config file"; + die "$scriptname: \$imapreadfolder not defined. Check config file"; } if (!defined $imapignoreerror ) { $imapignoreerror = 0; # maintain compatibility to old version @@ -195,21 +198,21 @@ if (exists $options{c}) { if ($source_options > 1) { show_usage(); - die "Only one source option can be used (-i, -x, -m, -e or -z).\n"; + die "$scriptname: Only one source option can be used (-i, -x, -m, -e or -z).\n"; } elsif ($source_options == 0) { show_usage(); - die "Please provide a source option (-i, -x, -m, -e or -z).\n"; + die "$scriptname: Please provide a source option (-i, -x, -m, -e or -z).\n"; } if ($ARGV[0]) { if ($reports_source == TS_IMAP) { show_usage(); - die "The IMAP source option (-i) may not be used together with a PATH.\n"; + die "$scriptname: The IMAP source option (-i) may not be used together with a PATH.\n"; } } else { if ($reports_source != TS_IMAP && $source_options == 1) { show_usage(); - die "The provided source option requires a PATH.\n"; + die "$scriptname: The provided source option requires a PATH.\n"; } } @@ -222,7 +225,7 @@ if (exists $options{info}) {$processInfo = 1;} # Setup connection to database server. my $dbh = DBI->connect("DBI:mysql:database=$dbname;host=$dbhost;port=$dbport", $dbuser, $dbpass) -or die "Cannot connect to database\n"; +or die "$scriptname: Cannot connect to database\n"; checkDatabase($dbh); @@ -258,7 +261,7 @@ if ($reports_source == TS_IMAP) { Socketargs => $socketargs ) # module uses eval, so we use $@ instead of $! - or die "IMAP Failure: $@"; + or die "$scriptname: IMAP Failure: $@"; # This connection is finished this way because of the tradgedy of exchange... $imap->User($imapuser); @@ -283,11 +286,11 @@ if ($reports_source == TS_IMAP) { if ($imap->message_count($imapreadfolder)) { # Select the mailbox to get messages from. $imap->select($imapreadfolder) - or die "IMAP Select Error: $!"; + or die "$scriptname: IMAP Select Error: $!"; # Store each message as an array element. my @msgs = $imap->search('ALL') - or die "Couldn't get all messages\n"; + or die "$scriptname: Couldn't get all messages\n"; # Loop through IMAP messages. foreach my $msg (@msgs) { @@ -306,7 +309,7 @@ if ($reports_source == TS_IMAP) { } elsif ($processResult & 2) { # processXML return a value with delete bit enabled. $imap->delete_message($msg) - or print "Could not delete IMAP message. [$@]\n"; + or warn "$scriptname: Could not delete IMAP message. [$@]\n"; } elsif ($imapmovefolder) { if ($processResult & 1 || !$imapmovefoldererr) { # processXML processed the XML OK, or it failed and there is no error imap folder @@ -328,7 +331,7 @@ if ($reports_source == TS_IMAP) { # We're all done with IMAP here. $imap->logout(); - if ( $debug || $processInfo ) { print "Processed $processedReport emails.\n"; } + if ( $debug || $processInfo ) { print "$scriptname: Processed $processedReport emails.\n"; } } else { # TS_MESSAGE_FILE or TS_XML_FILE or TS_MBOX_FILE @@ -353,7 +356,7 @@ if ($reports_source == TS_IMAP) { if (defined($filecontent)) { if (processXML(TS_MESSAGE_FILE, $filecontent, "message #$num of mbox file <$f>") & 2) { # processXML return a value with delete bit enabled - print "Removing message #$num from mbox file <$f> is not yet supported.\n"; + warn "$scriptname: Removing message #$num from mbox file <$f> is not yet supported.\n"; } $counts++; } @@ -387,11 +390,11 @@ if ($reports_source == TS_IMAP) { } $counts++; } else { - print "Unknown reports_source <$reports_source> for file <$f>. Skipped.\n"; + warn "$scriptname: Unknown reports_source <$reports_source> for file <$f>. Skipped.\n"; } } else { - print "Could not open file <$f>: $!. Skipped.\n"; + warn "$scriptname: Could not open file <$f>: $!. Skipped.\n"; # Could not retrieve filecontent, the skipped message # will be processed every time the script is run even if # delete_reports and delete_failed is given. The user @@ -399,7 +402,7 @@ if ($reports_source == TS_IMAP) { } } } - if ($debug || $processInfo) { print "Processed $counts messages(s).\n"; } + if ($debug || $processInfo) { print "$scriptname: Processed $counts messages(s).\n"; } } @@ -418,19 +421,19 @@ sub moveToImapFolder { # Try to create $imapfolder, if it does not exist. if (!$imap->exists($imapfolder)) { $imap->create($imapfolder) - or print "Could not create IMAP folder: $imapfolder.\n"; + or warn "$scriptname: Could not create IMAP folder: $imapfolder.\n"; } # Try to move the message to $imapfolder. my $newid = $imap->copy($imapfolder, [ $msg ]); if (!$newid) { - print "Error on moving (copy and delete) processed IMAP message: Could not COPY message to IMAP folder: <$imapfolder>!\n"; - print "Messsage will not be moved/deleted. [$@]\n"; + warn "$scriptname: Error on moving (copy and delete) processed IMAP message: Could not COPY message to IMAP folder: <$imapfolder>!\n"; + warn "$scriptname: Messsage will not be moved/deleted. [$@]\n"; } else { $imap->delete_message($msg) or do { - print "Error on moving (copy and delete) processed IMAP message: Could not DELETE message\n"; - print "after copying it to <$imapfolder>. [$@]\n"; + warn "$scriptname: Error on moving (copy and delete) processed IMAP message: Could not DELETE message\n"; + warn "$scriptname: after copying it to <$imapfolder>. [$@]\n"; } } } @@ -461,7 +464,7 @@ sub processXML { # of database storage failure and we MUST NOT delete the # file, because it has not been pushed into the database. # The user must investigate this issue. - print "Skipping $f due to database errors.\n"; + warn "$scriptname: Skipping $f due to database errors.\n"; return 5; #xml ok(1), but database error(4), thus no delete (!2) } @@ -476,8 +479,8 @@ sub processXML { # has been processed and should now be deleted. # Print its content so it gets send as cron # message, so the user can still investigate. - print "The $f does not seem to contain a valid DMARC report. Skipped and Removed. Content:\n"; - print $filecontent."\n"; + warn "$scriptname: The $f does not seem to contain a valid DMARC report. Skipped and Removed. Content:\n"; + warn $filecontent."\n"; return 2; #xml not ok (!1), delete file (2) } } @@ -485,7 +488,7 @@ sub processXML { if ($xml) { return 1; } else { - print "The $f does not seem to contain a valid DMARC report. Skipped.\n"; + warn "$scriptname: The $f does not seem to contain a valid DMARC report. Skipped.\n"; return 0; } } @@ -510,9 +513,10 @@ sub getXMLFromMessage { my $body = $ent->bodyhandle; my $mtype = $ent->mime_type; my $subj = decode_mimewords($ent->get('subject')); + chomp($subj); # Subject always contains a \n. if ($debug) { - print "Subject: $subj"; # Subject always contains a \n. + print "Subject: $subj\n"; print "MimeType: $mtype\n"; } @@ -615,14 +619,17 @@ sub getXMLFromMessage { if ($unzip eq "") { $xml = getXMLFromXMLString(join("", <XML>)); if (!$xml) { - print "The XML found in ZIP file (temp. location: <$location>) does not seem to be valid XML! "; + warn "$scriptname: Subject: $subj\n:"; + warn "$scriptname: The XML found in ZIP file (temp. location: <$location>) does not seem to be valid XML! \n"; } close XML; } else { - print "Failed to $unzip ZIP file (temp. location: <$location>)! "; + warn "$scriptname: Subject: $subj\n:"; + warn "$scriptname: Failed to $unzip ZIP file (temp. location: <$location>)! \n"; } } else { - print "Could not find an embedded ZIP! "; + warn "$scriptname: Subject: $subj\n:"; + warn "$scriptname: Could not find an embedded ZIP! \n"; } if($body) {$body->purge;} @@ -685,14 +692,14 @@ sub getXMLFromZip { if ($unzip eq "") { $xml = getXMLFromXMLString(join("", <XML>)); if (!$xml) { - print "The XML found in ZIP file (<$filename>) does not seem to be valid XML! "; + warn "$scriptname: The XML found in ZIP file (<$filename>) does not seem to be valid XML! \n"; } close XML; } else { - print "Failed to $unzip ZIP file (<$filename>)! "; + warn "$scriptname: Failed to $unzip ZIP file (<$filename>)! \n"; } } else { - print "Could not find an <$filename>! "; + warn "$scriptname: Could not find an <$filename>! \n"; } return $xml; @@ -755,7 +762,7 @@ sub storeXMLInDatabase { if ($db_tx_support) { $dbh->do(qq{START TRANSACTION}); if ($dbh->errstr) { - print "Cannot start transaction (" . $dbh->errstr ."). Continuing without transaction support.\n"; + warn "$scriptname: $org: $id: Cannot start transaction. Continuing without transaction support.\n"; $db_tx_support = 0; } } @@ -768,17 +775,17 @@ sub storeXMLInDatabase { # $sid is the serial of a report with reportid=$id # Remove this $sid from rptrecord and report table, but # try to continue on failure rather than skipping. - print "Replacing $xorg $id.\n"; + print "$scriptname: $org: $id: Replacing data.\n"; $dbh->do(qq{DELETE from rptrecord WHERE serial=?}, undef, $sid); if ($dbh->errstr) { - print "Cannot remove report data from database (". $dbh->errstr ."). Try to continue.\n"; + warn "$scriptname: $org: $id: Cannot remove report data from database. Try to continue.\n"; } $dbh->do(qq{DELETE from report WHERE serial=?}, undef, $sid); if ($dbh->errstr) { - print "Cannot remove report from database (". $dbh->errstr ."). Try to continue.\n"; + warn "$scriptname: $org: $id: Cannot remove report from database. Try to continue.\n"; } } else { - print "Already have $xorg $id, skipped\n"; + print "$scriptname: $org: $id: Already have report, skipped\n"; # Do not store in DB, but return true, so the message can # be moved out of the way, if configured to do so. return 1; @@ -791,7 +798,7 @@ sub storeXMLInDatabase { if ($compress_xml) { my $gzipdata; if(!gzip(\$storexml => \$gzipdata)) { - print "Cannot add gzip XML to database ($GzipError). Skipped.\n"; + warn "$scriptname: $org: $id: Cannot add gzip XML to database ($GzipError). Skipped.\n"; return 0; $storexml = ""; } else { @@ -799,22 +806,22 @@ sub storeXMLInDatabase { } } if (length($storexml) > $maxsize_xml) { - print "Skipping storage of large XML (".length($storexml)." bytes) as defined in config file.\n"; + warn "$scriptname: $org: $id: Skipping storage of large XML (".length($storexml)." bytes) as defined in config file.\n"; $storexml = ""; } $dbh->do($sql, undef, $from, $to, $domain, $org, $id, $email, $extra, $policy_adkim, $policy_aspf, $policy_p, $policy_sp, $policy_pct, $storexml); if ($dbh->errstr) { - print "Cannot add report to database (". $dbh->errstr ."). Skipped.\n"; + warn "$scriptname: $org: $id: Cannot add report to database. Skipped.\n"; return 0; } my $serial = $dbh->{'mysql_insertid'} || $dbh->{'insertid'}; if ($debug){ - print " serial $serial "; + print " serial $serial \n"; } my $record = $xml->{'record'}; - sub dorow($$) { - my ($serial,$recp) = @_; + sub dorow($$$$) { + my ($serial,$recp,$org,$id) = @_; my %r = %$recp; my $ip = $r{'row'}->{'source_ip'}; @@ -829,7 +836,7 @@ sub storeXMLInDatabase { my ($dkim, $dkimresult, $spf, $spfresult, $reason); if(ref $r{'auth_results'} ne "HASH"){ - print "Report has no auth_results data. Skipped.\n"; + warn "$scriptname: $org: $id: Report has no auth_results data. Skipped.\n"; return 0; } my $rp = $r{'auth_results'}->{'dkim'}; @@ -920,14 +927,14 @@ sub storeXMLInDatabase { $ipval = "X'" . unpack("H*",$nip) . "'"; $iptype = "ip6"; } else { - print "??? mystery ip $ip\n"; + warn "$scriptname: $org: $id: ??? mystery ip $ip\n"; next; # of dorow } $dbh->do(qq{INSERT INTO rptrecord(serial,$iptype,rcount,disposition,spf_align,dkim_align,reason,dkimdomain,dkimresult,spfdomain,spfresult,identifier_hfrom) VALUES(?,$ipval,?,?,?,?,?,?,?,?,?,?)},undef,$serial,$count,$disp,$spf_align,$dkim_align,$reason,$dkim,$dkimresult,$spf,$spfresult,$identifier_hfrom); if ($dbh->errstr) { - print "Cannot add report data to database (". $dbh->errstr ."). Skipped.\n"; + warn "$scriptname: $org: $id: Cannot add report data to database. Skipped.\n"; return 0; } return 1; @@ -938,16 +945,16 @@ sub storeXMLInDatabase { if ($debug){ print "single record\n"; } - $res = -1 if !dorow($serial,$record); + $res = -1 if !dorow($serial,$record,$org,$id); } elsif(ref $record eq "ARRAY") { if ($debug){ print "multi record\n"; } foreach my $row (@$record) { - $res = -1 if !dorow($serial,$row); + $res = -1 if !dorow($serial,$row,$org,$id); } } else { - print "mystery type " . ref($record) . "\n"; + warn "$scriptname: $org: $id: mystery type " . ref($record) . "\n"; } if ($debug && $res <= 0) { @@ -956,19 +963,19 @@ sub storeXMLInDatabase { if ($res <= 0) { if ($db_tx_support) { - print "Cannot add records to rptrecord. Rolling back DB transaction.\n"; + warn "$scriptname: $org: $id: Cannot add records to rptrecord. Rolling back DB transaction.\n"; $dbh->do(qq{ROLLBACK}); if ($dbh->errstr) { - print "Cannot rollback transaction (" . $dbh->errstr .").\n"; + warn "$scriptname: $org: $id: Cannot rollback transaction.\n"; } } else { - print "Warning: errors while adding to rptrecord, serial $serial records likely obsolete.\n"; + warn "$scriptname: $org: $id: errors while adding to rptrecord, serial $serial records likely obsolete.\n"; } } else { if ($db_tx_support) { $dbh->do(qq{COMMIT}); if ($dbh->errstr) { - print "Cannot commit transaction (" . $dbh->errstr .").\n"; + warn "$scriptname: $org: $id: Cannot commit transaction.\n"; } } } @@ -1040,7 +1047,7 @@ sub checkDatabase { if (!$db_tbl_exists{$table}) { # Table does not exist, build CREATE TABLE cmd from tables hash. - print "Adding missing table <" . $table . "> to the database.\n"; + print "$scriptname: Adding missing table <" . $table . "> to the database.\n"; my $sql_create_table = "CREATE TABLE " . $table . " (\n"; for (my $i=0; $i <= $#{$tables{$table}{"column_definitions"}}; $i+=2) { my $col_name = $tables{$table}{"column_definitions"}[$i]; |