1;# $Id$ 2;# 3;# Copyright (c) 1990-2006, Raphael Manfredi 4;# 5;# You may redistribute only under the terms of the Artistic License, 6;# as specified in the README file that comes with the distribution. 7;# You may reuse parts of this distribution only within the terms of 8;# that same Artistic License; a copy of which may be found at the root 9;# of the source tree for mailagent 3.0. 10;# 11;# $Log: filter.pl,v $ 12;# Revision 3.0.1.11 2001/03/13 13:13:37 ram 13;# patch71: changed SUBST/TR parameter parsing to support header fields 14;# 15;# Revision 3.0.1.10 1998/03/31 15:22:19 ram 16;# patch59: when "vacfixed" is on, forbid any change of vacation message 17;# patch59: new ON command to process commands on certain days only 18;# 19;# Revision 3.0.1.9 1997/09/15 15:15:04 ram 20;# patch57: fixed ASSGINED -> ASSIGNED typo in log message 21;# patch57: implemented new -t and -f flags for BEGIN and NOP 22;# patch57: insert user e-mail address if no address for NOTIFY 23;# 24;# Revision 3.0.1.8 1996/12/24 14:51:51 ram 25;# patch45: added initial logging of the SELECT command 26;# 27;# Revision 3.0.1.7 1995/08/07 16:18:57 ram 28;# patch37: new BIFF command 29;# 30;# Revision 3.0.1.6 1995/01/25 15:20:39 ram 31;# patch27: new commands BEEP and PROTECT 32;# 33;# Revision 3.0.1.5 1995/01/03 18:10:04 ram 34;# patch24: commands now get a string with the command name chopped off 35;# patch24: modified &alter_execution to accomodate new option parsing 36;# 37;# Revision 3.0.1.4 1994/10/04 17:50:24 ram 38;# patch17: SERVER will now discard whole message on errors 39;# 40;# Revision 3.0.1.3 1994/09/22 14:20:43 ram 41;# patch12: propagated change to the &queue_mail interface 42;# patch12: added stubs for DO and AFTER commands 43;# 44;# Revision 3.0.1.2 1994/07/01 15:00:30 ram 45;# patch8: new UMASK command 46;# 47;# Revision 3.0.1.1 1994/01/26 09:31:43 ram 48;# patch5: added tags to UNIQUE and RECORD commands 49;# 50;# Revision 3.0 1993/11/29 13:48:46 ram 51;# Baseline for mailagent 3.0 netwide release. 52;# 53;# 54;# There are a number of variables which are used by the filter commands and 55;# which are in the dynamic scope when those functions are called. The calling 56;# tree being: analyze_mail -> xeqte -> run_command -> run_*, where '*' stands 57;# for the action we are currently executing. 58;# 59;# All the run_* commands are called from within an eval by run_command, so that 60;# any otherwise fatal error can be trapped and reported in the log file. This 61;# is only a precaution against possible typos or other unpredictable errors. 62;# 63;# The following variables are inherited from run_command: 64;# $mfile is the name of the mail file processed 65;# $cmd is the command to be run 66;# $cms is the same as $cmd but with options and command name chopped off 67;# $cmd_name is the command name (upper-cased) 68;# $ever_saved which states whether a saving/discarding action occurred 69;# $cont is the continuation status, modified by REJECT and friends 70;# $vacation which is a boolean stating whether vacation messages are allowed 71;# The following variable is inherited from analyze_mail: 72;# $lastcmd is the failure status of the last command (among those to be kept) 73;# The working mode is held in $wmode (comes from analyze_mail). 74;# 75;# All the commands return an exit status: 0 for ok, 1 for failure. This status 76;# is normally recorded in $lastcmd by run_command, unless the executed action 77;# belongs to the set of commands whose exit status is discarded (because they 78;# can never fail). 79;# 80# 81# Filter commands are run from here 82# 83 84# Run the PROCESS command 85sub run_process { 86 if (0 != &process) { 87 &add_log("ERROR while processing [$mfile]--queing it") if $loglvl; 88 &queue_mail($file_name, 'fm'); 89 return 1; 90 } 91 &add_log("PROCESSED [$mfile]") if $loglvl > 8; 92 0; 93} 94 95# Run the SERVER command 96sub run_server { 97 &cmdenv'inituid; # Initialize server session environment 98 &cmdserv'trusted if $opt'sw_t; # Server runs in trusted mode 99 &cmdserv'disable($opt'sw_d) if $opt'sw_d; # Disable commands for this run 100 local(@body) = split(/\n/, $Header{'Body'}); 101 local($failed) = &cmdserv'process(*body); 102 unless ($failed) { 103 &add_log("SERVED [$mfile]") if $loglvl > 8; 104 } else { 105 &add_log("ERROR unable to serve [$mfile]--discarded") if $loglvl; 106 } 107 $failed; 108} 109 110# Run the LEAVE command 111sub run_leave { 112 local($mbox, $failed) = &leave; 113 unless ($failed) { 114 &add_log("LEFT [$mfile] in mailbox") if $loglvl > 2; 115 } 116 # Even if it failed, mark it as saved anyway, as the default action would 117 # be a saving in mailbox and there is little chance another attempt would 118 # succeed while this one failed. 119 $ever_saved = 1; # At least we tried to save it 120 $failed; 121} 122 123# Run the SAVE command 124sub run_save { 125 local($folder) = @_; # Folder where message should be saved 126 &save_message($folder); 127} 128 129# Run the STORE command 130sub run_store { 131 local($folder) = @_; # Folder where message should be saved 132 local($mbox, $failed, $log_message) = &run_saving($folder, $FOLDER_APPEND); 133 unless ($failed) { 134 $ever_saved = 1; # We were able to save it 135 ($mbox, $failed) = &leave; 136 unless ($failed) { 137 &add_log("STORED [$mfile] in $log_message") if $loglvl > 2; 138 } else { 139 &add_log("WARNING only SAVED [$mfile] in $log_message") 140 if $loglvl > 1; 141 return 1; 142 } 143 } else { 144 ($mbox, $failed) = &leave; 145 unless ($failed) { 146 $ever_saved = 1; # We were able to save it 147 &add_log("WARNING only LEFT [$mfile] in mailbox") 148 if $loglvl > 1; 149 } 150 } 151 $failed; 152} 153 154# Run the WRITE command 155sub run_write { 156 local($folder) = @_; # Folder where message should be saved 157 local($mbox, $failed, $log_message) = &run_saving($folder, $FOLDER_REMOVE); 158 unless ($failed) { 159 &add_log("WROTE [$mfile] in $log_message") if $loglvl > 2; 160 $ever_saved = 1; # We were able to save it 161 } 162 $failed; 163} 164 165# Run the DELETE command 166sub run_delete { 167 &add_log("DELETED [$mfile]") if $loglvl > 2; 168 $ever_saved = 1; # User chose to discard it, it counts as a save 169 0; 170} 171 172# Run the MACRO command 173sub run_macro { 174 local($args) = @_; # Get command arguments 175 local($name, $action) = ¯o($args); # Perform the command 176 &add_log("MACRO [$mfile] $name $action") if $loglvl > 7; 177 0; # Never fails 178} 179 180# Run the MESSAGE command 181sub run_message { 182 local($msg) = @_; # Vacation message location 183 $msg =~ s/~/$cf'home/g; # ~ substitution 184 local($failed) = &message($msg); 185 unless ($failed) { 186 $msg = &tilda($msg); # Replace the home directory by ~ 187 &add_log("MESSAGE $msg for [$mfile]") if $loglvl > 2; 188 } 189 $failed; 190} 191 192# Run the NOTIFY command 193sub run_notify { 194 local($args) = @_; 195 local(@args) = split(' ', $args); 196 local($msg) = shift(@args); # First argument is message text 197 $msg =~ s/~/$cf'home/g; # ~ substitution 198 local($address) = join(' ', @args); # Address list 199 $address = $cf'email if $address eq ''; # No address, defaults to user 200 local($failed) = ¬ify($msg, $address); 201 unless ($failed) { 202 $msg = &tilda($msg); # Replace the home directory by ~ 203 &add_log("NOTIFIED $msg [$mfile] to $address") if $loglvl > 2; 204 } 205 $failed; 206} 207 208# Run the REJECT command 209sub run_reject { 210 local(*perform) = *do_reject; 211 &alter_flow; # Change control flow by calling &perform 212} 213 214# Run the RESTART command 215sub run_restart { 216 local(*perform) = *do_restart; 217 &alter_flow; # Change control flow by calling &perform 218} 219 220# Run the ABORT command 221sub run_abort { 222 local(*perform) = *do_abort; 223 &alter_flow; # Change control flow by calling &perform 224} 225 226# Run the RESYNC command 227sub run_resync { 228 # Headers pertaining to body encoding could have changed. 229 &header_check_body_encoding; # Check and recode if possible 230 &header_resync; # Resynchronize the %Header array 231 &add_log("RESYNCED [$mfile]") if $loglvl > 4; 232 0; 233} 234 235# Run the BEGIN command 236sub run_begin { 237 local($newstate) = @_; # New state wanted 238 return 0 if $opt'sw_t && $lastcmd; # -t means change only if true 239 return 0 if $opt'sw_f && !$lastcmd; # -f means change only if false 240 $newstate = 'INITIAL' unless $newstate; 241 $wmode = $newstate; # $wmode comes from analyze_mail 242 &add_log("BEGUN [$mfile] state $newstate") if $loglvl > 4; 243 0; 244} 245 246# Run the RECORD command 247sub run_record { 248 local($mode) = @_; 249 local($tags); 250 $mode =~ s|^(\w*)\s*\(([^()]*)\).*|$1| && ($tags = $2); 251 local($failed) = 0; 252 if (&history_tag($tags)) { # Message already seen 253 if ($mode eq '') { 254 &add_log("NOTICE entering seen mode") 255 if $loglvl > 5 && $wmode ne '_SEEN_'; 256 # Enter special mode ($wmode from analyze_mail) 257 $wmode = '_SEEN_'; 258 } 259 &alter_execution('x', $mode); 260 $failed = 1; # Make sure it "fails" 261 } 262 local($tagmsg) = $tags ne '' ? " ($tags)" : ''; 263 &add_log("RECORDED [$mfile]" . $tagmsg) if $loglvl > 4; 264 $failed; 265} 266 267# Run the UNIQUE command 268sub run_unique { 269 local($mode) = @_; 270 local($tags); 271 $mode =~ s|^(\w*)\s*\(([^()]*)\).*|$1| && ($tags = $2); 272 local($failed) = 0; 273 if (&history_tag($tags)) { # Message already seen 274 &add_log("NOTICE message tagged as saved") if $loglvl > 5; 275 $ever_saved = 1; # In effect, runs a DELETE 276 &alter_execution('x', $mode); 277 $failed = 1; # Make sure it "fails" 278 } 279 local($tagmsg) = $tags ne '' ? " ($tags)" : ''; 280 &add_log("UNIQUE [$mfile]" . $tagmsg) if $loglvl > 4; 281 $failed; 282} 283 284# Run the FORWARD command 285sub run_forward { 286 local($addresses) = @_; # Address(es) 287 local($failed) = &forward($addresses); 288 unless ($failed) { 289 &add_log("FORWARDED [$mfile] to $addresses") if $loglvl > 2; 290 $ever_saved = 1; # Forwarding succeeded, counts as a save 291 } 292 $failed; 293} 294 295# Run the BOUNCE command 296sub run_bounce { 297 local($addresses) = @_; # Address(es) 298 local($failed) = &bounce($addresses); 299 unless ($failed) { 300 &add_log("BOUNCED [$mfile] to $addresses") if $loglvl > 2; 301 $ever_saved = 1; # Bouncing succeeded, counts as a save 302 } 303 $failed; 304} 305 306# Run the POST command 307sub run_post { 308 local($newsgroups) = @_; # Newsgroup(s) 309 local($failed) = &post($newsgroups); 310 unless ($failed) { 311 &add_log("POSTED [$mfile] to $newsgroups") if $loglvl > 2; 312 $ever_saved = 1; # Posting succeeded, counts as a save 313 } 314 $failed; 315} 316 317# Run the RUN command 318sub run_run { 319 local($program) = @_; # Program to run 320 local($failed) = &shell_command($program, $NO_INPUT, $NO_FEEDBACK); 321 unless ($failed) { 322 &add_log("RAN '$program' for [$mfile]") if $loglvl > 4; 323 } 324 $failed; 325} 326 327# Run the PIPE command 328sub run_pipe { 329 local($program) = @_; # Program to run 330 my $mail = $opt'sw_b ? $MAIL_INPUT_BINARY : $MAIL_INPUT; 331 local($failed) = &shell_command($program, $mail, $NO_FEEDBACK); 332 unless ($failed) { 333 &add_log("PIPED [$mfile] to '$program'") if $loglvl > 4; 334 } 335 $failed; 336} 337 338# Run the GIVE command 339sub run_give { 340 local($program) = @_; # Program to run 341 local($failed) = &shell_command($program, $BODY_INPUT, $NO_FEEDBACK); 342 unless ($failed) { 343 &add_log("GAVE [$mfile] to '$program'") if $loglvl > 4; 344 } 345 $failed; 346} 347 348# Run the PASS command 349sub run_pass { 350 local($program) = @_; # Program to run 351 local($failed) = &shell_command($program, $BODY_INPUT, $FEEDBACK); 352 unless ($failed) { 353 &add_log("PASSED [$mfile] through '$program'") if $loglvl > 4; 354 } 355 $failed; 356} 357 358# Run the FEED command 359sub run_feed { 360 local($program) = @_; # Program to run 361 my $mail = $opt'sw_b ? $MAIL_INPUT_BINARY : $MAIL_INPUT; 362 my $feedback = $opt'sw_e ? $FEEDBACK_ENCODING : $FEEDBACK; 363 local($failed) = &shell_command($program, $mail, $feedback); 364 unless ($failed) { 365 &add_log("FED [$mfile] through '$program'") if $loglvl > 4; 366 } 367 $failed; 368} 369 370# Run the PURIFY command 371sub run_purify { 372 local($program) = @_; # Program to run 373 local($failed) = &shell_command($program, $HEADER_INPUT, $FEEDBACK); 374 unless ($failed) { 375 &add_log("PURIFIED [$mfile] through '$program'") if $loglvl > 4; 376 } 377 $failed; 378} 379 380# Run the BACK command 381# Manipulates dynamically bound variable $cont (output from xeqte) 382sub run_back { 383 local($command) = @_; 384 # The BACK command is handled recursively. The local variable $Back will be 385 # set by xeq_back() if any feedback is to ever occur. This routine will be 386 # transparently called instead of the usual handle_output() because of the 387 # dynamic aliasing done here. 388 local($Back) = ''; # BACK may be nested 389 local(*handle_output) = *xeq_back; # Any output to be put in $Back 390 local($failed) = 0; 391 $command =~ s/%/%%/g; # Protect against 2nd macro substitution 392 # Calling run_command will position $lastcmd to be the return status of 393 # the last meaningful command executed. However, we reset $lastcmd before 394 # diving into the execution. 395 $lastcmd = 0; # Assume everything went fine 396 &run_command($command); # Run command (ignore return value) 397 if ($Back ne '') { 398 &add_log("got '$Back' back") if $loglvl > 11; 399 $cont = &xeqte($Back); # Get continuation status back 400 $@ = ''; # Avoid cascade of (same) error report 401 &add_log("BACK from '$command'") if $loglvl > 4; 402 } else { 403 &add_log("WARNING got nothing out of '$command'") if $loglvl > 5; 404 } 405 $lastcmd; # Propage error status we got from the $command 406} 407 408# Run the ON command 409sub run_on { 410 local($_) = $cmd; # The whole command line 411 local(@days) = split(' ', 'Sun Mon Tue Wed Thu Fri Sat'); 412 local(%days); 413 local($daynum) = 0; 414 foreach $day (@days) { # Initialize Sun => 0, Mon => 1, etc... 415 $days{$day} = $daynum++; 416 } 417 local(@on); # List of specified days 418 local(%on); # Hash '0' (for sunday) => 1 if selected 419 if (s/^ON\s*\(([^\)]*)\)//) { # List of days, like (Mon Tue) 420 @on = split(/,?\s+/, $1); # Allow (Mon Thu) and (Mon, Thu) 421 local($non); 422 foreach $on (@on) { 423 $non = $on; # New $on will be canonicalized 424 $non =~ s/^(...).*/\u\L$1/; # Keep only first 3 letters 425 unless (defined $days{$non}) { 426 &add_log("WARNING ignoring bad day $on in ON (@on)") 427 if $loglvl > 5; 428 next; 429 } 430 $on{$days{$non}}++; # E.g sets $on{1} for Mon 431 } 432 &add_log("on (@on)") if $loglvl > 18; 433 } else { 434 &add_log("ERROR bad ON syntax (did not parse right)") if $loglvl > 1; 435 return 1; 436 } 437 438 # Calling run_command will set $lastcmd to the status of the command. In 439 # case we are running a command which does not alter this status, assume 440 # everything is fine. 441 442 $lastcmd = 0; # Assume command will run correctly 443 s/^\s*//; # Remove leading spaces 444 445 local($wday) = (localtime(time))[6]; 446 447 if (defined $on{$wday}) { 448 &add_log("ON (@on) $_") if $loglvl > 7; 449 s/%/%%/g; # Protect against 2nd macro substitution 450 $cont = &run_command($_); # Run command and update control flow 451 } else { 452 &add_log("not a good day for $_") if $loglvl > 12; 453 } 454 455 $lastcmd; # Propagates execution status 456} 457 458# Run the ONCE command 459sub run_once { 460 local($_) = $cmd; # The whole command line 461 local($hname); # Hash name (e-mail address) 462 local($tag); # Tag associated with command 463 local($raw_period); # The period, as written 464 if (s/^ONCE\s*\(([^,\)]*),\s*([^,;\)]*),\s*(\w+)\s*\)//) { 465 ($hname, $tag, $raw_period) = ($1, $2, $3); 466 &add_log("tag is ($hname, $tag, $raw_period)") if $loglvl > 18; 467 } else { 468 &add_log("ERROR bad once syntax (invalid tag)") if $loglvl > 1; 469 return 1; 470 } 471 s/^\s*//; # Remove leading spaces 472 local($period) = &seconds_in_period($raw_period); 473 &add_log("period is $raw_period = $period seconds") if $loglvl > 18; 474 475 # Calling run_command will set $lastcmd to the status of the command. In 476 # case we are running a command which does not alter this status, assume 477 # everything is fine. 478 $lastcmd = 0; # Assume command will run correctly 479 480 if (&once_check($hname, $tag, $period)) { 481 &add_log("ONCE ($hname, $tag, $raw_period) $_") if $loglvl > 7; 482 &s_once($cmd_name, $wmode, $tag); 483 s/%/%%/g; # Protect against 2nd macro substitution 484 $cont = &run_command($_); # Run it, update continuation status 485 } else { 486 &add_log("retry time not reached for $_") if $loglvl > 12; 487 &s_noretry($cmd_name, $wmode, $tag); 488 } 489 490 $lastcmd; # Propagates execution status 491} 492 493# Run the SELECT command 494sub run_select { 495 local($_) = $cmd; # The whole command line 496 local($start, $end); # Date strings for start and end 497 if (s/^SELECT\s*\(([^.\)]*)\.\.\s*([^\)]*)\)//) { 498 ($start, $end) = ($1, $2); 499 $start =~ s/\s*$//; # Remove trailing spaces 500 $end =~ s/\s*$//; 501 &add_log("time is ($start .. $end)") if $loglvl > 18; 502 } else { 503 &add_log("ERROR bad select syntax (invalid time)") if $loglvl > 1; 504 return 1; 505 } 506 local($now) = time; # Current time 507 local($sec_start, $sec_end); # Start and end converted in seconds 508 $sec_start = &getdate($start, $now); 509 if ($sec_start == -1) { 510 &add_log("ERROR in SELECT: 1st time '$start'") if $loglvl > 1; 511 return 1; 512 } 513 $sec_end = &getdate($end, $now); 514 if ($sec_end == -1) { 515 &add_log("ERROR in SELECT: 2nd time '$end'") if $loglvl > 1; 516 return 1; 517 } 518 if ($sec_start > $sec_end) { 519 &add_log("WARNING time selection always impossible?") if $loglvl > 1; 520 return 0; 521 } 522 523 # Calling run_command will set $lastcmd to the status of the command. In 524 # case we are running a command which does not alter this status, assume 525 # everything is fine. 526 $lastcmd = 0; # Assume command will run correctly 527 528 &add_log("SELECT ($sec_start, $sec_end) at $now") if $loglvl > 11; 529 530 s/^\s*//; # Remove leading spaces 531 if ($now >= $sec_start && $now <= $sec_end) { 532 &add_log("SELECT ($start .. $end) $_") if $loglvl > 7; 533 s/%/%%/g; # Protect against 2nd macro substitution 534 $cont = &run_command($_); # Run command and update control flow 535 } else { 536 &add_log("time period not good for $_") if $loglvl > 12; 537 } 538 539 $lastcmd; # Propagates execution status 540} 541 542# Run the NOP command 543sub run_nop { 544 local($what) = $opt'sw_f ? 'failure' : ($opt'sw_t ? 'success' : ''); 545 local($force) = $what ? " forcing $what" : ''; 546 &add_log("NOP [$mfile]$force") if $loglvl > 7; 547 return 1 if $opt'sw_f; # -f forces failure 548 return 0 if $opt'sw_t; # -t forces failure 549 $lastcmd; # Propagates curremt exec status 550} 551 552# Run the STRIP command 553sub run_strip { 554 local($headers) = @_; # Headers to remove 555 &alter_header($headers, $HD_STRIP); 556 $headers = join(', ', split(/\s/, $headers)); 557 &add_log("STRIPPED $headers from [$mfile]") if $loglvl > 7; 558 0; 559} 560 561# Run the KEEP command 562sub run_keep { 563 local($headers) = @_; # Headers to keep 564 &alter_header($headers, $HD_KEEP); 565 $headers = join(', ', split(/\s/, $headers)); 566 &add_log("KEPT $headers from [$mfile]") if $loglvl > 7; 567 0; 568} 569 570# Run the ANNOTATE command 571sub run_annotate { 572 local($field, $value) = $cms =~ m|([\w\-]+):?\s*(.*)|; 573 local($failed) = &annotate_header($field, $value); 574 unless ($failed) { 575 local($msg) = $opt'sw_d ? ' (no date)' : ''; 576 &add_log("ANNOTATED [$mfile] with $field$msg") if $loglvl > 7; 577 } 578 $failed; 579} 580 581# Run the ASSIGN command 582sub run_assign { 583 local($var, $value) = $cms =~ m|^(:?\w+)\s+(.*)|; 584 local($eval); # Evaluated value for expression 585 local($@); 586 # An expression may be provided as a value. If the whole value is enclosed 587 # within simple quotes, then those are stripped and no evaluation is made. 588 unless ($value =~ s/^'(.*)'$/$1/) { 589 eval "\$eval = $value"; # Maybe value is an expression? 590 if ($@) { 591 chop($@); 592 &add_log("WARNINIG can't evaluate '$value': $@"); 593 } else { 594 $value = $eval; 595 } 596 } 597 if ($var =~ s/^://) { 598 &extern'set($var, $value); # Persistent variable is set 599 } else { 600 $Variable{$var} = $value; # User defined variable is set 601 } 602 &add_log("ASSIGNED '$value' to '$var' [$mfile]") if $loglvl > 7; 603 0; 604} 605 606# Run the TR command 607sub run_tr { 608 local($variable, $tr) = $cms =~ m|^(\S+)\s+(.*)|; 609 &alter_value($variable, "tr$tr"); 610} 611 612# Run the SUBST command 613sub run_subst { 614 local($variable, $s) = $cms =~ m|^(\S+)\s+(.*)|; 615 &alter_value($variable, "s$s"); 616} 617 618# Run the SPLIT command 619sub run_split { 620 local($folder) = @_; # Folder where split occurs 621 local($failed) = &split($folder); 622 if (0 == $failed % 2) { # Message was in digest format 623 if ($failed & 0x4) { 624 &add_log("SPLIT [$mfile] in mailagent's queue") if $loglvl > 2; 625 } else { 626 &add_log("SPLIT [$mfile] in $folder") if $loglvl > 2; 627 } 628 # If digest was not in RFC-934 style, there is a chance the split 629 # was not correctly performed. To avoid any accidental loss of 630 # information, the original digest message is also saved if SPLIT 631 # had a folder argument, or it is not tagged saved. 632 if ($failed & 0x8) { # Digest was not RFC-934 compliant 633 &add_log("NOTICE [$mfile] not RFC-934 compliant") if $loglvl > 6; 634 if ($folder ne '') { 635 &add_log("NOTICE saving original [$mfile] in $folder") 636 if $loglvl > 6; 637 &save_message($folder); 638 } else { 639 &add_log("NOTICE [$mfile] not tagged as saved") 640 if $loglvl > 6 && ($failed & 0x2); 641 } 642 } else { 643 $ever_saved = 1 if $failed & 0x2; # Split -i succeeded 644 } 645 $failed = 0; 646 } 647 # If message was not in digest format and a folder was specified, save 648 # message in that folder. 649 if ($failed < 0 && $folder ne '') { 650 &add_log("NOTICE [$mfile] not in digest format") if $loglvl > 6; 651 $failed = &save_message($folder); 652 } 653 $failed ? 1 : 0; # Failure status from split can be negative 654} 655 656# Run the VACATION command 657sub run_vacation { 658 return 0 unless $cf'vacation =~ /on/i; # Ignore if vacation mode off 659 local($mode, $period) = $cms =~ m|^(\S+)(\s+\S+)?|; 660 local($l) = $opt'sw_l ? ' locally' : ''; 661 local($allowed) = ($mode =~ /off/i) ? 0 : 1; 662 &env'local('vacation', $allowed) if $opt'sw_l; 663 $env'vacation = $allowed; # Won't hurt given the above local call 664 if ($allowed && $mode !~ /^on$/i) { # New vacation path given 665 if ($cf'vacfixed =~ /on/i) { # Not allowed if vacfixed is ON 666 &add_log("WARNING no message change allowed by 'vacfixed'") 667 if $loglvl > 5; 668 } else { 669 $mode =~ s/^~/$cf'home/; # ~ substitution 670 &env'local('vacfile', $mode) if $opt'sw_l; 671 $env'vacfile = $mode; 672 &add_log("vacation message in file $mode$l") if $loglvl > 7; 673 } 674 } 675 if ($allowed && $period) { 676 &env'local('vacperiod', $period) if $opt'sw_l; 677 $env'vacperiod = $period; 678 &add_log("vacation period is now $period$l") if $loglvl > 7; 679 } 680 $mode = $env'vacation ? 'on' : 'off'; 681 &add_log("vacation message turned $mode$l") if $loglvl > 7; 682 0; 683} 684 685# Run the QUEUE command 686sub run_queue { 687 # Mail is saved as a 'qm' file, to avoid endless loops when mailagent 688 # processes the queue. This means the mail will be deferred for at 689 # least half an hour. 690 local($name) = &queue_mail('', 'qm'); # No file name, mail in %Header 691 $ever_saved = 1 if defined $name; # Queuing counts as saving 692 defined $name ? 0 : 1; # Failed if $name is undef 693} 694 695# Run the PERL command 696sub run_perl { 697 local($script) = @_; # Script to be loaded 698 local($failed) = &perl($script); 699 unless ($failed) { 700 $script = &tilda($script); # Replace the home directory by ~ 701 &add_log("PERLED [$mfile] through $script") if $loglvl > 7; 702 } 703 $failed; 704} 705 706# Run the REQUIRE command 707sub run_require { 708 local($file, $package) = $cms =~ m|^(\S+)\s*(.*)|; 709 local($failed) = &require($file, $package); 710 unless ($failed) { 711 $file = &tilda($file); # Replace the home directory by ~ 712 local($inpack) = $file; # Loaded in a package? 713 $inpack .= " in package $package" if $package ne ''; 714 &add_log("REQUIRED [$mfile] $inpack") if $loglvl > 7; 715 } 716 $failed; 717} 718 719# Run the APPLY command 720sub run_apply { 721 local($rulefile) = @_; # Rule file to be applied 722 local($failed, $saved) = &apply($rulefile); 723 unless ($failed) { 724 $rulefile = &tilda($rulefile); # Replace the home directory by ~ 725 &add_log("APPLIED [$mfile] rules $rulefile") if $loglvl > 7; 726 } 727 $ever_saved = 1 if $saved; # Mark mail as saved if appropriate 728 $saved ? $failed : 1; # Force failure if never saved 729} 730 731# Run the UMASK command 732sub run_umask { 733 local($mask) = @_; 734 $mask = oct($mask) if $mask =~ /^0/; 735 &env'local('umask', $mask) if $opt'sw_l; # Restored when leaving rule 736 $env'umask = $mask; # Permanent change, unless changed locally already 737 umask($env'umask); 738 local($omask) = sprintf("0%o", $mask); # Octal string, for logging 739 local($local) = $opt'sw_l ? ' locally' : ''; 740 &add_log("UMASK [$mfile] set to ${omask}$local") if $loglvl > 7; 741 0; # Ok 742} 743 744# Run the AFTER command 745sub run_after { 746 local($time, $action) = $cms =~ m|^\((.*)\)(.*)|; 747 local($failed, $queued) = &after($time, $action); 748 unless ($failed) { 749 local(@msg); 750 push(@msg, 'shell') if $opt'sw_s; 751 push(@msg, 'command') if $opt'sw_c; 752 push(@msg, 'no input') if $opt'sw_n; 753 push(@msg, 'agent') if $opt'sw_a || 0 == @msg; 754 local($type) = join(', ', @msg); 755 local($qmsg) = $queued ne '-' ? "-> $queued" : ''; 756 &add_log("AFTER [$mfile$qmsg] $time {$action} ($type)") if $loglvl > 3; 757 } 758 $failed; # Failure status 759} 760 761# Run the DO command 762sub run_do { 763 local($what, $args) = $cms =~ m|^([^()\s]*)(.*)|; 764 local($something, $routine) = $what =~ m|^([^:]*):(.*)|; 765 $routine = $what if $something eq ''; 766 local($failed) = &do($something, $routine, $args); 767 &add_log("DONE [$mfile] $routine$args") if $loglvl > 7 && !$failed; 768 $failed; # Failure status 769} 770 771# Run the BEEP command 772sub run_beep { 773 local($beep) = @_; 774 &env'local('beep', $beep) if $opt'sw_l; # Restored when leaving rule 775 $env'beep = $beep; # Permanent change, unless changed locally already 776 local($local) = $opt'sw_l ? ' locally' : ''; 777 &add_log("BEEP [$mfile] set to ${beep}$local") if $loglvl > 7; 778 0; # Ok 779} 780 781# Run the PROTECT command 782sub run_protect { 783 local($mode) = @_; 784 local($local) = $opt'sw_l ? ' locally' : ''; 785 if ($opt'sw_u) { 786 &env'undef('protect'); 787 &env'unset('protect') unless $opt'sw_l; 788 &add_log("PROTECT [$mfile] reset to default$local") if $loglvl > 7; 789 return 0; # Ok 790 } 791 $mode = oct($mode) if $mode =~ /^0/; 792 &env'local('protect', $mode) if $opt'sw_l; # Restored when leaving rule 793 $env'protect = $mode; # Permanent change, unless changed locally already 794 local($omode) = sprintf("0%o", $mode); # Octal string, for logging 795 &add_log("PROTECT [$mfile] mode set to ${omode}$local") if $loglvl > 7; 796 0; # Ok 797} 798 799# Run the BIFF command 800sub run_biff { 801 local($mode) = $cms =~ m|^(\S+)|; 802 local($l) = $opt'sw_l ? ' locally' : ''; 803 local($allowed) = ($mode =~ /off/i) ? 0 : 1; # New boolean setting 804 local($was) = ($env'biff =~ /off/i) ? 0 : 1; # Old boolean setting 805 local($setting) = $allowed ? 'ON' : 'OFF'; 806 &env'local('biff', $setting) if $opt'sw_l; 807 $env'biff = $setting; # Won't hurt given the above local call 808 if ($allowed && $mode !~ /^on$/i) { # New biff template format path given 809 $mode =~ s/^~/$cf'home/; # ~ substitution 810 &env'local('biffmsg', $mode) if $opt'sw_l; 811 $env'biffmsg = $mode; 812 &add_log("biff template in file $mode$l") if $loglvl > 7; 813 } 814 &add_log("biffing turned $setting$l") if $loglvl > 7 && $was != $allowed; 815 0; 816} 817 818# For SAVE, STORE or WRITE, the job is the same 819# If the name is not an absolute path, the folder directory is taken 820# in the "maildir" environment variable. If none, defaults to ~/Mail. 821# A folder whose name begins with a '+' is taken as an MH folder. 822sub run_saving { 823 local($folder, $remove) = @_; # Shall we remove folder first? 824 local($folddir) = $XENV{'maildir'}; # Folder directory location 825 unless ($folder =~ /^\+/) { # Not an MH folder 826 $folder = "~/mbox" unless $folder; # No folder -> save in mbox 827 $folder =~ s/~/$cf'home/g; # ~ substitution 828 $folddir =~ s/~/$cf'home/g; # ~ substitution 829 $folddir = "$cf'home/Mail" unless $folddir; # Default folders in ~/Mail 830 $folder = "$folddir/$folder" unless $folder =~ m|^/|; 831 local($dir) = $folder =~ m|(.*)/.*|; # Get directory name 832 unless (-d "$dir") { 833 &makedir($dir); 834 unless (-d "$dir") { 835 &add_log("ERROR couldn't create directory $dir") 836 if $loglvl > 0; 837 } else { 838 &add_log("created directory $dir") if $loglvl > 7; 839 } 840 } 841 } 842 # Cannot use WRITE with an MH folder, it behaves like a SAVE. Same thing 843 # when attempting to save in a directory... 844 if ($remove == $FOLDER_REMOVE && $folder !~ /^\+/) { 845 # Folder has to be removed before writting into it. However, if it 846 # is write protected, do not unlink it (save will fail later on anyway). 847 # Note that this makes it a candidate for hooks via WRITE, if the 848 # folder has its 'x' bit set with its 'w' bit cleared. This is an 849 # undocumented feature however (WRITE is not supposed to trigger hooks). 850 unlink "$folder" if -f "$folder" && -w _; 851 } 852 local($mbox, $failed) = &save($folder); 853 local($log_message); # Log message to be issued 854 unless ($failed) { 855 local($file) = $folder; # Work on a copy to detect leading dir 856 $folddir =~ s/(\W)/\\$1/g; # Escape possible meta-characters 857 $file =~ s|^$folddir/||; # Preceded by folder directory? 858 if ($file =~ s/^\+//) { 859 $log_message = "MH folder $file"; 860 } elsif ($file ne $folder) { 861 $log_message = "folder $file"; 862 } else { 863 $log_message = &tilda($folder); # Replace the home directory by ~ 864 } 865 } 866 867 # Return the status of the save command and a part of the logging message 868 # to be issued. That way, we get a nice contextual log. 869 ($mbox, $failed, $log_message); 870} 871 872# Perform the appropriate continuation status, depending on the option: 873# When 'x' is given as the option string, then the current options in the 874# opt package are used instead of -c, -r or -a. 875sub alter_execution { 876 local($option, $mode) = @_; # Option, mode we have to change to 877 if ($mode ne '') { 878 &add_log("entering new state $mode") if $loglvl > 6 && $wmode ne $mode; 879 $wmode = $mode; 880 } 881 if ($option eq 'x') { # Backward compatibility at 3.0 PL24 882 $option = '-c' if $opt'sw_c; 883 $option = '-a' if $opt'sw_a; 884 $option = '-r' if $opt'sw_r; 885 $option = '' if $option eq 'x'; 886 } 887 &add_log("altering execution in mode '$wmode', option '$option'") 888 if $loglvl > 18; 889 if ($option eq '-c') { # Continue execution 890 0; 891 } elsif ($option eq '-r') { # Asks for RESTART 892 &do_restart; 893 } elsif ($option eq '-a') { # Asks for ABORT 894 &do_abort; 895 } else { # Default is to REJECT 896 &do_reject; 897 } 898 # Propagate return status. 899} 900 901# Save message in specified folder 902sub save_message { 903 local($folder) = @_; 904 local($mbox, $failed, $log_message) = &run_saving($folder, $FOLDER_APPEND); 905 unless ($failed) { 906 &add_log("SAVED [$mfile] in $log_message") if $loglvl > 2; 907 $ever_saved = 1; # We were able to save it 908 } 909 $failed; 910} 911 912