;# $Id: filter.pl,v 3.0.1.11 2001/03/13 13:13:37 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
;# You may redistribute only under the terms of the Artistic License,
;# as specified in the README file that comes with the distribution.
;# You may reuse parts of this distribution only within the terms of
;# that same Artistic License; a copy of which may be found at the root
;# of the source tree for mailagent 3.0.
;#
;# $Log: filter.pl,v $
;# Revision 3.0.1.11 2001/03/13 13:13:37 ram
;# patch71: changed SUBST/TR parameter parsing to support header fields
;#
;# Revision 3.0.1.10 1998/03/31 15:22:19 ram
;# patch59: when "vacfixed" is on, forbid any change of vacation message
;# patch59: new ON command to process commands on certain days only
;#
;# Revision 3.0.1.9 1997/09/15 15:15:04 ram
;# patch57: fixed ASSGINED -> ASSIGNED typo in log message
;# patch57: implemented new -t and -f flags for BEGIN and NOP
;# patch57: insert user e-mail address if no address for NOTIFY
;#
;# Revision 3.0.1.8 1996/12/24 14:51:51 ram
;# patch45: added initial logging of the SELECT command
;#
;# Revision 3.0.1.7 1995/08/07 16:18:57 ram
;# patch37: new BIFF command
;#
;# Revision 3.0.1.6 1995/01/25 15:20:39 ram
;# patch27: new commands BEEP and PROTECT
;#
;# Revision 3.0.1.5 1995/01/03 18:10:04 ram
;# patch24: commands now get a string with the command name chopped off
;# patch24: modified &alter_execution to accomodate new option parsing
;#
;# Revision 3.0.1.4 1994/10/04 17:50:24 ram
;# patch17: SERVER will now discard whole message on errors
;#
;# Revision 3.0.1.3 1994/09/22 14:20:43 ram
;# patch12: propagated change to the &queue_mail interface
;# patch12: added stubs for DO and AFTER commands
;#
;# Revision 3.0.1.2 1994/07/01 15:00:30 ram
;# patch8: new UMASK command
;#
;# Revision 3.0.1.1 1994/01/26 09:31:43 ram
;# patch5: added tags to UNIQUE and RECORD commands
;#
;# Revision 3.0 1993/11/29 13:48:46 ram
;# Baseline for mailagent 3.0 netwide release.
;#
;#
;# There are a number of variables which are used by the filter commands and
;# which are in the dynamic scope when those functions are called. The calling
;# tree being: analyze_mail -> xeqte -> run_command -> run_*, where '*' stands
;# for the action we are currently executing.
;#
;# All the run_* commands are called from within an eval by run_command, so that
;# any otherwise fatal error can be trapped and reported in the log file. This
;# is only a precaution against possible typos or other unpredictable errors.
;#
;# The following variables are inherited from run_command:
;# $mfile is the name of the mail file processed
;# $cmd is the command to be run
;# $cms is the same as $cmd but with options and command name chopped off
;# $cmd_name is the command name (upper-cased)
;# $ever_saved which states whether a saving/discarding action occurred
;# $cont is the continuation status, modified by REJECT and friends
;# $vacation which is a boolean stating whether vacation messages are allowed
;# The following variable is inherited from analyze_mail:
;# $lastcmd is the failure status of the last command (among those to be kept)
;# The working mode is held in $wmode (comes from analyze_mail).
;#
;# All the commands return an exit status: 0 for ok, 1 for failure. This status
;# is normally recorded in $lastcmd by run_command, unless the executed action
;# belongs to the set of commands whose exit status is discarded (because they
;# can never fail).
;#
#
# Filter commands are run from here
#
# Run the PROCESS command
sub run_process {
if (0 != &process) {
&add_log("ERROR while processing [$mfile]--queing it") if $loglvl;
&queue_mail($file_name, 'fm');
return 1;
}
&add_log("PROCESSED [$mfile]") if $loglvl > 8;
0;
}
# Run the SERVER command
sub run_server {
&cmdenv'inituid; # Initialize server session environment
&cmdserv'trusted if $opt'sw_t; # Server runs in trusted mode
&cmdserv'disable($opt'sw_d) if $opt'sw_d; # Disable commands for this run
local(@body) = split(/\n/, $Header{'Body'});
local($failed) = &cmdserv'process(*body);
unless ($failed) {
&add_log("SERVED [$mfile]") if $loglvl > 8;
} else {
&add_log("ERROR unable to serve [$mfile]--discarded") if $loglvl;
}
$failed;
}
# Run the LEAVE command
sub run_leave {
local($mbox, $failed) = &leave;
unless ($failed) {
&add_log("LEFT [$mfile] in mailbox") if $loglvl > 2;
}
# Even if it failed, mark it as saved anyway, as the default action would
# be a saving in mailbox and there is little chance another attempt would
# succeed while this one failed.
$ever_saved = 1; # At least we tried to save it
$failed;
}
# Run the SAVE command
sub run_save {
local($folder) = @_; # Folder where message should be saved
&save_message($folder);
}
# Run the STORE command
sub run_store {
local($folder) = @_; # Folder where message should be saved
local($mbox, $failed, $log_message) = &run_saving($folder, $FOLDER_APPEND);
unless ($failed) {
$ever_saved = 1; # We were able to save it
($mbox, $failed) = &leave;
unless ($failed) {
&add_log("STORED [$mfile] in $log_message") if $loglvl > 2;
} else {
&add_log("WARNING only SAVED [$mfile] in $log_message")
if $loglvl > 1;
return 1;
}
} else {
($mbox, $failed) = &leave;
unless ($failed) {
$ever_saved = 1; # We were able to save it
&add_log("WARNING only LEFT [$mfile] in mailbox")
if $loglvl > 1;
}
}
$failed;
}
# Run the WRITE command
sub run_write {
local($folder) = @_; # Folder where message should be saved
local($mbox, $failed, $log_message) = &run_saving($folder, $FOLDER_REMOVE);
unless ($failed) {
&add_log("WROTE [$mfile] in $log_message") if $loglvl > 2;
$ever_saved = 1; # We were able to save it
}
$failed;
}
# Run the DELETE command
sub run_delete {
&add_log("DELETED [$mfile]") if $loglvl > 2;
$ever_saved = 1; # User chose to discard it, it counts as a save
0;
}
# Run the MACRO command
sub run_macro {
local($args) = @_; # Get command arguments
local($name, $action) = ¯o($args); # Perform the command
&add_log("MACRO [$mfile] $name $action") if $loglvl > 7;
0; # Never fails
}
# Run the MESSAGE command
sub run_message {
local($msg) = @_; # Vacation message location
$msg =~ s/~/$cf'home/g; # ~ substitution
local($failed) = &message($msg);
unless ($failed) {
$msg = &tilda($msg); # Replace the home directory by ~
&add_log("MESSAGE $msg for [$mfile]") if $loglvl > 2;
}
$failed;
}
# Run the NOTIFY command
sub run_notify {
local($args) = @_;
local(@args) = split(' ', $args);
local($msg) = shift(@args); # First argument is message text
$msg =~ s/~/$cf'home/g; # ~ substitution
local($address) = join(' ', @args); # Address list
$address = $cf'email if $address eq ''; # No address, defaults to user
local($failed) = ¬ify($msg, $address);
unless ($failed) {
$msg = &tilda($msg); # Replace the home directory by ~
&add_log("NOTIFIED $msg [$mfile] to $address") if $loglvl > 2;
}
$failed;
}
# Run the REJECT command
sub run_reject {
local(*perform) = *do_reject;
&alter_flow; # Change control flow by calling &perform
}
# Run the RESTART command
sub run_restart {
local(*perform) = *do_restart;
&alter_flow; # Change control flow by calling &perform
}
# Run the ABORT command
sub run_abort {
local(*perform) = *do_abort;
&alter_flow; # Change control flow by calling &perform
}
# Run the RESYNC command
sub run_resync {
&header_resync; # Resynchronize the %Header array
&add_log("RESYNCED [$mfile]") if $loglvl > 4;
0;
}
# Run the BEGIN command
sub run_begin {
local($newstate) = @_; # New state wanted
return 0 if $opt'sw_t && $lastcmd; # -t means change only if true
return 0 if $opt'sw_f && !$lastcmd; # -f means change only if false
$newstate = 'INITIAL' unless $newstate;
$wmode = $newstate; # $wmode comes from analyze_mail
&add_log("BEGUN new state $newstate") if $loglvl > 4;
0;
}
# Run the RECORD command
sub run_record {
local($mode) = @_;
local($tags);
$mode =~ s|^(\w*)\s*\(([^()]*)\).*|$1| && ($tags = $2);
local($failed) = 0;
if (&history_tag($tags)) { # Message already seen
$wmode = '_SEEN_'; # Enter special mode ($wmode from analyze_mail)
&add_log("NOTICE entering seen mode") if $loglvl > 5;
&alter_execution('x', $mode);
$failed = 1; # Make sure it "fails"
}
local($tagmsg) = $tags ne '' ? " ($tags)" : '';
&add_log("RECORDED [$mfile]" . $tagmsg) if $loglvl > 4;
$failed;
}
# Run the UNIQUE command
sub run_unique {
local($mode) = @_;
local($tags);
$mode =~ s|^(\w*)\s*\(([^()]*)\).*|$1| && ($tags = $2);
local($failed) = 0;
if (&history_tag($tags)) { # Message already seen
&add_log("NOTICE message tagged as saved") if $loglvl > 5;
$ever_saved = 1; # In effect, runs a DELETE
&alter_execution('x', $mode);
$failed = 1; # Make sure it "fails"
}
local($tagmsg) = $tags ne '' ? " ($tags)" : '';
&add_log("UNIQUE [$mfile]" . $tagmsg) if $loglvl > 4;
$failed;
}
# Run the FORWARD command
sub run_forward {
local($addresses) = @_; # Address(es)
local($failed) = &forward($addresses);
unless ($failed) {
&add_log("FORWARDED [$mfile] to $addresses") if $loglvl > 2;
$ever_saved = 1; # Forwarding succeeded, counts as a save
}
$failed;
}
# Run the BOUNCE command
sub run_bounce {
local($addresses) = @_; # Address(es)
local($failed) = &bounce($addresses);
unless ($failed) {
&add_log("BOUNCED [$mfile] to $addresses") if $loglvl > 2;
$ever_saved = 1; # Bouncing succeeded, counts as a save
}
$failed;
}
# Run the POST command
sub run_post {
local($newsgroups) = @_; # Newsgroup(s)
local($failed) = &post($newsgroups);
unless ($failed) {
&add_log("POSTED [$mfile] to $newsgroups") if $loglvl > 2;
$ever_saved = 1; # Posting succeeded, counts as a save
}
$failed;
}
# Run the RUN command
sub run_run {
local($program) = @_; # Program to run
local($failed) = &shell_command($program, $NO_INPUT, $NO_FEEDBACK);
unless ($failed) {
&add_log("RAN '$program' for [$mfile]") if $loglvl > 4;
}
$failed;
}
# Run the PIPE command
sub run_pipe {
local($program) = @_; # Program to run
local($failed) = &shell_command($program, $MAIL_INPUT, $NO_FEEDBACK);
unless ($failed) {
&add_log("PIPED [$mfile] to '$program'") if $loglvl > 4;
}
$failed;
}
# Run the GIVE command
sub run_give {
local($program) = @_; # Program to run
local($failed) = &shell_command($program, $BODY_INPUT, $NO_FEEDBACK);
unless ($failed) {
&add_log("GAVE [$mfile] to '$program'") if $loglvl > 4;
}
$failed;
}
# Run the PASS command
sub run_pass {
local($program) = @_; # Program to run
local($failed) = &shell_command($program, $BODY_INPUT, $FEEDBACK);
unless ($failed) {
&add_log("PASSED [$mfile] through '$program'") if $loglvl > 4;
}
$failed;
}
# Run the FEED command
sub run_feed {
local($program) = @_; # Program to run
local($failed) = &shell_command($program, $MAIL_INPUT, $FEEDBACK);
unless ($failed) {
&add_log("FED [$mfile] through '$program'") if $loglvl > 4;
}
$failed;
}
# Run the PURIFY command
sub run_purify {
local($program) = @_; # Program to run
local($failed) = &shell_command($program, $HEADER_INPUT, $FEEDBACK);
unless ($failed) {
&add_log("PURIFIED [$mfile] through '$program'") if $loglvl > 4;
}
$failed;
}
# Run the BACK command
# Manipulates dynamically bound variable $cont (output from xeqte)
sub run_back {
local($command) = @_;
# The BACK command is handled recursively. The local variable $Back will be
# set by xeq_back() if any feedback is to ever occur. This routine will be
# transparently called instead of the usual handle_output() because of the
# dynamic aliasing done here.
local($Back) = ''; # BACK may be nested
local(*handle_output) = *xeq_back; # Any output to be put in $Back
local($failed) = 0;
$command =~ s/%/%%/g; # Protect against 2nd macro substitution
# Calling run_command will position $lastcmd to be the return status of
# the last meaningful command executed. However, we reset $lastcmd before
# diving into the execution.
$lastcmd = 0; # Assume everything went fine
&run_command($command); # Run command (ignore return value)
if ($Back ne '') {
&add_log("got '$Back' back") if $loglvl > 11;
$cont = &xeqte($Back); # Get continuation status back
$@ = ''; # Avoid cascade of (same) error report
&add_log("BACK from '$command'") if $loglvl > 4;
} else {
&add_log("WARNING got nothing out of '$command'") if $loglvl > 5;
}
$lastcmd; # Propage error status we got from the $command
}
# Run the ON command
sub run_on {
local($_) = $cmd; # The whole command line
local(@days) = split(' ', 'Sun Mon Tue Wed Thu Fri Sat');
local(%days);
local($daynum) = 0;
foreach $day (@days) { # Initialize Sun => 0, Mon => 1, etc...
$days{$day} = $daynum++;
}
local(@on); # List of specified days
local(%on); # Hash '0' (for sunday) => 1 if selected
if (s/^ON\s*\(([^\)]*)\)//) { # List of days, like (Mon Tue)
@on = split(/,?\s+/, $1); # Allow (Mon Thu) and (Mon, Thu)
local($non);
foreach $on (@on) {
$non = $on; # New $on will be canonicalized
$non =~ s/^(...).*/\u\L$1/; # Keep only first 3 letters
unless (defined $days{$non}) {
&add_log("WARNING ignoring bad day $on in ON (@on)")
if $loglvl > 5;
next;
}
$on{$days{$non}}++; # E.g sets $on{1} for Mon
}
&add_log("on (@on)") if $loglvl > 18;
} else {
&add_log("ERROR bad ON syntax (did not parse right)") if $loglvl > 1;
return 1;
}
# Calling run_command will set $lastcmd to the status of the command. In
# case we are running a command which does not alter this status, assume
# everything is fine.
$lastcmd = 0; # Assume command will run correctly
s/^\s*//; # Remove leading spaces
local($wday) = (localtime(time))[6];
if (defined $on{$wday}) {
&add_log("ON (@on) $_") if $loglvl > 7;
s/%/%%/g; # Protect against 2nd macro substitution
$cont = &run_command($_); # Run command and update control flow
} else {
&add_log("not a good day for $_") if $loglvl > 12;
}
$lastcmd; # Propagates execution status
}
# Run the ONCE command
sub run_once {
local($_) = $cmd; # The whole command line
local($hname); # Hash name (e-mail address)
local($tag); # Tag associated with command
local($raw_period); # The period, as written
if (s/^ONCE\s*\(([^,\)]*),\s*([^,;\)]*),\s*(\w+)\s*\)//) {
($hname, $tag, $raw_period) = ($1, $2, $3);
&add_log("tag is ($hname, $tag, $raw_period)") if $loglvl > 18;
} else {
&add_log("ERROR bad once syntax (invalid tag)") if $loglvl > 1;
return 1;
}
s/^\s*//; # Remove leading spaces
local($period) = &seconds_in_period($raw_period);
&add_log("period is $raw_period = $period seconds") if $loglvl > 18;
# Calling run_command will set $lastcmd to the status of the command. In
# case we are running a command which does not alter this status, assume
# everything is fine.
$lastcmd = 0; # Assume command will run correctly
if (&once_check($hname, $tag, $period)) {
&add_log("ONCE ($hname, $tag, $raw_period) $_") if $loglvl > 7;
&s_once($cmd_name, $wmode, $tag);
s/%/%%/g; # Protect against 2nd macro substitution
$cont = &run_command($_); # Run it, update continuation status
} else {
&add_log("retry time not reached for $_") if $loglvl > 12;
&s_noretry($cmd_name, $wmode, $tag);
}
$lastcmd; # Propagates execution status
}
# Run the SELECT command
sub run_select {
local($_) = $cmd; # The whole command line
local($start, $end); # Date strings for start and end
if (s/^SELECT\s*\(([^.\)]*)\.\.\s*([^\)]*)\)//) {
($start, $end) = ($1, $2);
$start =~ s/\s*$//; # Remove trailing spaces
$end =~ s/\s*$//;
&add_log("time is ($start .. $end)") if $loglvl > 18;
} else {
&add_log("ERROR bad select syntax (invalid time)") if $loglvl > 1;
return 1;
}
local($now) = time; # Current time
local($sec_start, $sec_end); # Start and end converted in seconds
$sec_start = &getdate($start, $now);
if ($sec_start == -1) {
&add_log("ERROR in SELECT: 1st time '$start'") if $loglvl > 1;
return 1;
}
$sec_end = &getdate($end, $now);
if ($sec_end == -1) {
&add_log("ERROR in SELECT: 2nd time '$end'") if $loglvl > 1;
return 1;
}
if ($sec_start > $sec_end) {
&add_log("WARNING time selection always impossible?") if $loglvl > 1;
return 0;
}
# Calling run_command will set $lastcmd to the status of the command. In
# case we are running a command which does not alter this status, assume
# everything is fine.
$lastcmd = 0; # Assume command will run correctly
&add_log("SELECT ($sec_start, $sec_end) at $now") if $loglvl > 11;
s/^\s*//; # Remove leading spaces
if ($now >= $sec_start && $now <= $sec_end) {
&add_log("SELECT ($start .. $end) $_") if $loglvl > 7;
s/%/%%/g; # Protect against 2nd macro substitution
$cont = &run_command($_); # Run command and update control flow
} else {
&add_log("time period not good for $_") if $loglvl > 12;
}
$lastcmd; # Propagates execution status
}
# Run the NOP command
sub run_nop {
local($what) = $opt'sw_f ? 'failure' : ($opt'sw_t ? 'success' : '');
local($force) = $what ? " forcing $what" : '';
&add_log("NOP [$mfile]$force") if $loglvl > 7;
return 1 if $opt'sw_f; # -f forces failure
return 0 if $opt'sw_t; # -t forces failure
$lastcmd; # Propagates curremt exec status
}
# Run the STRIP command
sub run_strip {
local($headers) = @_; # Headers to remove
&alter_header($headers, $HD_STRIP);
$headers = join(', ', split(/\s/, $headers));
&add_log("STRIPPED $headers from [$mfile]") if $loglvl > 7;
0;
}
# Run the KEEP command
sub run_keep {
local($headers) = @_; # Headers to keep
&alter_header($headers, $HD_KEEP);
$headers = join(', ', split(/\s/, $headers));
&add_log("KEPT $headers from [$mfile]") if $loglvl > 7;
0;
}
# Run the ANNOTATE command
sub run_annotate {
local($field, $value) = $cms =~ m|([\w\-]+):?\s*(.*)|;
local($failed) = &annotate_header($field, $value);
unless ($failed) {
local($msg) = $opt'sw_d ? ' (no date)' : '';
&add_log("ANNOTATED [$mfile] with $field$msg") if $loglvl > 7;
}
$failed;
}
# Run the ASSIGN command
sub run_assign {
local($var, $value) = $cms =~ m|^(:?\w+)\s+(.*)|;
local($eval); # Evaluated value for expression
local($@);
# An expression may be provided as a value. If the whole value is enclosed
# within simple quotes, then those are stripped and no evaluation is made.
unless ($value =~ s/^'(.*)'$/$1/) {
eval "\$eval = $value"; # Maybe value is an expression?
if ($@) {
chop($@);
&add_log("WARNINIG can't evaluate '$value': $@");
} else {
$value = $eval;
}
}
if ($var =~ s/^://) {
&extern'set($var, $value); # Persistent variable is set
} else {
$Variable{$var} = $value; # User defined variable is set
}
&add_log("ASSIGNED '$value' to '$var' [$mfile]") if $loglvl > 7;
0;
}
# Run the TR command
sub run_tr {
local($variable, $tr) = $cms =~ m|^(\S+)\s+(.*)|;
&alter_value($variable, "tr$tr");
}
# Run the SUBST command
sub run_subst {
local($variable, $s) = $cms =~ m|^(\S+)\s+(.*)|;
&alter_value($variable, "s$s");
}
# Run the SPLIT command
sub run_split {
local($folder) = @_; # Folder where split occurs
local($failed) = &split($folder);
if (0 == $failed % 2) { # Message was in digest format
if ($failed & 0x4) {
&add_log("SPLIT [$mfile] in mailagent's queue") if $loglvl > 2;
} else {
&add_log("SPLIT [$mfile] in $folder") if $loglvl > 2;
}
# If digest was not in RFC-934 style, there is a chance the split
# was not correctly performed. To avoid any accidental loss of
# information, the original digest message is also saved if SPLIT
# had a folder argument, or it is not tagged saved.
if ($failed & 0x8) { # Digest was not RFC-934 compliant
&add_log("NOTICE [$mfile] not RFC-934 compliant") if $loglvl > 6;
if ($folder ne '') {
&add_log("NOTICE saving original [$mfile] in $folder")
if $loglvl > 6;
&save_message($folder);
} else {
&add_log("NOTICE [$mfile] not tagged as saved")
if $loglvl > 6 && ($failed & 0x2);
}
} else {
$ever_saved = 1 if $failed & 0x2; # Split -i succeeded
}
$failed = 0;
}
# If message was not in digest format and a folder was specified, save
# message in that folder.
if ($failed < 0 && $folder ne '') {
&add_log("NOTICE [$mfile] not in digest format") if $loglvl > 6;
$failed = &save_message($folder);
}
$failed ? 1 : 0; # Failure status from split can be negative
}
# Run the VACATION command
sub run_vacation {
return 0 unless $cf'vacation =~ /on/i; # Ignore if vacation mode off
local($mode, $period) = $cms =~ m|^(\S+)(\s+\S+)?|;
local($l) = $opt'sw_l ? ' locally' : '';
local($allowed) = ($mode =~ /off/i) ? 0 : 1;
&env'local('vacation', $allowed) if $opt'sw_l;
$env'vacation = $allowed; # Won't hurt given the above local call
if ($allowed && $mode !~ /^on$/i) { # New vacation path given
if ($cf'vacfixed =~ /on/i) { # Not allowed if vacfixed is ON
&add_log("WARNING no message change allowed by 'vacfixed'")
if $loglvl > 5;
} else {
$mode =~ s/^~/$cf'home/; # ~ substitution
&env'local('vacfile', $mode) if $opt'sw_l;
$env'vacfile = $mode;
&add_log("vacation message in file $mode$l") if $loglvl > 7;
}
}
if ($allowed && $period) {
&env'local('vacperiod', $period) if $opt'sw_l;
$env'vacperiod = $period;
&add_log("vacation period is now $period$l") if $loglvl > 7;
}
$mode = $env'vacation ? 'on' : 'off';
&add_log("vacation message turned $mode$l") if $loglvl > 7;
0;
}
# Run the QUEUE command
sub run_queue {
# Mail is saved as a 'qm' file, to avoid endless loops when mailagent
# processes the queue. This means the mail will be deferred for at
# least half an hour.
local($name) = &queue_mail('', 'qm'); # No file name, mail in %Header
$ever_saved = 1 if defined $name; # Queuing counts as saving
defined $name ? 0 : 1; # Failed if $name is undef
}
# Run the PERL command
sub run_perl {
local($script) = @_; # Script to be loaded
local($failed) = &perl($script);
unless ($failed) {
$script = &tilda($script); # Replace the home directory by ~
&add_log("PERLED [$mfile] through $script") if $loglvl > 7;
}
$failed;
}
# Run the REQUIRE command
sub run_require {
local($file, $package) = $cms =~ m|^(\S+)\s*(.*)|;
local($failed) = &require($file, $package);
unless ($failed) {
$file = &tilda($file); # Replace the home directory by ~
local($inpack) = $file; # Loaded in a package?
$inpack .= " in package $package" if $package ne '';
&add_log("REQUIRED [$mfile] $inpack") if $loglvl > 7;
}
$failed;
}
# Run the APPLY command
sub run_apply {
local($rulefile) = @_; # Rule file to be applied
local($failed, $saved) = &apply($rulefile);
unless ($failed) {
$rulefile = &tilda($rulefile); # Replace the home directory by ~
&add_log("APPLIED [$mfile] rules $rulefile") if $loglvl > 7;
}
$ever_saved = 1 if $saved; # Mark mail as saved if appropriate
$saved ? $failed : 1; # Force failure if never saved
}
# Run the UMASK command
sub run_umask {
local($mask) = @_;
$mask = oct($mask) if $mask =~ /^0/;
&env'local('umask', $mask) if $opt'sw_l; # Restored when leaving rule
$env'umask = $mask; # Permanent change, unless changed locally already
umask($env'umask);
local($omask) = sprintf("0%o", $mask); # Octal string, for logging
local($local) = $opt'sw_l ? ' locally' : '';
&add_log("UMASK [$mfile] set to ${omask}$local") if $loglvl > 7;
0; # Ok
}
# Run the AFTER command
sub run_after {
local($time, $action) = $cms =~ m|^\((.*)\)(.*)|;
local($failed, $queued) = &after($time, $action);
unless ($failed) {
local(@msg);
push(@msg, 'shell') if $opt'sw_s;
push(@msg, 'command') if $opt'sw_c;
push(@msg, 'no input') if $opt'sw_n;
push(@msg, 'agent') if $opt'sw_a || 0 == @msg;
local($type) = join(', ', @msg);
local($qmsg) = $queued ne '-' ? "-> $queued" : '';
&add_log("AFTER [$mfile$qmsg] $time {$action} ($type)") if $loglvl > 3;
}
$failed; # Failure status
}
# Run the DO command
sub run_do {
local($what, $args) = $cms =~ m|^([^()\s]*)(.*)|;
local($something, $routine) = $what =~ m|^([^:]*):(.*)|;
$routine = $what if $something eq '';
local($failed) = &do($something, $routine, $args);
&add_log("DONE [$mfile] $routine$args") if $loglvl > 7 && !$failed;
$failed; # Failure status
}
# Run the BEEP command
sub run_beep {
local($beep) = @_;
&env'local('beep', $beep) if $opt'sw_l; # Restored when leaving rule
$env'beep = $beep; # Permanent change, unless changed locally already
local($local) = $opt'sw_l ? ' locally' : '';
&add_log("BEEP [$mfile] set to ${beep}$local") if $loglvl > 7;
0; # Ok
}
# Run the PROTECT command
sub run_protect {
local($mode) = @_;
local($local) = $opt'sw_l ? ' locally' : '';
if ($opt'sw_u) {
&env'undef('protect');
&env'unset('protect') unless $opt'sw_l;
&add_log("PROTECT [$mfile] reset to default$local") if $loglvl > 7;
return 0; # Ok
}
$mode = oct($mode) if $mode =~ /^0/;
&env'local('protect', $mode) if $opt'sw_l; # Restored when leaving rule
$env'protect = $mode; # Permanent change, unless changed locally already
local($omode) = sprintf("0%o", $mode); # Octal string, for logging
&add_log("PROTECT [$mfile] mode set to ${omode}$local") if $loglvl > 7;
0; # Ok
}
# Run the BIFF command
sub run_biff {
local($mode) = $cms =~ m|^(\S+)|;
local($l) = $opt'sw_l ? ' locally' : '';
local($allowed) = ($mode =~ /off/i) ? 0 : 1; # New boolean setting
local($was) = ($env'biff =~ /off/i) ? 0 : 1; # Old boolean setting
local($setting) = $allowed ? 'ON' : 'OFF';
&env'local('biff', $setting) if $opt'sw_l;
$env'biff = $setting; # Won't hurt given the above local call
if ($allowed && $mode !~ /^on$/i) { # New biff template format path given
$mode =~ s/^~/$cf'home/; # ~ substitution
&env'local('biffmsg', $mode) if $opt'sw_l;
$env'biffmsg = $mode;
&add_log("biff template in file $mode$l") if $loglvl > 7;
}
&add_log("biffing turned $setting$l") if $loglvl > 7 && $was != $allowed;
0;
}
# For SAVE, STORE or WRITE, the job is the same
# If the name is not an absolute path, the folder directory is taken
# in the "maildir" environment variable. If none, defaults to ~/Mail.
# A folder whose name begins with a '+' is taken as an MH folder.
sub run_saving {
local($folder, $remove) = @_; # Shall we remove folder first?
local($folddir) = $XENV{'maildir'}; # Folder directory location
unless ($folder =~ /^\+/) { # Not an MH folder
$folder = "~/mbox" unless $folder; # No folder -> save in mbox
$folder =~ s/~/$cf'home/g; # ~ substitution
$folddir =~ s/~/$cf'home/g; # ~ substitution
$folddir = "$cf'home/Mail" unless $folddir; # Default folders in ~/Mail
$folder = "$folddir/$folder" unless $folder =~ m|^/|;
local($dir) = $folder =~ m|(.*)/.*|; # Get directory name
unless (-d "$dir") {
&makedir($dir);
unless (-d "$dir") {
&add_log("ERROR couldn't create directory $dir")
if $loglvl > 0;
} else {
&add_log("created directory $dir") if $loglvl > 7;
}
}
}
# Cannot use WRITE with an MH folder, it behaves like a SAVE. Same thing
# when attempting to save in a directory...
if ($remove == $FOLDER_REMOVE && $folder !~ /^\+/) {
# Folder has to be removed before writting into it. However, if it
# is write protected, do not unlink it (save will fail later on anyway).
# Note that this makes it a candidate for hooks via WRITE, if the
# folder has its 'x' bit set with its 'w' bit cleared. This is an
# undocumented feature however (WRITE is not supposed to trigger hooks).
unlink "$folder" if -f "$folder" && -w _;
}
local($mbox, $failed) = &save($folder);
local($log_message); # Log message to be issued
unless ($failed) {
local($file) = $folder; # Work on a copy to detect leading dir
$folddir =~ s/(\W)/\\$1/g; # Escape possible meta-characters
$file =~ s|^$folddir/||; # Preceded by folder directory?
if ($file =~ s/^\+//) {
$log_message = "MH folder $file";
} elsif ($file ne $folder) {
$log_message = "folder $file";
} else {
$log_message = &tilda($folder); # Replace the home directory by ~
}
}
# Return the status of the save command and a part of the logging message
# to be issued. That way, we get a nice contextual log.
($mbox, $failed, $log_message);
}
# Perform the appropriate continuation status, depending on the option:
# When 'x' is given as the option string, then the current options in the
# opt package are used instead of -c, -r or -a.
sub alter_execution {
local($option, $mode) = @_; # Option, mode we have to change to
if ($mode ne '') {
$wmode = $mode;
&add_log("entering new state $wmode") if $loglvl > 6;
}
if ($option eq 'x') { # Backward compatibility at 3.0 PL24
$option = '-c' if $opt'sw_c;
$option = '-a' if $opt'sw_a;
$option = '-r' if $opt'sw_r;
$option = '' if $option eq 'x';
}
&add_log("altering execution in mode '$wmode', option '$option'")
if $loglvl > 18;
if ($option eq '-c') { # Continue execution
0;
} elsif ($option eq '-r') { # Asks for RESTART
&do_restart;
} elsif ($option eq '-a') { # Asks for ABORT
&do_abort;
} else { # Default is to REJECT
&do_reject;
}
# Propagate return status.
}
# Save message in specified folder
sub save_message {
local($folder) = @_;
local($mbox, $failed, $log_message) = &run_saving($folder, $FOLDER_APPEND);
unless ($failed) {
&add_log("SAVED [$mfile] in $log_message") if $loglvl > 2;
$ever_saved = 1; # We were able to save it
}
$failed;
}