Merge pull request #92 from wolfgangkarall/cron_output

Improve output of warnings and errors

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];