From 4c218af9d6a22470288120dd4555b6bea7c2d153 Mon Sep 17 00:00:00 2001 From: Andrew Engelbrecht Date: Thu, 14 Jan 2016 14:47:01 -0500 Subject: [PATCH 1/1] response-pending: initial commit response-pending is a system that reminds users when selected emails receive no response in the desired amount of time. --- .gitignore | 4 + Makefile | 45 ++ README.md | 81 +++ config/procmailrc.example | 29 + config/response-pending.config.example | 8 + src/feed-response-pending.pl | 119 ++++ src/response-pending.pl | 837 +++++++++++++++++++++++++ 7 files changed, 1123 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 README.md create mode 100644 config/procmailrc.example create mode 100644 config/response-pending.config.example create mode 100755 src/feed-response-pending.pl create mode 100755 src/response-pending.pl diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b03ef0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*~ +*.swp +*.swo + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..40d8c34 --- /dev/null +++ b/Makefile @@ -0,0 +1,45 @@ +MAIL_DIR = $(HOME)/Mail +PROCMAIL_DIR = $(HOME) + +warn: + echo -e "\nread the README then run \"make setup\"" + +.PHONY: warn setup maildir configs programs procmail speak + +setup: maildir configs programs procmailrc speak + +maildir: + mkdir -p $(MAIL_DIR) + mkdir -p $(MAIL_DIR)/Archives + mkdir -p $(MAIL_DIR)/Archives/reminders-sent + mkdir -p $(MAIL_DIR)/Caches + mkdir -p $(MAIL_DIR)/Data + mkdir -p $(MAIL_DIR)/Folders + mkdir -p $(MAIL_DIR)/Folders/processed # not sure if this is needed + mkdir -p $(MAIL_DIR)/Logs + mkdir -p $(MAIL_DIR)/Programs + touch $(MAIL_DIR)/FILTER.LOG + touch $(MAIL_DIR)/Caches/response-pending + touch $(MAIL_DIR)/Data/responded-report-file.txt + touch $(MAIL_DIR)/Data/responded-report-file.txt.msgIDs + touch $(MAIL_DIR)/Data/waiting-messages.data + touch $(MAIL_DIR)/Folders/archive.spool + touch $(MAIL_DIR)/Folders/incoming + touch $(MAIL_DIR)/Folders/incoming.old + touch $(MAIL_DIR)/Folders/response + touch $(MAIL_DIR)/Folders/response-pending + touch $(MAIL_DIR)/Logs/response-pending.log + +configs: + cp config/response-pending.config.example $(MAIL_DIR)/Data + +programs: + cp src/feed-response-pending.pl $(MAIL_DIR)/Programs + cp src/response-pending.pl $(MAIL_DIR)/Programs + +procmailrc: + cp config/procmailrc.example $(PROCMAIL_DIR) + +speak: + echo -e "\nRead the README file to learn how to finish\n\ + the configuration and installation process." diff --git a/README.md b/README.md new file mode 100644 index 0000000..6a52fed --- /dev/null +++ b/README.md @@ -0,0 +1,81 @@ +# response-pending + +response-pending is a system that reminds users when selected emails receive no +response in the desired amount of time. + +## Installation + +* Make the user account `USERNAMEemail`, where `USERNAME` is your user name. + + # useradd USERNAMEemail + +* Copy this repository to that new user's home directory and continue the + installation as that user. + + $ login USERNAMEemail + +* Initialize the `~/Mail` directory structure: + + $ make setup + +* Edit `~/Mail/Data/response-pending.config.example` and then remove the + `.example` suffix. + +* Edit `~/procmailrc.example`, replacing both occurrences of the word + `USERNAME` with your user name. Do the same for `DOMAIN.org`. You can specify +multiple domains by using the `(DOMAIN_1.org|DOMAIN_2.net)` syntax. Integrate +this file with your current `.procmailrc` file, or put the file there if you +don't have one yet. + +* Edit the `/etc/aliases` file and add the following entries (replacing + `USERNAME` with your user name. It's probably easiest to use your text +editor's find and replace feature.): + + USERNAME: \USERNAME, USERNAMEemail + USERNAME-response-1d: USERNAMEemail + USERNAME-response-2d: USERNAMEemail + USERNAME-response-3d: USERNAMEemail + USERNAME-response-4d: USERNAMEemail + USERNAME-response-5d: USERNAMEemail + USERNAME-response-6d: USERNAMEemail + USERNAME-response-1w: USERNAMEemail + USERNAME-response-2w: USERNAMEemail + USERNAME-response-3w: USERNAMEemail + USERNAME-response-4w: USERNAMEemail + USERNAME-response-5w: USERNAMEemail + USERNAME-response-6w: USERNAMEemail + USERNAME-response-1m: USERNAMEemail + USERNAME-response-2m: USERNAMEemail + USERNAME-response-3m: USERNAMEemail + + (The backslash on the first line is intended.) You may need to log in as +root to make these changes. + +* Add the following lines to your crontab: + + $ crontab -e + 46 3 * * * HOMEDIR_USERNAMEemail/Mail/Programs/feed-response-pending.pl + 52 0 * * * find HOMEDIR_USERNAMEemail/Mail/Archives -type f -ctime +180 |grep -v reminders-sent |xargs rm -f + + Make sure to replace `HOMEDIR_USERNAMEemail` with the proper +system-dependent path. Get your home directory path like this: + + $ echo $HOME + /home/u/usernameemail/ + + You may wish to edit the time at which these scripts run. The time is +specified by the first two colums in "`MM HH`" format. + +* Send a few test emails to a secondary address that you own as described in + the next section. Reply to some but not all of them and wait for the +reminders to appear in your inbox. + +## Usage + +When sending an email that you wish to remind yourself of if no response is +given, add `USERNAME-response-1d@DOMAIN.org` to the `Bcc:` field of your email. +The `1d` part means to remind in one day and can be replaced by other dates: + +* `-1d`, `-2d`, `-3d`, `-4d`, `-5d`, `-6d`, `-1w`, `-2w`, `-3w`, `-4w`, `-5w`, `-6w`, + `-1m`, `-2m` or `-3m` + diff --git a/config/procmailrc.example b/config/procmailrc.example new file mode 100644 index 0000000..c0abef7 --- /dev/null +++ b/config/procmailrc.example @@ -0,0 +1,29 @@ +UMASK=007 +PATH=/bin:/usr/bin:/usr/bin +MAILDIR=$HOME/Mail +LOGFILE=$MAILDIR/FILTER.LOG +CACHE_SIZE=4096 +CACHE_DIR=$MAILDIR/Caches +VERBOSE=yes + +############################## PENDING RESPONSE ############################## + +:0 +* ^Received:.*(^|[ \t]*)for[ \t]+<[ \t]*USERNAME-response-[^@]*@(DOMAIN.org)[\t]*>|^Envelope-to:.*USERNAME-response-[^@]*@(DOMAIN.org) +{ +:0c: +* !? formail -D $CACHE_SIZE $CACHE_DIR/response-pending +Folders/response-pending + +:0: +Folders/archive.spool +} + +################################## INCOMING ################################## + +:0c: +Folders/incoming + +:0: +Folders/archive.spool + diff --git a/config/response-pending.config.example b/config/response-pending.config.example new file mode 100644 index 0000000..0098ae9 --- /dev/null +++ b/config/response-pending.config.example @@ -0,0 +1,8 @@ +/home/s/USERNAMEemail/Mail/Folders/response +/home/s/USERNAMEemail/Mail/Data/waiting-messages.data +/home/s/USERNAMEemail/Mail/Data/responded-report-file.txt +USERNAME-response-(\d+)([dwmy])@(?:gnu.org) +USERNAME@gnu.org +"No Response Received" +127.0.0.1 +/home/s/USERNAMEemail/Mail diff --git a/src/feed-response-pending.pl b/src/feed-response-pending.pl new file mode 100755 index 0000000..6374c06 --- /dev/null +++ b/src/feed-response-pending.pl @@ -0,0 +1,119 @@ +#!/usr/bin/perl +# feed-pending-response.pl -*- Perl -*- +# Script to feed incoming messages into response files + +use strict; +use warnings; + +use Fcntl ':flock'; +use IO::File; + +my $USER_NAME = "$ENV{USER}"; +my $USER_EMAIL_DIR = "$ENV{HOME}/Mail"; +my $USER_INCOMING_CLOBBER_MAILBOX = "incoming"; +my $USER_INCOMING_CLOBBER_FOLDER = "$USER_EMAIL_DIR/Folders/$USER_INCOMING_CLOBBER_MAILBOX"; +my $USER_RESPONSE_PENDING_MAILBOX = "response-pending"; +my $USER_RESPONSE_PENDING_FOLDER = + "$USER_EMAIL_DIR/Folders/$USER_RESPONSE_PENDING_MAILBOX"; + +my $USER_RESPONSE_PROGRAM = "$USER_EMAIL_DIR/Programs/response-pending.pl $USER_EMAIL_DIR/Data/response-pending.config 1"; + +############################################################################### +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 find 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"; +} +############################################################################### + +# Lock a file to make sure only one copy of this script is running at once, ever +open(LOCKFILE,">/tmp/feed-pending-response.pl.$USER_NAME.locked-if-running"); +if (not flock(LOCKFILE,LOCK_EX | LOCK_NB)) { + print "$!\n"; + print "Unable to lock /tmp/feed-pending-response.pl.$USER_NAME.locked-if-running, $USER_NAME must be running another copy of feed-pending-response.pl. Aborting...\n"; + exit(1); +} + +system("/bin/cp -fpa $USER_INCOMING_CLOBBER_FOLDER ${USER_INCOMING_CLOBBER_FOLDER}.old"); + +# We want to archive the folders we process, for debugging purposes. +# Ward, 2006-05-01 +use POSIX qw(strftime); +my $now_string = strftime "%Y-%m-%d-%H:%M:%S", localtime; +system("/bin/cp -fpa $USER_RESPONSE_PENDING_FOLDER $USER_EMAIL_DIR/Archives/${USER_RESPONSE_PENDING_MAILBOX}-$now_string.archive"); +system("/bin/cp -fpa $USER_INCOMING_CLOBBER_FOLDER $USER_EMAIL_DIR/Archives/${USER_INCOMING_CLOBBER_MAILBOX}-$now_string.archive"); + +# Make a temporary copy of the 2 mailboxes we process, so that we don't try to +# keep a lock for the 20 minutes or so it can take $USER_RESPONSE_PROGRAM to +# complete. Otherwise, Procmail will just wipe the .lock file after a while, +# because it assumes it is stale. This can have weird consequences. +foreach my $file ($USER_RESPONSE_PENDING_MAILBOX, $USER_INCOMING_CLOBBER_MAILBOX) { + my $ioFile = LockFile("$USER_EMAIL_DIR/Folders/$file", "+<", LOCK_EX); + + system("/bin/cp -fpa $USER_EMAIL_DIR/Folders/$file $USER_EMAIL_DIR/Folders/$file-$now_string.tmp"); + + truncate $ioFile, 0; + + CloseAndUnlockFile($ioFile, "$USER_EMAIL_DIR/Folders/$file"); +} + +# Now process the temporary files, and delete them at the end. + +# The $firstrun parameter is 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. +# WVW, 2006-06-02 + +my $firstrun = 1; +foreach my $file ("$USER_EMAIL_DIR/Folders/$USER_RESPONSE_PENDING_MAILBOX-$now_string.tmp", "$USER_EMAIL_DIR/Folders/$USER_INCOMING_CLOBBER_MAILBOX-$now_string.tmp") { + my $ioFile = LockFile($file, "+<", LOCK_EX); + + open(RESPONSE_PRG, "|$USER_RESPONSE_PROGRAM $firstrun") + || die "unable to run $USER_RESPONSE_PROGRAM:$!"; + + while (my $line = <$ioFile>) { + print RESPONSE_PRG $line; + } + close(RESPONSE_PRG); + if ($? != 0) { + CloseAndUnlockFile($ioFile, $file); + die "$USER_RESPONSE_PROGRAM failed to take my data: $!" ; + } + + CloseAndUnlockFile($ioFile, $file); + + system("/bin/rm -f $file"); + $firstrun = 0; + +} + +# Unlock lock file +flock(LOCKFILE,LOCK_UN | LOCK_NB); +close(LOCKFILE); + diff --git a/src/response-pending.pl b/src/response-pending.pl new file mode 100755 index 0000000..04fc8f9 --- /dev/null +++ b/src/response-pending.pl @@ -0,0 +1,837 @@ +#!/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 [] []\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 = ; chomp $RESPONSE_MAILBOX; +my $PENDING_FILE = ; chomp $PENDING_FILE; + +my $RESPONDED_REPORT_FILE = ; chomp $RESPONDED_REPORT_FILE; +my $RESPONDED_MESSAGE_ID_FILE = "${RESPONDED_REPORT_FILE}.msgIDs"; +my $RESPONSE_ADDR_REGEX = ; chomp $RESPONSE_ADDR_REGEX; + +my $NO_RESPONSE_REPORT_TO_EMAIL = ; chomp $NO_RESPONSE_REPORT_TO_EMAIL; +my $NO_RESPONSE_REPORT_FROM_LINE = ; +chomp $NO_RESPONSE_REPORT_FROM_LINE; +my $MAIL_HOST = ; chomp $MAIL_HOST; +my $ROOT_PATH = ; 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 <> '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 <> '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 = ) { + 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: -- 2.25.1