1my $RCS_Id = '$Id: Procmail.pm,v 1.24 2004-09-19 12:34:56+02 jv Exp jv $ '; 2 3# Author : Johan Vromans 4# Created On : Tue Aug 8 13:53:22 2000 5# Last Modified By: Johan Vromans 6# Last Modified On: 7# Update Count : 254 8# Status : Unknown, Use with caution! 9 10=head1 NAME 11 12Mail::Procmail - Procmail-like facility for creating easy mail filters. 13 14=head1 SYNOPSIS 15 16 use Mail::Procmail; 17 18 # Set up. Log everything up to log level 3. 19 my $m_obj = pm_init ( loglevel => 3 ); 20 21 # Pre-fetch some interesting headers. 22 my $m_from = pm_gethdr("from"); 23 my $m_to = pm_gethdr("to"); 24 my $m_subject = pm_gethdr("subject"); 25 26 # Default mailbox. 27 my $default = "/var/spool/mail/".getpwuid($>); 28 29 pm_log(1, "Mail from $m_from"); 30 31 pm_ignore("Non-ASCII in subject") 32 if $m_subject =~ /[\232-\355]{3}/; 33 34 pm_resend("jojan") 35 if $m_to =~ /jjk@/i; 36 37 # Make sure I see these. 38 pm_deliver($default, continue => 1) 39 if $m_subject =~ /getopt(ions|(-|::)?long)/i; 40 41 # And so on ... 42 43 # Final delivery. 44 pm_deliver($default); 45 46=head1 DESCRIPTION 47 48F<procmail> is a great mail filter program, but it has weird recipe 49format. It's pattern matching capabilities are basic and often 50insufficient. I wanted something flexible whereby I could filter my 51mail using the power of Perl. 52 53I've been considering to write a procmail replacement in Perl for a 54while, but it was Simon Cozen's C<Mail::Audit> module, and his article 55in The Perl Journal #18, that set it off. 56 57I first started using Simon's great module, and then decided to write 58my own since I liked certain things to be done differently. And I 59couldn't wait for his updates. 60 61C<Mail::Procmail> allows a piece of email to be logged, examined, 62delivered into a mailbox, filtered, resent elsewhere, rejected, and so 63on. It is designed to allow you to easily create filter programs to 64stick in a F<.forward> or F<.procmailrc> file, or similar. 65 66=head1 DIFFERENCES WITH MAIL::AUDIT 67 68Note that several changes are due to personal preferences and do not 69necessarily imply deficiencies in C<Mail::Audit>. 70 71=over 72 73=item General 74 75Not object oriented. Procmail functionality typically involves one 76single message. All (relevant) functions are exported. 77 78=item Delivery 79 80Each of the delivery methods is able to continue (except 81I<pm_reject> and I<pm_ignore>). 82 83Each of the delivery methods is able to pretend they did it 84(for testing a new filter). 85 86No default file argument for mailbox delivery, since this is system 87dependent. 88 89Each of the delivery methods logs the line number in the calling 90program so one can deduce which 'rule' caused the delivery. 91 92Message IDs can be checked to suppress duplicate messages. 93 94System commands can be executed for their side-effects. 95 96I<pm_ignore> logs a reason as well. 97 98I<pm_reject> will fake a "No such user" status to the mail transfer agent. 99 100=item Logging 101 102The logger function is exported as well. Logging is possible to 103a named file, STDOUT or STDERR. 104 105Since several deliveries can take place in parallel, logging is 106protected against concurrent access, and a timestamp/pid is included 107in log messages. 108 109A log reporting tool is included. 110 111=item Robustness 112 113Exit with TEMPFAIL instead of die in case of problems. 114 115I<pm_pipe_to> ignores SIGPIPE. 116 117I<pm_pipe_to> returns the command exit status if continuation is selected. 118 119Commands and pipes can be protected against concurrent access using 120lockfiles. 121 122=back 123 124=head1 EXPORTED ROUTINES 125 126Note that most delivery routines exit the program unless the attribute 127"continue=>1" is passed. 128 129Also, the delivery routines log the line number in the calling program 130so it is easy to find out which 'rule' caused a specific delivery to 131take place. 132 133=cut 134 135################ Common stuff ################ 136 137package Mail::Procmail; 138 139$VERSION = "1.08"; 140 141use strict; 142use 5.005; 143use vars qw(@ISA @EXPORT $pm_hostname); 144 145my $verbose = 0; # verbose processing 146my $debug = 0; # debugging 147my $trace = 0; # trace (show process) 148my $test = 0; # test mode. 149 150my $logfile; # log file 151my $loglevel; # log level 152 153use Fcntl qw(:DEFAULT :flock); 154 155use constant REJECTED => 67; # fake "no such user" 156use constant TEMPFAIL => 75; 157use constant DELIVERED => 0; 158 159use Sys::Hostname; 160$pm_hostname = hostname; 161 162require Exporter; 163 164@ISA = qw(Exporter); 165@EXPORT = qw( 166 pm_init 167 pm_gethdr 168 pm_gethdr_raw 169 pm_body 170 pm_deliver 171 pm_reject 172 pm_resend 173 pm_pipe_to 174 pm_command 175 pm_ignore 176 pm_dupcheck 177 pm_lockfile 178 pm_unlockfile 179 pm_log 180 pm_report 181 $pm_hostname 182 ); 183 184################ The Process ################ 185 186use Mail::Internet; 187use LockFile::Simple; 188 189use Carp; 190 191my $m_obj; # the Mail::Internet object 192my $m_head; # its Mail::Header object 193 194=head2 pm_init 195 196This routine performs the basic initialisation. It must be called once. 197 198Example: 199 200 pm_init (logfile => "my.log", loglevel => 3, test => 1); 201 202Attributes: 203 204=over 205 206=item * 207 208fh 209 210An open file handle to read the message from. Defaults to STDIN. 211 212=item * 213 214logfile 215 216The name of a file to log messages to. Each message will have a timestamp 217attached. 218 219The attribute may be 'STDOUT' or 'STDERR' to achieve logging to 220standard output or error respectively. 221 222=item * 223 224loglevel 225 226The amount of information that will be logged. 227 228=item * 229 230test 231 232If true, no actual delivery will be done. Suitable to test a new setup. 233Note that file locks are done, so lockfiles may be created and deleted. 234 235=item * 236 237debug 238 239Provide some debugging info. 240 241=item * 242 243trace 244 245Provide some tracing info, eventually. 246 247=item * 248 249verbose 250 251Produce verbose information, eventually. 252 253=back 254 255=cut 256 257sub pm_init { 258 259 my %atts = ( 260 logfile => '', 261 loglevel => 0, 262 fh => undef, 263 verbose => 0, 264 trace => 0, 265 debug => 0, 266 test => 0, 267 @_); 268 $debug = delete $atts{debug}; 269 $trace = delete $atts{trace}; 270 $test = delete $atts{test}; 271 $verbose = delete $atts{verbose}; 272 $logfile = delete $atts{logfile}; 273 $loglevel = delete $atts{loglevel}; 274 my $fh = delete $atts{fh} || \*STDIN; 275 276 $trace |= ($debug || $test); 277 278 croak("Unprocessed attributes: ".join(" ",sort keys %atts)) 279 if %atts; 280 281 $m_obj = Mail::Internet->new($fh); 282 $m_head = $m_obj->head; # Mail::Header 283 284 $m_obj; 285} 286 287=head2 pm_gethdr 288 289This routine fetches the contents of a header. The result will have 290excess whitepace tidied up. 291 292The header is reported using warn() if the debug attribute was passed 293(with a true value) to pm_init(); 294 295Example: 296 297 $m_rcvd = pm_gethdr("received"); # get first (or only) Received: header 298 $m_rcvd = pm_gethdr("received",2); # get 3rd Received: header 299 @m_rcvd = pm_gethdr("received"); # get all Received: headers 300 301=cut 302 303sub pm_gethdr { 304 my ($hdr, $ix) = @_; 305 my @ret; 306 foreach my $val ( $m_head->get($hdr, $ix) ) { 307 last unless defined $val; 308 for ( $val ) { 309 s/^\s+//; 310 s/\s+$//; 311 s/\s+/ /g; 312 s/[\r\n]+$//; 313 } 314 if ( $debug ) { 315 $hdr =~ s/-(.)/"-".ucfirst($1)/ge; 316 warn (ucfirst($hdr), ": ", $val, "\n"); 317 } 318 return $val unless wantarray; 319 push (@ret, $val); 320 } 321 wantarray ? @ret : ''; 322} 323 324=head2 pm_gethdr_raw 325 326Like pm_gethdr, but without whitespace cleanup. 327 328=cut 329 330sub pm_gethdr_raw { 331 my ($hdr, $ix) = @_; 332 my @ret; 333 foreach my $val ( $m_head->get($hdr, $ix) ) { 334 last unless defined $val; 335 if ( $debug ) { 336 $hdr =~ s/-(.)/"-".ucfirst($1)/ge; 337 warn (ucfirst($hdr), ": ", $val, "\n"); 338 } 339 return $val unless wantarray; 340 push (@ret, $val); 341 } 342 wantarray ? @ret : ''; 343} 344 345=head2 pm_body 346 347This routine fetches the body of a message, as a reference to an array 348of lines. 349 350Example: 351 352 $body = pm_body(); # ref of lines 353 $body = join("", @{pm_body()}); # as one string 354 355=cut 356 357sub pm_body { 358 $m_obj->body; 359} 360 361=head2 pm_deliver 362 363This routine performs delivery to a Unix style mbox file, or maildir. 364 365In case of an mbox file, the file is locked first by acquiring 366exclusive access. Note that older style locking, with a lockfile with 367C<.lock> extension, is I<not> supported. 368 369Example: 370 371 pm_deliver("/var/spool/mail/".getpwuid($>)); 372 373Attributes: 374 375=over 376 377=item * 378 379continue 380 381If true, processing will continue after delivery. Otherwise the 382program will exit with a DELIVERED status. 383 384=back 385 386=cut 387 388sub _pm_msg_size { 389 length($m_obj->head->as_string || '') + length(join("", @{$m_obj->body})); 390} 391 392sub pm_deliver { 393 my ($target, %atts) = @_; 394 my $line = (caller(0))[2]; 395 pm_log(2, "deliver[$line]: $target "._pm_msg_size()); 396 397 # Is it a Maildir? 398 if ( -d "$target/tmp" && -d "$target/new" ) { 399 my $msg_file = "/${\time}.$$.$pm_hostname"; 400 my $tmp_path = "$target/tmp/$msg_file"; 401 my $new_path = "$target/new/$msg_file"; 402 pm_log(3,"Looks like maildir, writing to $new_path"); 403 404 # since mutt won't add a lines tag to maildir messages, 405 # we'll add it here 406 unless ( pm_gethdr("lines") ) { 407 my $body = $m_obj->body; 408 my $num_lines = @$body; 409 $m_head->add("Lines", $num_lines); 410 pm_log(4,"Adding Lines: $num_lines header"); 411 } 412 my $tmp = _new_fh(); 413 unless (open ($tmp, ">$tmp_path") ) { 414 pm_log(0,"Couldn't open $tmp_path! $!"); 415 exit TEMPFAIL; 416 } 417 print $tmp ($m_obj->as_mbox_string); 418 close($tmp); 419 420 unless ( $test ) { 421 unless (link($tmp_path, $new_path) ) { 422 pm_log(0,"Couldn't link $tmp_path to $new_path : $!"); 423 exit TEMPFAIL; 424 } 425 } 426 unlink($tmp_path) or pm_log(1,"Couldn't unlink $tmp_path: $!"); 427 } 428 else { 429 # It's an mbox, I hope. 430 my $fh = _new_fh(); 431 unless (open($fh, ">>$target")) { 432 pm_log(0,"Couldn't open $target! $!"); 433 exit TEMPFAIL; 434 } 435 flock($fh, LOCK_EX) 436 or pm_log(1,"Couldn't get exclusive lock on $target"); 437 seek($fh, 0, 2); # make sure we're still at the end 438 print $fh ($m_obj->as_mbox_string) unless $test; 439 flock($fh, LOCK_UN) 440 or pm_log(1,"Couldn't unlock on $target"); 441 close($fh); 442 } 443 exit DELIVERED unless $atts{continue}; 444} 445 446 447=head2 pm_pipe_to 448 449This routine performs delivery to a command via a pipe. 450 451Return the command exit status if the continue attribute is supplied. 452If execution is skipped due to test mode, the return value will be 0. 453See also attribute C<testalso> below. 454 455If the name of a lockfile is supplied, multiple deliveries are throttled. 456 457Example: 458 459 pm_pipe_to("my_filter", lockfile => "/tmp/pm.lock"); 460 461Attributes: 462 463=over 464 465=item * 466 467lockfile 468 469The name of a file that is used to guard against multiple deliveries. 470The program will try to exclusively create this file before proceding. 471Upon completion, the lock file will be removed. 472 473=item * 474 475continue 476 477If true, processing will continue after delivery. Otherwise the 478program will exit with a DELIVERED status, I<even when the command 479failed>. 480 481=item * 482 483testalso 484 485Do this, even in test mode. 486 487=back 488 489=cut 490 491sub pm_pipe_to { 492 my ($target, %atts) = @_; 493 my $line = (caller(0))[2]; 494 pm_log(2, "pipe_to[$line]: $target "._pm_msg_size()); 495 496 my $lock; 497 my $lockfile = $atts{lockfile}; 498 $lock = pm_lockfile($lockfile) if $lockfile; 499 local ($SIG{PIPE}) = 'IGNORE'; 500 my $ret = 0; 501 eval { 502 $ret = undef; 503 my $pipe = _new_fh(); 504 open ($pipe, "|".$target) 505 && $m_obj->print($pipe) 506 && close ($pipe); 507 $ret = $?; 508 } unless $test && !$atts{testalso}; 509 510 pm_unlockfile($lock); 511 $ret = 0 if $ret < 0; # broken pipe 512 pm_log (2, "pipe_to[$line]: command result = ". 513 (defined $ret ? sprintf("0x%x", $ret) : "undef"). 514 ($! ? ", \$! = $!" : ""). 515 ($@ ? ", \$@ = $@" : "")) 516 unless defined $ret && $ret == 0; 517 return $ret if $atts{continue}; 518 exit DELIVERED; 519} 520 521=head2 pm_command 522 523Executes a system command for its side effects. 524 525If the name of a lockfile is supplied, multiple executes are 526throttled. This would be required if the command manipulates external 527data in an otherwise unprotected manner. 528 529Example: 530 531 pm_command("grep foo some.dat > /tmp/pm.dat", 532 lockfile => "/tmp/pm.dat.lock"); 533 534Attributes: 535 536=over 537 538=item * 539 540lockfile 541 542The name of a file that is used to guard against multiple executions. 543The program will try to exclusively create this file before proceding. 544Upon completion, the lock file will be removed. 545 546testalso 547 548Do this, even in test mode. 549 550=back 551 552=cut 553 554sub pm_command { 555 my ($target, %atts) = @_; 556 my $line = (caller(0))[2]; 557 pm_log(2, "command[$line]: $target "._pm_msg_size()); 558 559 my $lock; 560 my $lockfile = $atts{lockfile}; 561 $lock = pm_lockfile($lockfile) if $lockfile; 562 my $ret = 0; 563 $ret = system($target) unless $atts{testalso}; 564 pm_unlockfile($lock); 565 pm_log (2, "command[$line]: command result = ". 566 (defined $ret ? sprintf("0x%x", $ret) : "undef")) 567 unless defined $ret && $ret == 0; 568 $ret; 569} 570 571=head2 pm_resend 572 573Send this message through to some other user. 574 575Example: 576 577 pm_resend("root"); 578 579Attributes: 580 581=over 582 583=item * 584 585continue 586 587If true, processing will continue after delivery. Otherwise the 588program will exit with a DELIVERED status. 589 590=back 591 592=cut 593 594sub pm_resend { 595 my ($target, %atts) = @_; 596 my $line = (caller(0))[2]; 597 pm_log(2, "resend[$line]: $target "._pm_msg_size()); 598 $m_obj->smtpsend(To => $target) unless $test; 599 exit DELIVERED unless $atts{continue}; 600} 601 602=head2 pm_reject 603 604Reject a message. The sender will get a mail back with the reason for 605the rejection (unless stderr has been redirected). 606 607Example: 608 609 pm_reject("Non-existent address"); 610 611=cut 612 613sub pm_reject { 614 my $reason = shift; 615 my $line = (caller(0))[2]; 616 pm_log(2, "reject[$line]: $reason "._pm_msg_size()); 617 print STDERR ($reason, "\n") unless lc $logfile eq 'stderr'; 618 exit REJECTED; 619} 620 621 622=head2 pm_ignore 623 624Ignore a message. The program will do nothing and just exit with a 625DELIVERED status. A descriptive text may be passed to log the reason 626for ignoring. 627 628Example: 629 630 pm_ignore("Another make money fast message"); 631 632=cut 633 634sub pm_ignore { 635 my $reason = shift; 636 my $line = (caller(0))[2]; 637 pm_log(2, "ignore[$line]: $reason "._pm_msg_size()); 638 exit DELIVERED; 639} 640 641=head2 pm_dupcheck 642 643Check for duplicate messages. Reject the message if its message ID has 644already been received. 645 646Example: 647 648 pm_dupcheck(scalar(pm_gethdr("message-id"))); 649 650Attributes: 651 652=over 653 654=item * 655 656dbm 657 658The name of a DBM file (created if necessary) to store the message IDs. 659The default name is C<.msgids> in the HOME directory. 660 661=item * 662 663retain 664 665The amount of time, in days, that subsequent identical message IDs are 666considered duplicates. Each new occurrence will refresh the time stamp. 667The default value is 14 days. 668 669=item * 670 671continue 672 673If true, the routine will return true or false depending on the 674message ID being duplicate. Otherwise, if it was duplicate, the 675program will exit with a DELIVERED status. 676 677=back 678 679I<Warning: In the current implementation, the DBM file will grow 680unlimited. A separate tool will be supplied to expire old message IDs.> 681 682=cut 683 684sub pm_dupcheck { 685 my ($msgid) = shift; 686 my (%atts) = (dbm => $ENV{HOME}."/.msgids", 687 retain => 14, 688 @_); 689 my $dbm = $atts{dbm}; 690 691 my %msgid; 692 my $dup = 0; 693 if ( dbmopen(%msgid, $dbm, 0660) ) { 694 my $tmp; 695 if ( defined($tmp = $msgid{$msgid}) ) { 696 if ( ($msgid{$msgid} = time) - $tmp < $atts{retain}*24*60*60 ) { 697 my $line = (caller(0))[2]; 698 pm_log(2, "dup[$line]: $msgid "._pm_msg_size()); 699 $dup++; 700 } 701 } 702 else { 703 $msgid{$msgid} = time; 704 } 705 dbmclose(%msgid) 706 or pm_log(0, "Error closing $dbm: $!"); 707 } 708 else { 709 pm_log(0, "Error opening $dbm: $!"); 710 } 711 exit DELIVERED 712 if $dup && !$atts{continue}; 713 $dup; 714} 715 716=head2 pm_lockfile 717 718The program will try to get an exclusive lock using this file. 719 720Example: 721 722 $lock_id = pm_lockfile("my.mailbox.lock"); 723 724The lock id is returned, or undef on failure. 725 726=cut 727 728my $lockmgr; 729sub pm_lockfile { 730 my ($file) = @_; 731 732 $lockmgr = LockFile::Simple->make(-hold => 600, -stale => 1, 733 -autoclean => 1, 734 -wfunc => sub { pm_log(2,@_) }, 735 -efunc => sub { pm_log(0,@_) }, 736 ) 737 unless $lockmgr; 738 739 $lockmgr->lock($file, "%f"); 740} 741 742=head2 pm_unlockfile 743 744Unlocks a lock acquired earlier using pm_lockfile(). 745 746Example: 747 748 pm_unlockfile($lock_id); 749 750If unlocking succeeds, the lock file is removed. 751 752=cut 753 754sub pm_unlockfile { 755 shift->release if $_[0]; 756} 757 758=head2 pm_log 759 760Logging facility. If pm_init() was supplied the name of a log file, 761this file will be opened, created if necessary. Every log message 762written will get a timestamp attached. The log level (first argument) 763must be less than or equal to the loglevel attribute used with 764pm_init(). If not, this message will be skipped. 765 766Example: 767 768 pm_log(2,"Retrying"); 769 770=cut 771 772my $logfh; 773sub pm_log { 774 return unless $logfile; 775 return if shift > $loglevel; 776 777 # Use sysopen/syswrite for atomicity. 778 unless ( $logfh ) { 779 $logfh = _new_fh(); 780 print STDERR ("Opening logfile $logfile\n") if $debug; 781 if ( lc($logfile) eq "stderr" ) { 782 open ($logfh, ">&STDERR"); 783 } 784 elsif ( lc($logfile) eq "stdout" || $logfile eq "-" ) { 785 open ($logfh, ">&STDOUT"); 786 } 787 else { 788 sysopen ($logfh, $logfile, O_WRONLY|O_CREAT|O_APPEND) 789 || print STDERR ("$logfile: $!\n"); 790 } 791 } 792 my @tm = localtime; 793 my $msg = sprintf ("%04d%02d%02d%02d%02d%02d.%05d %s\n", 794 $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], 795 $$, "@_"); 796 print STDERR ($msg) if $debug; 797 syswrite ($logfh, $msg); 798} 799 800sub _new_fh { 801 return if $] >= 5.006; # 5.6 will take care itself 802 require IO::File; 803 IO::File->new(); 804} 805 806################ Reporting ################ 807 808=head2 pm_report 809 810pm_report() produces a summary report from log files from 811Mail::Procmail applications. 812 813Example: 814 815 pm_report(logfile => "pmlog"); 816 817The report shows the deliveries, and the rules that caused the 818deliveries. For example: 819 820 393 393 deliver[203] /home/jv/Mail/perl5-porters.spool 821 370 370 deliver[203] /home/jv/Mail/perl6-language.spool 822 174 174 deliver[203] /home/jv/Mail/perl6-internals.spool 823 160 81 deliver[311] /var/spool/mail/jv 824 46 deliver[337] 825 23 deliver[363] 826 10 deliver[165] 827 828The first column is the total number of deliveries for this target. 829The second column is the number of deliveries triggered by the 830indicated rule. If more rules apply to a target, this line is followed 831by additional lines with an empty first and last column. 832 833Attributes: 834 835=over 836 837=item * 838 839logfile 840 841The name of the logfile to process. 842 843=back 844 845If no logfile attribute is passed, pm_report() reads all files 846supplied on the command line. This makes it straighforward to run from 847the command line: 848 849 $ perl -MMail::Procmail -e 'pm_report()' syslog/pm_logs/* 850 851=cut 852 853sub pm_report { 854 855 my (%atts) = @_; 856 my $logfile = delete($atts{logfile}); 857 858 local (@ARGV) = $logfile ? ($logfile) : @ARGV; 859 860 my %tally; # master array with data 861 my $max1 = 0; # max. delivery 862 my $max2 = 0; # max. delivery / rule 863 my $max3 = 0; # max length of rules 864 my $recs = 0; # records in file 865 my $msgs = 0; # messages 866 my $dlvr = 0; # deliveries 867 868 while ( <> ) { 869 $recs++; 870 871 # Tally number of incoming messages. 872 $msgs++, next if /^\d+\.\d+ Mail from/; 873 874 # Skip non-deliveries. 875 next unless /^\d+\.\d+ (\w+\[[^\]]+\]):\s+(.+)/; 876 $dlvr++; 877 878 # Update stats and keep track of max values. 879 my $t; 880 $max1 = $t if ($t = ++$tally{$2}->[0]) > $max1; 881 $max2 = $t if ($t = ++$tally{$2}->[1]->{$1}) > $max2; 882 $max3 = $t if ($t = length($1)) > $max3; 883 } 884 885 print STDOUT ("$recs records, $msgs messages, $dlvr deliveries.\n\n"); 886 887 # Construct format for report. 888 $max1 = length($max1); 889 $max2 = length($max2); 890 my $fmt = "%${max1}s %${max2}s %-${max3}s %s\n"; 891 892 # Sort on number of deliveries per target. 893 foreach my $dest ( sort { $b->[1] <=> $a->[1] } 894 map { [ $_, $tally{$_}->[0], $tally{$_}->[1] ] } 895 keys %tally ) { 896 my $first = 1; 897 # Sort on deliveries per rule. 898 foreach my $rule ( sort { $b->[1] <=> $a->[1] } 899 map { [ $_, $dest->[2]->{$_} ] } 900 keys %{$dest->[2]} ) { 901 printf STDOUT ($fmt, 902 ($first ? $dest->[1] : ""), 903 $rule->[1], 904 $rule->[0], 905 ($first ? $dest->[0] : "")); 906 $first = 0; 907 } 908 } 909 910} 911 912=head1 USING WITH PROCMAIL 913 914The following lines at the start of .procmailrc will cause a copy of 915each incoming message to be saved in $HOME/syslog/mail, after which 916the procmail-pl is run as a TRAP program (see the procmailrc 917documentation). As a result, procmail will transfer the exit status of 918procmail-pl to the mail transfer agent that invoked procmail (e.g., 919sendmail, or postfix). 920 921 LOGFILE=$HOME/syslog/procmail 922 VERBOSE=off 923 LOGABSTRACT=off 924 EXITCODE= 925 TRAP=$HOME/bin/procmail-pl 926 927 :0: 928 $HOME/syslog/mail 929 930B<WARNING>: procmail seems to have problems when $HOME/syslog/mail 931gets too big (over 50Mb). If you want to maintain a huge archive, you 932can specify excess extents, like this: 933 934 :0: 935 $HOME/syslog/mail-ext1 936 937 :0: 938 $HOME/syslog/mail-ext2 939 940=head1 EXAMPLE 941 942An extensive example can be found in the examples directory of the 943C<Mail::Procmail> kit. 944 945=head1 SEE ALSO 946 947L<Mail::Internet> 948 949L<LockFile::Simple> 950 951procmail documentation. 952 953=head1 AUTHOR 954 955Johan Vromans, Squirrel Consultancy <jvromans@squirrel.nl> 956 957Some parts are shamelessly stolen from Mail::Audit by Simon Cozens 958<simon@cpan.org>, who admitted that he stole most of it from programs 959by Tom Christiansen. 960 961=head1 COPYRIGHT and DISCLAIMER 962 963This program is Copyright 2000,2004 by Squirrel Consultancy. All 964rights reserved. 965 966This program is free software; you can redistribute it and/or modify 967it under the terms of either: a) the GNU General Public License as 968published by the Free Software Foundation; either version 1, or (at 969your option) any later version, or b) the "Artistic License" which 970comes with Perl. 971 972This program is distributed in the hope that it will be useful, but 973WITHOUT ANY WARRANTY; without even the implied warranty of 974MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the 975GNU General Public License or the Artistic License for more details. 976 977=cut 978 9791; 980 981# Local Variables: 982# compile-command: "perl -wc -Mlib=$HOME/lib/perl5 Procmail.pm && install -m 0555 Procmail.pm $HOME/lib/perl5/Mail/Procmail.pm" 983# End: 984