#! @PERL@ -w # ==================================================================== # Copyright (c) 2000,2002, MeepZor Consulting. # All rights reserved. # # The use and distribution of this code or document is # governed by version 1.0.1 of the MeepZor Consulting Public # Licence (MCPL), which may be found on the Internet at # . # # # $Id: autoresponder.in,v 1.19 2002/09/17 10:33:04 coar Exp $ # use strict; package autoresponder; my $VERSION = '$Id: autoresponder.in,v 1.19 2002/09/17 10:33:04 coar Exp $'; $VERSION =~ s§^\$[I]d: (.*)(?:\.in),v\s+([.\d]*).*§$1 v@PACKAGE_VERSION@ (r$2)§g; my $aborted = 1; $! = 0; $SIG{'INT'} = $SIG{'TERM'} = $SIG{'URG'} = \&exit_on_signal; # # A rather hackish script to deal with incoming mail; a sort of # email receptionist. It sends a standard reply back to the sender. # Invoked through .forward or .qmail files. # # Options: # --accept-for=address-list # Addresses for which we're answering. If specified, at least # one of these must appear in the To: or Cc: list, or the # incoming message will be ignored and no autoresponse sent. # # --debug # Enables verbose mode and disables actual sending of the # autoresponse. # # --from=address # The address to put into the 'From:' field of the response. # Mail settings may prevent this from taking effect if this # is not the same as the actually responding account; some # systems take a dim view of such masquerades. # # --file=reply-text # The name of the file comprising the response text. Only # text files are supported at this time. # # --cc=address-list # A comma-separated list of addresses to include in the # response's Cc field. Defaults to no Cc list. # # --bcc=address-list # A comma-separated list of addresses to include in the # response's Bcc field. Defaults to no Bcc list. # # --errors-to=address-list # A comma-separated list of addresses to include in the # response's Errors-To field; these should receive notification # of any problems if the response doesn't reach its destination. # Defaults to no Errors-To list. # # --edit-response # Causes the response text to be edited to substitute things like # the date/time, original subject, original sender, et cetera. # # --[no]rc-file[=filename] # Identifies a file to be used instead of $HOME/.autoresponderrc; # useful when $HOME isn't defined. Obviously a no-op inside an # rc file. # # --sender=email-address # An email address to put into the message "From" field (distinct # from the "From:" field). This is useful for environments which # don't honour the Errors-To field. Defaults to the value of the # --errors-to option if one is set, otherwise to the value of the # --from option. # # --subject=printf-string # A string to be used when constructing the Subject: of the # response message. "%s" in the string will be replaced by # the subject of the original message, after removal of any # leading 'Re: ' or 'Sv: ' strings. Defaults to "Re: %s". # # --[no]include-original # Indicates whether or not the original message should be # included in the response as a MIME attachment. Default is no. # # --work-dir=directory # Specifies where temporary files should be placed; this may # be important if large messages are sent to the autoresponder's # address. Defaults to "/tmp". # # --no-reply-to=pattern [...] # Deprecated; replaced by --ignore-from. # # --ignore-from=pattern [...] # Specifies a regular expression pattern (see 'man perlre') used # to match origins to which replies should *not* be sent. This # option may occur multiple times. # Example: "--ignore-from 'MAILER-DAEMON.*@' --ignore-from 'postmaster@'" # # --ignore-header="field:pattern" [...] # Specifies a mail header field name and a regular expression pattern # (see 'man perlre') to match against the field's value. If the # pattern matches, an autoresponse is *not* sent. The field name # is case-sensitive; the pattern is not. This option may occur # multiple times. # Example: "--ignore-header 'X-Spam-Status:yes' # # --ignore-precedence=pattern # Specifies a regular expression pattern (see 'man perlre') used # to match the precedence of messages to which replies should *not* # be sent. This option may occur multiple times. # Example: "--ignore-precedence 'bulk|list'" # # --ignore-subject=pattern [...] # Specifies a regular expression pattern (see 'man perlre') used # to match subjects of messages to which replies should *not* be sent. # This option may occur multiple times. # Example: "--ignore-subject 'I LOVE YOU'" # # --precedence=mailpri # Specifies the precedence of the autoresponse message. The # default is "bulk". # Example: "--precedence first-class" # # --verbose # Passes remarks about why it does things. Also turned on by --debug. # # --version # Display the version of the programme, and exit. # # Options are taken from the command line. If a ~/.autoresponderrc file # exists, its contents are read and prefixed to the command line arguments. # Blank lines, lines containing only whitespace, and lines beginning with # a '#' (with or without leading whitespace) are treated as comments and # ignored. The effect is equivalent to # # autoresponder `cat ~/.autoresponderrc` command-line-args # # As a consequence, options in the .autoresponderrc may be specified # either as one per line or multiple options per line, but '\' continuation # characters should *not* be used. # # The --rc-file option can be used to specify an option file other # than ~/.autoresponderrc (useful for sendmail environments like .forward # in which $HOME might not be defined). # use POSIX qw(strftime); use MIME::Parser; use Getopt::Long; use MIME::Base64; use Fcntl; require 'shellwords.pl'; # # Predeclare some of the cells we use later. # my (%history, %ignore_header, %opt_list); my (@text, @tmplines); my ($answer_subject, $boundary, $got_options, $header, $lines, $msgid, $original_precedence, $original_subject, $originally_cc, $originally_to, $parser, $references, $refs, $remark, $snub, $tmpfile); # # Predeclare the cells set by the GetOptions call. # my (@accept_for, $from, $cc, $bcc, $debug, $edit_response, $errors_to, $text, @hist_add, $dbfile, $hist_list, @hist_remove, @ignore_from, @ignore_header, $interval, @ignore_subject, @ignore_precedence, $include_original, $log_file, @no_reply_to, $precedence, $sender, $subject, $verbose, $version, $workdir); my $LOG = \*STDERR; my $USE_HISTORY = @OPTION_HISTORY@; if ($USE_HISTORY) { eval { require SDBM_File; require Mail::Address; }; if ($@) { $USE_HISTORY = 0; Log("unable to use history functions", "$@"); } else { Verbose("history function enabled"); } } my $whoami = "$0"; my $SENDMAIL = "@SENDMAIL@"; my $now = time(); @ignore_from = qw(self); %opt_list = ("accept-for|for=s@" => \@accept_for, "from|f=s" => \$from, "cc|c=s" => \$cc, "bcc|b=s" => \$bcc, "debug!" => \$debug, "edit-response|e!" => \$edit_response, "errors-to|e=s" => \$errors_to, "file|t=s" => \$text, "history-add=s@" => \@hist_add, "history-db|db=s" => \$dbfile, "history-list!" => \$hist_list, "history-remove|history-delete=s@" => \@hist_remove, "ignore-from=s@" => \@ignore_from, "ignore-header=s@" => \@ignore_header, "ignore-interval=i" => \$interval, "ignore-subject=s@" => \@ignore_subject, "ignore-precedence=s@"=> \@ignore_precedence, "include-original|o!" => \$include_original, "log-file=s" => \$log_file, "no-reply-to=s@" => \@no_reply_to, "precedence=s" => \$precedence, "sender=s" => \$sender, "subject|s=s" => \$subject, "verbose|v" => \$verbose, "version|V" => \$version, "work-dir|w=s" => \$workdir ); my $init_file; my $noinit; my %init_options = ('rc-file|i=s' => \$init_file, 'norc-file' => \$noinit); @opt_list{keys(%init_options)} = values(%init_options); my %ignore_fields = (); # # Check to see if we have a .rc file, and process it if so. # my $user = $ENV{'USER'} || getlogin() || getpwuid($<); my $homedir = $ENV{'HOME'} || (getpwnam($user))[7]; my $rc = "$homedir/.autoresponderrc"; # # Now see if we have an override for the init file. # my (@save_ARGV) = @ARGV; Getopt::Long::Configure('pass_through'); my $gotopts = GetOptions(%init_options); Getopt::Long::Configure('no_pass_through'); if (defined($init_file)) { $rc = $init_file; } @ARGV = @save_ARGV; if ((! defined($noinit)) && (-r $rc)) { my(@save_ARGV) = @ARGV; my(@temp_ARGV) = (); open RCFILE, "<$rc" or die("Can't open file $rc"); while () { # # Skip comment lines # next if (m:^\s*#: || m:^\s*$:); chomp; push(@temp_ARGV, shellwords($_)); } close(RCFILE); @ARGV = (); push(@ARGV, @temp_ARGV, @save_ARGV); } $got_options = GetOptions(%opt_list); if (defined($log_file)) { open(LOGFILE, ">> $log_file") or die("Can't open log $log_file: $!"); $LOG = \*LOGFILE; } $verbose = ($verbose || $debug); Verbose("Version '$VERSION'"); if (defined($rc) && (-r $rc)) { Verbose("used rc-file '$rc'"); } else { Verbose("didn't use rc-file($rc)"); } if ($version) { printf "$VERSION\n" . "Copyright (c) 2002 by MeepZor Consulting. All rights reserved.\n"; Decline(0); } my @errors = (); if (! $from) { push(@errors, "Must specify a From: address (--from=address option)"); } if ($text && (! -f $text)) { push(@errors, "Reply file '$text' must be readable!"); } if (! $workdir) { $workdir = "/tmp"; } if (! $precedence) { $precedence = "bulk"; } if (! -d $workdir) { push(@errors, "Working area '$workdir' is not a directory!"); } if (! $subject) { $subject = "Re: %s"; } if (! $sender) { $sender = $errors_to || $from; } my $hist_manip = (@hist_add || @hist_remove || $hist_list); if ((! defined($interval)) || (($interval < 30) && $hist_manip)) { Verbose("--ignore-interval being set to 30 seconds"); $interval = 30; } if ($verbose) { Log("using --ignore-interval of $interval seconds"); } if ($dbfile) { if ($USE_HISTORY) { Verbose("attempting to tie database file '$dbfile'"); tie(%history, 'SDBM_File', $dbfile, O_RDWR|O_CREAT, 0700) or do { $USE_HISTORY = 0; Log("unable to access/create history database '$dbfile'", "tie: $!"); }; Verbose("history database accessed"); } if (! $USE_HISTORY) { Log("history functions disabled, --history-db ignored"); } } else { $USE_HISTORY = 0; if ($hist_manip) { push(@errors, '--history-db option not specified'); } } if ($USE_HISTORY && $hist_manip) { Verbose("Performing history database maintenance operations only"); for my $eddress (@hist_add) { $eddress =~ s:\@(.*):\@\L$1\E:g; my $eligible = $interval ? ($now + $interval) : 0; Verbose("Setting eligibility to '" . scalar(localtime($eligible)) . "' (interval=$interval)"); $history{$eddress} = $eligible; } for my $eddress (@hist_remove) { $eddress =~ s:\@(.*):\@\L$1\E:g; # # Set his eligibility to a time in the past rather than deleting # him. Maybe later we'll deal with deleting entries.. # Verbose("marking $eddress as autorespondable"); $history{$eddress} = 1; } if (defined($hist_list) && $hist_list) { print STDOUT "Entries currently in do-not-reply database:\n"; for my $eddress (keys(%history)) { my $eligible = $history{$eddress}; if ($eligible == 0) { print STDOUT "$eddress = never autorespond\n"; } elsif ($eligible > $now) { print STDOUT "$eddress = autorespondable after " . scalar(localtime($eligible)) . "($eligible)\n"; } elsif ($debug) { print STDOUT "$eddress = autorespondable after " . scalar(localtime($eligible)) . "($eligible)\n"; } } } Decline(0); } $whoami = $debug ? "$0 (debug)" : $0; if (@errors) { Log(@errors); if ((! $debug) || ($hist_manip && (! $USE_HISTORY))) { Decline(1); } } Verbose("Responding from: $from"); if (@no_reply_to) { push(@ignore_from, @no_reply_to); Log("--no-reply-to deprecated; use --ignore-from instead"); } # # If we had any --ignore-header values, parse 'em out for use. # for my $h (@ignore_header) { my($hname, $hvalue) = split(qr{\s*:\s*}, $h, 2); if ($verbose && exists($ignore_fields{$hname})) { Log("--ignore-header pattern '" . $ignore_header{$hname} . "' replaced with '$hvalue'"); } $ignore_fields{$hname} = $hvalue; } # # Try to keep everything in memory; failing that, keep it in the # /tmp directory. Note that this MUST NOT be done with the full # dump! # $parser = new MIME::Parser; $parser->output_to_core(10000000); $parser->output_dir($workdir); # # Force cleanup if the version of MIME::Parser we're using supports it. # eval { $parser->tmp_recycling(0); }; # # Read the input and copy it to a temporary file.. (Wouldn't work # otherwise.) # $tmpfile = "$workdir/regdata-$$.data"; @tmplines = ; open(OUT, ">$tmpfile"); print OUT @tmplines; close(OUT); # # Read it in and make an entity of it. # open(IN, "<$tmpfile"); my $entity = $parser->read(\*IN) or die("Couldn't parse input file"); close(IN); unlink($tmpfile); # # Extract the bits we need for the reply header. # my $answer_to = $entity->get('Reply-to') || $entity->get('From') || $entity->get('Sender'); chomp($answer_to); if (! $answer_to) { Log("no valid origin address"); Decline(0); } Verbose('beginning processing of message ' . $entity->get('Message-ID')); my $histkey = $answer_to; if ($USE_HISTORY) { my @address_list = Mail::Address->parse($histkey); my $addr = shift(@address_list); $histkey = $addr->address; $histkey =~ s:\@(.*):\@\L$1\E:g; Verbose("source '$answer_to' munged to '$histkey'"); } chomp($original_subject = $entity->get('Subject') || ''); chomp($original_precedence = $entity->get('Precedence') || ''); chomp($remark = $entity->get('X-Remark') || ''); chomp($originally_to = $entity->get('To') || ''); chomp($originally_cc = $entity->get('Cc') || ''); # # First off, is this a reply from an instantiation of ourselves? # if ($remark =~ m:Automatic response generated by.*autoresponder:i) { Verbose("exiting; talking to a remote incarnation of myself"); Decline(0); } # # Check to see if the message was sent to one of our addresses. # if (@accept_for) { my $proceed = 0; for my $okaddr (@accept_for) { if (($originally_to =~ qr/$okaddr/i) || ($originally_cc =~ qr/$okaddr/i)) { $proceed = 1; last; } } if (! $proceed) { Verbose("exiting; message was not sent to an address we answer"); Decline(0); } } # # See if the originator is someone we're supposed to snub. # if (@ignore_from) { foreach my $snub (@ignore_from) { # # Check for the special keyword 'self' which means our own # messages. # if ($snub =~ /^self$/i) { $snub = $from; } if ($answer_to =~ /$snub/i) { Verbose("exiting; originator matched /$snub/\n"); Decline(0); } } } # # Now check the ignoble subjects.. # if (@ignore_subject) { foreach $snub (@ignore_subject) { if ($original_subject =~ /$snub/i) { Verbose("exiting; subject matched /$snub/"); Decline(0); } } } # # Now the detestable precedences. # if (@ignore_precedence) { foreach $snub (@ignore_precedence) { if ($original_precedence =~ /$snub/i) { Verbose("exiting; precedence matched /$snub/"); Decline(0); } } } # # Now the execrable header fields. # for my $hname (keys(%ignore_fields)) { my $pattern = $ignore_fields{$hname}; my $hvalue = $entity->get($hname) || ''; chomp($hvalue); Verbose("checking header field '$hname' value '$hvalue' " . "against pattern /$pattern/"); if ($hvalue && ($hvalue =~ qr/$pattern/i)) { Verbose("exiting; header field '$hname' value '$hvalue' " . "matched /$pattern/"); Decline(0); } } # # If the history processing is enabled, see if the sender is # in it and eligible for a response. # if ($USE_HISTORY) { Verbose("checking for last message from $histkey"); if (defined($history{$histkey})) { my $ok_after = $history{$histkey}; # # If the last-message for this source is zero, it means 'never reply.' # (This is basically so you can put known correspondents into the # database and they'll bypass the autoreply. For busy people. # # If the time in the database has passed, we can reply. This can # cause a bit of a disconnect if multiple runs are made with # different values of --ignore-interval; a lower value won't # overcome an enty previously stored with a higher one. # if ($ok_after == 0) { Log("we never autorespond to '$histkey'"); Decline(0); } elsif ($now < $ok_after) { Log("too soon to repy to '$histkey'", "okey after $ok_after, but it is now $now"); Decline(0); } } else { Verbose("seems like a first-timer"); } } # # If the original message was labelled as a reply, remove the label # before feeding it into our new subject creator. # if ($original_subject !~ m/^(Re|Sv): /i) { $original_subject =~ s/^$1//; } $answer_subject = sprintf($subject, $original_subject); chomp($refs = $entity->get('References') || ''); chomp($msgid = $entity->get('Message-Id') || ''); # # Create the new References: value. # $references = $msgid . ($refs ? ", $refs" : ""); # # Create a reply and fill in the bits. # $boundary = sprintf("%s%s", ("-" x 16), encode_base64(sprintf("%0x", time()))); $boundary =~ s/=//g; # # First, the text of the message we're sending back. # if ($text) { Verbose("reading specified response text"); open(REPLY, "<$text"); @text = ; close(REPLY); $text = join('', @text); } else { Verbose("using canned response"); $text = <get('From') || $entity->get('Sender')); my $gmt = strftime("%a, %d %b %Y %T GMT", gmtime()); my $at = strftime("%a, %d %b %Y %T %z", localtime()); $text =~ s:%S:$original_subject:gs; $text =~ s:%F:$originator:gs; $text =~ s:%T:$originally_to:gs; $text =~ s:%U:$gmt:gs; $text =~ s:%[\@L]:$at:gs; } @text = split(m:\n:, $text); $lines = @text; # # Now the header. # $header = <build(Type => "multipart/mixed", Boundary => $boundary); $MIME_reply->head->mime_encoding("7bit"); foreach my $field (split(m:\n:, $header)) { $field =~ m/^([^:]*):\s*(.*)/; my($fname, $fval) = ($1, $2); if ($fname && ($fname !~ /content-type/i)) { $MIME_reply->head->set($fname, $fval); } } $MIME_reply->attach(Data => $text); # # Right, there's our actual reply text. Now to attach the # original message.. # my $original = $entity->stringify(); $MIME_reply->attach(Type => 'message/rfc822', Data => $original); $MIME_reply->print(\*MAILER); } close(MAILER); } # # Now record when we sent this, if we're doing that sort of thing. # if ($USE_HISTORY && (! $debug)) { Verbose("recording that we replied to this source"); $history{$histkey} = $now + $interval; untie(%history); } $aborted = 0; exit(0); # # Debugging routines.. # sub Log { chomp(my @list = @_); my $message = join("\001", @list); $message =~ s§\n§\001§gs; $message =~ s§\001{2,}§\001§g; $message =~ s§\001§\001$whoami: §g; $message =~ s§\001§\n§gs; print $LOG "$whoami: $message\n"; } sub Verbose { if ($verbose) { return Log(@_); } return $verbose; } # # Die cleanly but prematurely, without requesting reincarnation; we've # determined that it's inappropriate for us to do anything with the # message. # sub Decline { my $evalue = shift or 0; $aborted = 0; exit($evalue); } # # Handle a please-die signal. # sub exit_on_signal { my $signame = shift; $aborted = 1; die("Caught signal SIG$signame"); } # # Wrapping up and departing. If we aborted for whatever reason, # return a defer status so the message will be retried later. # sub END { if ($aborted) { print STDERR "Deferring message and exiting\n"; $? = 75; } }