--- /dev/null
+#!/usr/bin/perl
+# response-pending.pl -*- Perl -*-
+# Assumes STDIN is a set of incoming messages, which will be saved
+# in $RESPONSE_MAILBOX and processed for Bcc's to address
+#
+# If no STDIN is given, then it simply checks the mailbox folder for
+#
+# This program assumes that messages arrive in chronological order, because
+# it relies on the fact that it won't see a Reference to a message before
+# the original message has been seen.
+
+use strict;
+use warnings;
+
+use Fcntl ':flock';
+use IO::File;
+
+use Mail::Internet;
+use Mail::Address;
+
+my $DEBUG = 0;
+
+use Date::Manip;
+use Date::Calc qw(Today Add_Delta_Days Delta_Days Parse_Date Decode_Date_US
+ Decode_Date_EU);
+
+use File::Temp qw(tempfile);
+use POSIX qw(strftime);
+
+sub myToday {
+ if (!$DEBUG) {
+ return Today();
+ } else {
+ # Put a hard-coded date here for debugging!
+ # This is the date the script thinks is _now_.
+ return ('2011','02','15');
+ }
+}
+
+if (@ARGV < 1 or @ARGV > 3) {
+ print STDERR "usage: $0 <CONFIGURATION_FILE_NAME> [<VERBOSITY>] [<CHECK_REMINDERS>]\n"; exit 1;
+}
+
+my $VERBOSE = $ARGV[1];
+$VERBOSE = 0 unless defined $VERBOSE;
+
+# A parameter can be passed to the response program. We feed the new pending
+# response requests from the user to the script first, but during that run, the
+# reminder script should *NOT* yet send out reminders, because the incoming
+# messages have not been processed yet. So when the reminder script is invoked
+# with a parameter '1', it will skip sending of reminders. On the second run
+# (when we feed it the new incoming mail), we give it the parameter '0',
+# indicating that it may check the outstanding reminders and send out reminders
+# if necessary.
+#
+# This is necessary to avoid the following race condition:
+#
+# 1. User sets reminder for 5 days on message to X
+# 2. X responds on the 4th day
+# 3. Reminder script runs early on the 5th day
+#
+# Without this parameter patch, the script would read new reminders to be set,
+# then see that the message to X has not been responded to, and send out the
+# reminder. On the second run, it would receive the response from X, but at
+# that point, the reminder would already have been sent out/cancelled.
+#
+# DO NOT FEED NEW INCOMING MAIL TO THIS SCRIPT WHEN PASSING IT THE '1'
+# PARAMETER, OR THE REMINDERS WILL NOT BE CANCELLED!
+#
+# WVW, 2006-06-02
+my $dont_check_reminders = $ARGV[2];
+$dont_check_reminders ||= 0;
+
+open(CONFIG, "<$ARGV[0]") || die "unable to open $ARGV[0]: $!";
+
+my $RESPONSE_MAILBOX = <CONFIG>; chomp $RESPONSE_MAILBOX;
+my $PENDING_FILE = <CONFIG>; chomp $PENDING_FILE;
+
+my $RESPONDED_REPORT_FILE = <CONFIG>; chomp $RESPONDED_REPORT_FILE;
+my $RESPONDED_MESSAGE_ID_FILE = "${RESPONDED_REPORT_FILE}.msgIDs";
+my $RESPONSE_ADDR_REGEX = <CONFIG>; chomp $RESPONSE_ADDR_REGEX;
+
+my $NO_RESPONSE_REPORT_TO_EMAIL = <CONFIG>; chomp $NO_RESPONSE_REPORT_TO_EMAIL;
+my $NO_RESPONSE_REPORT_FROM_LINE = <CONFIG>;
+chomp $NO_RESPONSE_REPORT_FROM_LINE;
+my $MAIL_HOST = <CONFIG>; chomp $MAIL_HOST;
+my $ROOT_PATH = <CONFIG>; chomp $ROOT_PATH;
+
+die "Missing lines in configuration file $ARGV[0]" unless
+ defined $RESPONSE_MAILBOX and defined $PENDING_FILE and
+ defined $RESPONDED_REPORT_FILE and defined $RESPONSE_ADDR_REGEX and
+ defined $NO_RESPONSE_REPORT_TO_EMAIL and
+ defined $NO_RESPONSE_REPORT_FROM_LINE and defined $MAIL_HOST;
+
+close CONFIG;
+
+my $LOGHANDLE = &LockFile("$ROOT_PATH/Logs/response-pending.log",">>",LOCK_EX);
+
+my @SEARCHED_HEADERS = ("Received", "Envelope-to", "X-Response-Expected");
+
+# %RESPONSE_MAILBOX_MESSAGES is a hash of messages that do exist
+# or should exist in $RESPONSE_MAILBOX. keys are message IDs and
+# data is the corresponding message object
+
+my %RESPONSE_MAILBOX_MESSAGES;
+
+# %RESPONSE_PENDING is a hash that lists messages waiting for a response.
+# It is built from the $PENDING_FILE, and added to as needed when messages
+# that are waiting for responses are encountered. The keys are message-ID's
+# and the values are the dates (YEAR-MO-DA format) by when a response is
+# expected.
+
+my %RESPONSE_PENDING;
+
+###############################################################################
+sub LockFile {
+ my($fileName, $flags, $lockType) = @_;
+
+ system("/usr/bin/lockfile -l 7200 ${fileName}.lock");
+ my $ioFile = new IO::File("$flags $fileName");
+
+ unless (defined $ioFile) {
+ unlink("${fileName}.lock") ||
+ print STDERR "Warning: Unable to remove ${fileName}.lock: $!\n";
+ die "unable to lock a file called: $fileName.";
+ }
+ flock $ioFile, $lockType;
+
+ seek $ioFile, 2, 0 if (($lockType & LOCK_EX) and ($flags eq ">>"));
+ # seek to the end of file
+
+ return $ioFile;
+}
+###############################################################################
+sub CloseAndUnlockFile {
+ my($ioFile, $fileName) = @_;
+
+ $ioFile->close; undef $ioFile;
+ unlink("${fileName}.lock") ||
+ print STDERR "Warning: Unable to remove ${fileName}.lock: $!"
+}
+
+##############################################################################
+sub Log {
+ my($message) = @_;
+
+# my $handle = &LockFile("$ROOT_PATH/Logs/response-pending.log",">>",LOCK_EX);
+# print $handle "$message\n";
+ print $LOGHANDLE "$message\n";
+# &CloseAndUnlockFile($handle, "$ROOT_PATH/Logs/response-pending.log");
+}
+
+##############################################################################
+# BuildThreadData takes two arguments.
+# The first argument is the hash in which the thread data is built.
+# This hash has keys of message ids, and values hashes.
+# these sub hashes have keys that are message ID's
+# that are in that in a thread with that message
+# The second argument is a hash of new messages to be added to the previous
+# thread data hash.
+
+sub BuildThreadData {
+ my($threadHash, $newMessageHash) = @_;
+
+ &Log("TIMESTAMP: pre-newRefFound loop in BuildThreadData: " . localtime()) if ($VERBOSE);
+ my $newRefFound = 1;
+ while ($newRefFound) {
+ $newRefFound = 0;
+
+ foreach my $msgId (keys %{$newMessageHash}) {
+ my $header = $newMessageHash->{$msgId}->head();
+ if (not defined $threadHash->{$msgId}) {
+ $threadHash->{$msgId} = { OBJECT => $newMessageHash->{$msgId},
+ MESSAGES => {},
+ REFERRED_TO_BY => {} };
+ } elsif (not defined $threadHash->{$msgId}{OBJECT}) {
+ $threadHash->{$msgId}{OBJECT} = $newMessageHash->{$msgId};
+ }
+
+ foreach my $headerLine ("References", "In-Reply-To") {
+ my $referenceCount = $header->count($headerLine);
+ my $ii = 0;
+ my %seenReferences;
+ while ($ii < $referenceCount) {
+ my $referenceLine = $header->get($headerLine, $ii++);
+ chomp $referenceLine;
+ while ($referenceLine =~ s/(<\s*\S+\s*>)//ms) {
+ &Log("**** referenceLine: $referenceLine ****") if ($VERBOSE);
+ my $refId = $1;
+ chomp $refId;
+ next if (defined $seenReferences{$refId});
+ $seenReferences{$refId} = $refId;
+
+ # Place an empty hash as a place holder if we haven't seen this
+ # message before
+ unless (defined $threadHash->{$refId}) {
+ $threadHash->{$refId} = { OBJECT => undef,
+ MESSAGES => {},
+ REFERRED_TO_BY => {} };
+ }
+ $newRefFound = 1
+ unless ((defined $threadHash->{$refId}{MESSAGES}{$msgId})
+ and (defined $threadHash->{$msgId}{MESSAGES}{$refId}));
+
+ $threadHash->{$refId}{MESSAGES}{$msgId} = $threadHash->{$msgId}
+ unless (defined $threadHash->{$refId}{MESSAGES}{$msgId});
+
+ $threadHash->{$refId}{REFERRED_TO_BY}{$msgId} =
+ $threadHash->{$msgId}
+ unless (defined $threadHash->{$refId}{REFERRED_TO_BY}{$msgId});
+
+ $threadHash->{$msgId}{MESSAGES}{$refId} = $threadHash->{$refId}
+ unless (defined $threadHash->{$msgId}{MESSAGES}{$refId});
+
+ if ($VERBOSE) {
+ &Log("MESSAGES: " . $threadHash->{$refId}{MESSAGES}{$msgId});
+ foreach my $tmp (keys %{$threadHash->{$refId}{REFERRED_TO_BY}{$msgId}}) {
+ &Log("REFERRED_TO_BY: $msgId: $tmp -> " . $threadHash->{$refId}{REFERRED_TO_BY}{$msgId}{$tmp});
+ }
+ &Log("MESSAGES msgId" . $threadHash->{$msgId}{MESSAGES}{$refId});
+ }
+ }
+ }
+ }
+ }
+ }
+ &Log("TIMESTAMP: post-newRefFound loop in BuildThreadData: " . localtime()) if ($VERBOSE);
+
+ # Make sure that we have ADDRESSSES and SUBJECT fields for each message
+ foreach my $id (keys %{$threadHash}) {
+ next unless defined $threadHash->{$id}{OBJECT};
+ my $header = $threadHash->{$id}{OBJECT}->head();
+
+ if (not defined $threadHash->{$id}{FROM_ADDRESSES}) {
+ # This program may generate error messages like:
+ # Unmatched () '(http://nefac.northernhacking.org/ ' ''
+ # Unmatched <> '<foo@bar.org' ''
+ # Errors like that are a result of the following line doing a carp.
+ # It indicates that the From: line in an e-mail was badly formed.
+ # There doesn't seem to be a good way to catch carps, and so there
+ # doesn't seem to be a way to suppress that output. As a result,
+ # I guess we just have to live with the error messages. They come
+ # up pretty rarely (I got my first one after 18 months of watching
+ # this account), so hopefully they won't be too annoying.
+ # -- brett 2004-02-01
+ my(@addresses) = Mail::Address->parse($header->get("From"));
+
+ my $a;
+ foreach my $address (@addresses) {
+ $a = $address->address();
+ chomp $a;
+ $threadHash->{$id}{FROM_ADDRESSES}{$a} = $address;
+ }
+ if (not defined $a) {
+# commented this out because this additional verbosity seemed a unecessary
+# to print anymore -- bkuhn, 2003-09-15
+# print STDERR "This message is missing a From: line:\n",
+# $newMessageHash->{$id}->as_mbox_string();
+# &Log("This message is missing a From: line:\n" . $newMessageHash->{$id}->as_mbox_string());
+ $threadHash->{$id}{FROM_ADDRESSES}{"nobody\@NO_DOMAIN.NODOM"} =
+ "nobody\@NO_DOMAIN.NODOM";
+ }
+ }
+ if (not defined $threadHash->{$id}{TO_ADDRESSES}) {
+ # Here, too, we can get the
+ # Unmatched <> '<some@one.org' ''
+ # error messages
+ # ward, 2006-02-02
+ my(@addresses) = Mail::Address->parse($header->get("To"));
+ push(@addresses, Mail::Address->parse($header->get("Cc")));
+ my $a;
+ foreach my $address (@addresses) {
+ $a = $address->address();
+ chomp $a;
+ $threadHash->{$id}{TO_ADDRESSES}{$a} = $address;
+ &Log("$id: added to TO_ADDRESSES: $a") if ($VERBOSE);
+ # Some people have @gnu.org and @fsf.org addresses that are aliases, and
+ # have broken e-mail clients that don't include the original message id when
+ # responding to a message by the user, with the *other* alias (Jonas!). To deal
+ # with this, include the alias in the TO_ADDRESSES hash to allow matching on
+ # subject/date. Cf. RT #333732
+ # WVW, 2007-04-18
+ if (($a =~ /\@gnu.org$/) or ($a =~ /\@fsf.org/)) {
+ my $b = $a;
+ $b =~ s/\@gnu.org$/\@fsf.org/;
+ $b =~ s/\@fsf.org$/\@gnu.org/ if ($a eq $b);
+ $threadHash->{$id}{TO_ADDRESSES}{$b} = $address;
+ &Log("$id: added to TO_ADDRESSES: $b") if ($VERBOSE);
+ }
+ }
+ if (not defined $a) {
+# print STDERR "This message is missing a To: or Cc: line:\n",
+# $newMessageHash->{$id}->as_mbox_string();
+# &Log("This message is missing a To: or Cc: line:\n" . $newMessageHash->{$id}->as_mbox_string());
+ }
+ }
+ if (not defined $threadHash->{$id}{DATE}) {
+ my $date = $header->get("Date"); chomp $date;
+ $threadHash->{$id}{DATE} = Date::Manip::ParseDate($date);
+ }
+ &Log(sprintf("\r%79.79s", "Building thread data for ($threadHash->{$id}{DATE})")) if ($VERBOSE);
+
+ if (not defined $threadHash->{$id}{SUBJECT}) {
+ my $subject = $header->get("Subject");
+ if (not defined $subject) {
+# print STDERR "This message is missing a Subject:\n",
+# $newMessageHash->{$id}->as_mbox_string();
+# &Log("This message is missing a Subject:\n" . $newMessageHash->{$id}->as_mbox_string());
+ $threadHash->{$id}{SUBJECT} = "";
+ } else {
+ chomp $subject;
+ $subject =~ s/^(?:Re:\s*)?(?:\[\s*gnu\.org\s+\#([0-9]+)\s*]\s*)?\s*(?:Re:\s*)?//i;
+ # We need a unique string for the TICKET if there is no RT ticket, so
+ # that the comparision in the foreach below doesn't given false
+ # positives. Using the subject seemed like the easiest way to give
+ # something unique for this message thread.
+ $threadHash->{$id}{TICKET} = (defined $1) ? $1 : $subject;
+ $threadHash->{$id}{SUBJECT} = $subject;
+ }
+ }
+ }
+ &Log("TIMESTAMP: post-from/to address loop in BuildThreadData: " . localtime()) if ($VERBOSE);
+ # reiterate through one last time, so we can see if there are any subject
+ # line matches
+
+ my $counter = 0;
+
+ &Log("newMessageHash is " . (scalar keys %{$newMessageHash}) . " items long") if ($VERBOSE);
+ &Log("threadHash is " . (scalar keys %{$threadHash}) . " items long") if ($VERBOSE);
+
+ foreach my $msgId (sort {$threadHash->{$a}{DATE} cmp $threadHash->{$b}{DATE}}
+ keys %{$newMessageHash}) {
+ &Log(sprintf("\r%09d: %79.79s",$counter++,"Comparing ($threadHash->{$msgId}{DATE}) to rest of the set")) if ($VERBOSE);
+ foreach my $possibleRefedId (keys %{$threadHash}) {
+ next if ($msgId eq $possibleRefedId);
+ #&Log("Considering $possibleRefedId...") if ($VERBOSE);
+ next unless (defined $threadHash->{$possibleRefedId}{OBJECT});
+
+ # I encountered some sort of bug where the if statement here that
+ # compares tickets and subject lines, and apparently they were sometimes
+ # undefined. I added these tests to compare their undefined-ness as well
+ # -- bkuhn, 2003-09-15
+ my %cmps;
+ foreach my $key (qw/SUBJECT TICKET/) {
+ &Log("Considering $key...") if ($VERBOSE > 2); # Set $VERBOSE > 2 at your own peril; this loop will generate a *LOT* of output...
+ $cmps{$key} = 0 if ( (defined $threadHash->{$msgId}{$key}) and
+ (not defined $threadHash->{$possibleRefedId}{$key})) or
+ ( (not defined $threadHash->{$msgId}{$key}) and
+ (defined $threadHash->{$possibleRefedId}{$key}));
+ next if defined $cmps{$key};
+ &Log('$cmps{$key} is not defined for key ' . $key) if ($VERBOSE > 2);
+ if ( (not defined $threadHash->{$msgId}{$key}) and
+ (not defined $threadHash->{$possibleRefedId}{$key})) {
+ $cmps{$key} = 1;
+ &Log("Setting " . $cmps{$key} . " to 1") if ($VERBOSE > 2);
+ } else {
+ $cmps{$key} = $threadHash->{$msgId}{$key} eq $threadHash->{$possibleRefedId}{SUBJECT};
+ &Log("Set " . $cmps{$key} . " to " . $threadHash->{$msgId}{$key} . "(msgId is $msgId)") if ($VERBOSE > 2);
+ }
+ &Log("result for $key: " . $cmps{$key}) if ($VERBOSE > 2);
+ }
+ &Log("date for possible: " . $threadHash->{$possibleRefedId}{DATE}) if ($VERBOSE > 2);
+ &Log("date for message: " . $threadHash->{$msgId}{DATE}) if ($VERBOSE > 2);
+ if ( ($cmps{SUBJECT} or $cmps{TICKET}) and
+ ($threadHash->{$possibleRefedId}{DATE} lt $threadHash->{$msgId}{DATE})) {
+ my $isInThisThread = 0;
+ if ($VERBOSE) {
+ &Log("About to match from addresses...");
+ foreach my $to_address (keys %{$threadHash->{$possibleRefedId}{TO_ADDRESSES}}) {
+ &Log("from address: $to_address");
+ }
+ }
+ foreach my $msgAddr (keys %{$threadHash->{$msgId}{FROM_ADDRESSES}}) {
+ &Log("Comparing $msgAddr with above list") if ($VERBOSE);
+ if (defined $threadHash->{$possibleRefedId}{TO_ADDRESSES}{$msgAddr}) {
+ &Log("Match found!") if ($VERBOSE);
+ $isInThisThread = 1;
+ last;
+ }
+ }
+ &Log("isInThisThread: $isInThisThread") if ($VERBOSE);
+ if ($isInThisThread) {
+ my $referredId = $possibleRefedId;
+
+ $threadHash->{$referredId}{MESSAGES}{$msgId} = $threadHash->{$msgId}
+ unless (defined $threadHash->{$referredId}{MESSAGES}{$msgId});
+
+ $threadHash->{$referredId}{REFERRED_TO_BY}{$msgId} =
+ $threadHash->{$msgId}
+ unless defined
+ $threadHash->{$referredId}{REFERRED_TO_BY}{$msgId};
+
+ $threadHash->{$msgId}{MESSAGES}{$referredId} =
+ $threadHash->{$referredId}
+ unless (defined $threadHash->{$msgId}{MESSAGES}{$referredId});
+ }
+ }
+ }
+ }
+ &Log("TIMESTAMP: post-subject match loop in BuildThreadData: " . localtime()) if ($VERBOSE);
+ #print "\n" if ($VERBOSE > 0);
+}
+
+##############################################################################
+sub ReadAndFillHashes_ProcessMessageData {
+ my($msgData, $messageHash) = @_;
+
+ my $msg = new Mail::Internet($msgData);
+ my $header = $msg->head();
+ my $msgId = $header->get("Message-Id", 0);
+ chomp $msgId;
+ $messageHash->{$msgId} = $RESPONSE_MAILBOX_MESSAGES{$msgId} = $msg;
+}
+##############################################################################
+sub ReadAndFillHashes {
+ my($file, $threadHash) = @_;
+
+ return unless -f $file; # If there is none there at this point, ignore
+
+ my %messages;
+
+ my $ioFile = LockFile($file, "<", LOCK_SH);
+ my @msg;
+
+ while (my $line = <$ioFile>) {
+ if ($line =~ /^From\s+[^@\s]+\@[^@\s]+\s+(.+)$/) {
+ my @saveData = @msg; # Must do this, Mail::Interenet will use our data!
+ ReadAndFillHashes_ProcessMessageData(\@saveData, \%messages)
+ if (@msg > 0);
+ @msg = ();
+ }
+ push(@msg, $line);
+ }
+ ReadAndFillHashes_ProcessMessageData(\@msg, \%messages) if (@msg > 0);
+ CloseAndUnlockFile($ioFile, $file);
+
+ BuildThreadData($threadHash, \%messages);
+}
+##############################################################################
+sub ReadPendingFile {
+ my($file) = @_;
+
+ return unless -f $file; # If there is none there at this point, ignore
+
+ my $ioFile = LockFile($file, "<", LOCK_SH);
+
+ while (my $line = <$ioFile>) {
+ if ($line =~ /\s*(\d+-\d+-\d+)\s+(\S+)\s*$/) {
+ my($day, $messageID) = ($1, $2);
+ $RESPONSE_PENDING{$messageID} = $day;
+ } else {
+ die "Invalid line in $file: \"$line\"";
+ }
+ }
+ CloseAndUnlockFile($ioFile, $file);
+}
+##############################################################################
+sub WritePendingFile {
+ my($file) = @_;
+
+ my $ioFile = LockFile($file, ">", LOCK_EX);
+
+ foreach my $key (sort { $RESPONSE_PENDING{$a} cmp $RESPONSE_PENDING{$b} }
+ keys %RESPONSE_PENDING) {
+ print $ioFile $RESPONSE_PENDING{$key}, " ", $key, "\n";
+ }
+ CloseAndUnlockFile($ioFile, $file);
+}
+##############################################################################
+# Takes the header of the message and returns a list ($year, $month, $day)
+sub FindDateForMessage ($$) {
+ my($header, $fromLine) = @_;
+
+ my($year, $month, $day);
+
+ my $date = $header->get("Date"); chomp $date;
+ my $tryDate = $date =~ s/\w+,\s*(\d+\s+\w+\s+\d+)\s+.*$/$1/;
+
+ #if (ref(\$tryDate) eq 'SCALAR') {
+ # ($year, $month, $day) = Decode_Date_EU($tryDate);
+ #}
+ unless (defined $year) {
+ ($year, $month, $day) = Parse_Date($tryDate);
+ }
+ unless (defined $year) {
+ $fromLine =~ /^From\s+[^@\s]+\@[^@\s]+\s+(.+)$/;
+ ($year, $month, $day) = Parse_Date($1);
+ }
+ unless (defined $year) {
+ my $manipDate = Date::Manip::ParseDate($date);
+ if (not $manipDate) {
+ $manipDate = Date::Manip::ParseDate($tryDate);
+ }
+ ($year, $month, $day) = Date::Manip::UnixDate($manipDate, '%Y', '%m', '%d')
+ if ($manipDate);
+ #print STDERR "Used manip, got $manipDate\n";
+ &Log("Used manip, got $manipDate\n");
+ }
+ unless (defined $year) {
+ ($year, $month, $day) = myToday();
+ #print STDERR "Forced to use todays date\n";
+ &Log("Forced to use todays date\n");
+ }
+
+
+ return($year, $month, $day);
+}
+##############################################################################
+sub ProcessNewMessages_HandleMessageData {
+ my($msgData, $messageHash) = @_;
+
+ my $fromLine = $msgData->[0];
+ my $msg = new Mail::Internet($msgData);
+ my $header = $msg->head();
+ my $msgId = $header->get("Message-Id", 0);
+
+ if (defined $msgId) {
+ chomp $msgId;
+ my $foundResponseExpected = 0;
+ foreach my $headerType (@SEARCHED_HEADERS) {
+ my $headerCount = $header->count($headerType);
+ my $ii = 0;
+
+ while ($ii < $headerCount) {
+ my $headerLine = $header->get($headerType, $ii++);
+ if ($headerLine =~ /$RESPONSE_ADDR_REGEX/) {
+ &Log("***** Found response message: $headerLine *****") if ($VERBOSE);
+
+ my($amount, $unit) = ($1, $2);
+ $foundResponseExpected = 1;
+
+ if ($unit eq "m") { $amount *= 30; }
+ elsif ($unit eq "y") { $amount *= 365; }
+ elsif ($unit eq "w") { $amount *= 7; }
+ elsif ($unit eq "d") { }
+ else {
+ print STDERR "unknown unit, $unit, assuming days\n";
+ &Log("unknown unit, $unit, assuming days\n");
+ }
+
+ my($year, $month, $day) = FindDateForMessage($header, $fromLine);
+
+ ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $amount);
+
+ $RESPONSE_PENDING{$msgId} =
+ sprintf("%4.4d-%2.2d-%2.2d", $year, $month, $day);
+ $RESPONSE_MAILBOX_MESSAGES{$msgId} = $msg;
+
+ &Log("msgID: $msgId") if ($VERBOSE);
+ &Log("response_pending record: " . $RESPONSE_PENDING{$msgId}) if ($VERBOSE);
+ &Log("response_mailbox_messages record: " . $RESPONSE_MAILBOX_MESSAGES{$msgId}) if ($VERBOSE);
+ last;
+ }
+ }
+ $messageHash->{$msgId} = $msg;
+ last if $foundResponseExpected;
+ }
+ } else {
+# print STDERR ("#" x 79), "\nThis message has no Message ID:\n",
+# $msg->as_mbox_string();
+ &Log( ("#" x 79) . "\nThis message has no Message ID:\n" . $msg->as_mbox_string());
+ }
+}
+##############################################################################
+# $newMsgSubjectHash is a hash whose keys are email addresses, and the
+# values of that hash is itself a hash with keys that are subject lines
+# (Possible RE: removed) and the values of that inner hash are list refs
+# which is a list of message objects that are FROM that email address
+# and have that Subject line
+# Note that $newMsgSubjectHash is only for the new messages
+
+sub ProcessNewMessages {
+ my($threadHash, $newMsgSubjectHash) = @_;
+ my @msg;
+ my %messages;
+
+ &Log("***** Start logging STDIN *****") if ($VERBOSE);
+
+ my $count = 0;
+ while (my $line = <STDIN>) {
+ print sprintf("\r%79.79s", "Processing STDIN line number: $count") if ($VERBOSE > 1 and $count++ % 10000 == 0);
+
+ if ($line =~ /^From/) { # See if we can speed processing of large attachments up by using a simple regexp here
+ if ($line =~ /^(From\s+[^@\s]+\@[^@\s]+\s+(.+))$/) { # and the more complex one only when lines start with From
+ my @saveData = @msg; # Must do this, Mail::Internet will use our data!
+ &Log("*****\n* NEW MESSAGE. Processing: $1\n*****\n") if ($VERBOSE);
+ ProcessNewMessages_HandleMessageData(\@saveData, \%messages) if (@msg > 0);
+ &Log("*****\n* /NEW MESSAGE. Processing: $1 done\n*****\n") if ($VERBOSE);
+ @msg = ();
+ }
+ }
+
+# This loop is way too slow. Ward, 2009-12-11
+# if ($VERBOSE) {
+# # It's very agressive but I really want to know what's going on here.
+# # Ward, 2006-04-28
+# my $tmp = $line;
+# chomp($tmp);
+# &Log($tmp);
+# }
+
+ push(@msg, $line);
+ }
+ close STDIN;
+ print "\n" if ($VERBOSE > 1);
+
+ &Log("***** End logging STDIN *****") if ($VERBOSE);
+
+ &Log("TIMESTAMP: pre-ProcessNewMessages_HandleMessageData: " . localtime()) if ($VERBOSE);
+ ProcessNewMessages_HandleMessageData(\@msg, \%messages) if (@msg > 0);
+ &Log("TIMESTAMP: post-ProcessNewMessages_HandleMessageData: " . localtime()) if ($VERBOSE);
+ BuildThreadData($threadHash, \%messages);
+ &Log("TIMESTAMP: post-BuildThreadData: " . localtime()) if ($VERBOSE);
+}
+##############################################################################
+sub GenerateRespondedMessage {
+ my($msgId, $respondedReportIO, $respondedMessageIdIO, $threadHash) = @_;
+
+ my $subject = $threadHash->{$msgId}->{SUBJECT};
+
+ my(@address) =
+ my $to = join(", ", keys %{$threadHash->{$msgId}->{TO_ADDRESSES}});
+
+ chomp $to; chomp $subject;
+ $subject =~ s/^Re:\s+//i;
+
+ print $respondedReportIO
+ sprintf("%-25.25s %-29.29s %-10.10s %3d\n", $to, $subject,
+ sprintf("%4.4d-%2.2d-%2.2d", myToday()),
+ Delta_Days(myToday(), split(/\-/, $RESPONSE_PENDING{$msgId})));
+
+ print $respondedMessageIdIO "$msgId\n";
+ foreach my $refId (keys %{$threadHash->{$msgId}{MESSAGES}}) {
+ print $respondedMessageIdIO "$refId\n"
+ if ($refId eq $msgId);
+ }
+}
+##############################################################################
+sub RemoveAnnoyingHeadersFromFullMessage {
+ my($messageBody) = @_;
+ my $fixedMessageBody = "";
+
+ my @list = split(/\n/, $messageBody);
+ my $inBadHeader = 0;
+ while (defined(my $line = shift @list)) {
+ if ($line =~ /^\s*$/) { # End of headers, leave loop
+ $fixedMessageBody .= "$line\n";
+ last;
+ }
+ if ($line =~ /^(?:Received|Return-Path|Resent-[^:]+):\s+.+$/i ||
+ ($inBadHeader and $line =~ /^\s+\S+.+$/)) {
+ $inBadHeader = 1;
+ } else {
+ $fixedMessageBody .= "$line\n";
+ $inBadHeader = 0;
+ }
+ }
+ while (defined(my $line = shift @list)) { $fixedMessageBody .= "$line\n";
+ }
+
+ return $fixedMessageBody;
+}
+##############################################################################
+sub GenerateNoResponseMessage {
+ my($msgId, $threadHash) = @_;
+
+ my @body = ("\n",
+ "This message has received no response, and the deadline has passed.\n",
+ "Below is the original message, followed by any referenced messages.\n\n",
+ "############################### ORGINAL MESSAGE #####################\n");
+
+ push(@body, &RemoveAnnoyingHeadersFromFullMessage(
+ $RESPONSE_MAILBOX_MESSAGES{$msgId}->as_mbox_string()));
+
+ my $replyHeader = $RESPONSE_MAILBOX_MESSAGES{$msgId}->reply()->head();
+ $replyHeader->add("References", $msgId);
+ $replyHeader->delete("Cc");
+ $replyHeader->delete("Bcc");
+ $replyHeader->replace("From", $NO_RESPONSE_REPORT_FROM_LINE);
+ $replyHeader->replace("To", $NO_RESPONSE_REPORT_TO_EMAIL);
+ $replyHeader->replace("Date", strftime("%a, %e %b %Y %H:%M:%S %z", localtime));
+
+ foreach my $refId (keys %{$threadHash->{$msgId}{MESSAGES}}) {
+ next if ($refId eq $msgId);
+ $replyHeader->add("References", $refId);
+ my $refData = $threadHash->{$msgId}{MESSAGES}{$refId};
+ next unless defined $refData->{OBJECT};
+ push(@body,
+ "############################### REFERENCED MESSAGE #####################\n",
+ &RemoveAnnoyingHeadersFromFullMessage(
+ $refData->{OBJECT}->as_mbox_string()));
+ }
+ $replyHeader->combine("References");
+
+ my $replyMsg = new Mail::Internet(Header => $replyHeader,
+ Body => \@body);
+
+ # Store a backup of the message sent
+ my $date_string = strftime "%Y%m%d", localtime;
+ if (! -d "$ROOT_PATH/Archives/reminders-sent/$date_string") {
+ mkdir("$ROOT_PATH/Archives/reminders-sent/$date_string") or print STDERR "Unable to create $ROOT_PATH/Archives/reminders-sent/$date_string\n";
+ }
+
+ my $now_string = strftime "%Y-%m-%d_%H%M%S", localtime;
+ my ( $tmp_fh, $tmp_filename ) =
+ tempfile( "$ROOT_PATH/Archives/reminders-sent/$date_string/$now_string.XXXXXX", UNLINK => 0 );
+ if ( !defined $tmp_fh ) {
+ print STDERR "Unable to create temporary file $tmp_filename\n";
+ } else {
+ $replyMsg->print($tmp_fh);
+ close($tmp_fh);
+ }
+
+ my @retval = $replyMsg->smtpsend(Host => $MAIL_HOST);
+
+ if (! @retval) {
+ print STDERR "Unable to deliver message via smtp; it was stored locally as $tmp_filename\n";
+ }
+
+ sleep 3; # sleep a bit so the SMTP server doesn't get
+ # over loaded when we have lots
+
+}
+##############################################################################
+sub RemoveRespondedMessages ($$) {
+ my ($threadHash, $newMsgsSubjectEmailHash) = @_;
+
+ my($respondedReportIO, $respondedMessageIdIO);
+ if (-f $RESPONDED_REPORT_FILE) {
+ $respondedReportIO = LockFile($RESPONDED_REPORT_FILE, ">>", LOCK_EX);
+ $respondedMessageIdIO = LockFile($RESPONDED_MESSAGE_ID_FILE, ">>",
+ LOCK_EX);
+ } else {
+ $respondedReportIO = LockFile($RESPONDED_REPORT_FILE, ">",
+ LOCK_EX);
+ print $respondedReportIO sprintf("%-25.25s %-29.29s %-10.10s %s\n",
+ "Addressed To", "Subject", "Date Resp.", "DaysEarly?"),
+ ("-" x 79), "\n";
+ $respondedMessageIdIO = LockFile($RESPONDED_MESSAGE_ID_FILE, ">",
+ LOCK_EX);
+ }
+ foreach my $msgId (keys %RESPONSE_PENDING) {
+ my $remove = 0;
+ if (scalar(keys %{$threadHash->{$msgId}{REFERRED_TO_BY}}) > 0) {
+ GenerateRespondedMessage($msgId, $respondedReportIO,
+ $respondedMessageIdIO, $threadHash);
+ delete $RESPONSE_PENDING{$msgId};
+ foreach my $removeId (keys %{$threadHash->{$msgId}{MESSAGES}}, $msgId) {
+ delete $RESPONSE_MAILBOX_MESSAGES{$removeId}
+ unless defined $RESPONSE_PENDING{$removeId};
+ }
+ } elsif (Delta_Days(myToday(), split(/\-/, $RESPONSE_PENDING{$msgId})) <= 0) {
+ GenerateNoResponseMessage($msgId, $threadHash);
+ delete $RESPONSE_PENDING{$msgId};
+ }
+ }
+ CloseAndUnlockFile($respondedReportIO, $RESPONDED_REPORT_FILE);
+ CloseAndUnlockFile($respondedMessageIdIO, $RESPONDED_MESSAGE_ID_FILE);
+}
+##############################################################################
+sub WriteResponseMailbox {
+ my($file, $threadHash) = @_;
+ my $responseWrite = LockFile($file, ">", LOCK_EX);
+
+ foreach my $msgId (keys %RESPONSE_PENDING) {
+ print $responseWrite $threadHash->{$msgId}{OBJECT}->as_mbox_string();
+ foreach my $refId (keys %{$threadHash->{$msgId}{MESSAGES}}) {
+ print $responseWrite $threadHash->{$refId}{OBJECT}->as_mbox_string()
+ if (defined $threadHash->{$refId}{OBJECT});
+ }
+ }
+ CloseAndUnlockFile($responseWrite, $file);
+}
+##############################################################################
+sub CheckPendingForSanity {
+ foreach my $msgId (keys %RESPONSE_PENDING) {
+ unless (defined $RESPONSE_MAILBOX_MESSAGES{$msgId}) {
+ print STDERR "Message: $msgId occurs in pending file but not mailbox\n";
+ #print STDERR "Message: $msgId occurs in waiting-messages.data file but not in response-pending mailbox\n";
+ &Log("Message: $msgId occurs in pending file but not mailbox\n");
+ #&Log("Message: $msgId occurs in waiting-messages.data file but not in response-pending mailbox\n");
+ exit 1;
+ }
+ }
+}
+###############################################################################
+# Main program
+
+select STDERR; $| = 0; select STDOUT;
+
+my(%mailThreads, %newMessageSubjectsEmails);
+
+&Log("->->->->->->->->->->->->->->->->->->->->->->->->->-");
+&Log("Start run at " . localtime());
+
+ReadPendingFile($PENDING_FILE);
+&Log("TIMESTAMP: post-ReadPendingFile: " . localtime()) if ($VERBOSE);
+ReadAndFillHashes($RESPONSE_MAILBOX, \%mailThreads);
+&Log("TIMESTAMP: post-ReadAndFillHashes: " . localtime()) if ($VERBOSE);
+if ($VERBOSE) {
+ foreach my $l1 (keys %mailThreads) {
+ foreach my $l2 (keys %{$mailThreads{$l1}}) {
+ if (($l2 eq "TO_ADDRESSES") || ($l2 eq "MESSAGES") || ($l2 eq "REFERRED_TO_BY") || ($l2 eq "FROM_ADDRESSES")) {
+ foreach my $l3 (keys %{$mailThreads{$l1}{$l2}}) {
+ &Log("mailThreads (3): $l1 -> $l2 -> $l3 " . $mailThreads{$l1}{$l2}{$l3});
+ }
+ } else {
+ if (defined($mailThreads{$l1}{$l2})) {
+ &Log("mailThreads (2): $l1 -> $l2 -> " . $mailThreads{$l1}{$l2});
+ } else {
+ &Log("mailThreads (2, unset): $l1 -> $l2");
+ }
+ }
+ }
+ }
+}
+&Log("TIMESTAMP: post-verbose: " . localtime()) if ($VERBOSE);
+&CheckPendingForSanity;
+&Log("TIMESTAMP: post-CheckPendingForSanity: " . localtime()) if ($VERBOSE);
+ProcessNewMessages(\%mailThreads, \%newMessageSubjectsEmails);
+&Log("TIMESTAMP: post-ProcessNewMessages: " . localtime()) if ($VERBOSE);
+&Log("dont_check_reminders: $dont_check_reminders") if ($VERBOSE);
+RemoveRespondedMessages(\%mailThreads, \%newMessageSubjectsEmails) if (!$dont_check_reminders);
+&Log("TIMESTAMP: post-RemoveRespondedMessages: " . localtime()) if ($VERBOSE);
+WriteResponseMailbox($RESPONSE_MAILBOX, \%mailThreads);
+&Log("TIMESTAMP: post-WriteResponseMailbox: " . localtime()) if ($VERBOSE);
+WritePendingFile($PENDING_FILE, \%mailThreads);
+&Log("TIMESTAMP: post-WritePendingFile: " . localtime()) if ($VERBOSE);
+
+&Log("Finished run at " . localtime());
+&Log("-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-");
+
+&CloseAndUnlockFile($LOGHANDLE, "$ROOT_PATH/Logs/response-pending.log");
+
+# Local variables:
+# compile-command: "perl -c response-pending.pl"
+# End:
projects / response-pending.git / commitdiff