yample-0.30/0040700001554500155450000000000010001072123011731 5ustar perbuperbuyample-0.30/yample0100755001554500155450000007152610001072123013170 0ustar perbuperbu#!/usr/bin/perl # $Id: yample,v 1.35 2004/01/13 22:32:04 perbu Exp $ our ($VERSION); $VERSION = '0.30'; =head1 NAME Yample - Yet Another Mail Processing Language. =head1 DESCRIPTION Yample is an MDA - a mail delivery agent. It accepts a message via standard input and stores this message in a maildir or in a mbox. Yample tries to incorporate the power of Perl and Mail::Internet, Mail::Spamassassin and the other Mail modules whilst maintaining an friendly syntax. Yample was written due to a personal conflict with Procmails syntax. Look at the following lines, taken from "man procmailex"; :0 c * ^From.*peter * ^Subject:.*compilers ! william@somewhere.edu :0 A petcompil This can be implemented like this in Yample; sender(peter) and subject(compilers) unseen resend(william@somewhere.edu) sender(peter) and subject(compilers) mbox(petcompil) =cut # load critical modules. Without these - we fail. use strict; use Mail::Internet; use Mail::Send; use Getopt::Long; use Pod::Usage; #use Regexp::Common qw(balanced); use Text::Balanced qw(extract_bracketed); # use Data::Dumper; $SIG{__DIE__} = sub { DB::backtrace() }; use constant OK => 1; use constant FAILED => 0; use constant TEMPFAIL => 101; use constant PERMFAIL => 75; use constant RX_MAGIC => 1; use constant LIST_SUPPORT => 1; use constant S_COND => 0; use constant S_ACTION => 1; my $HOME = $ENV{'HOME'}; my $BASE = "$HOME/.yample"; my (@RULES); my $HELP; my $SHOW_VERSION; my $MAILBASE = "$HOME/Maildir"; my $LOGFILE = "$BASE/log"; my $RULESFILE = "$BASE/rules"; my $DUPDB = "$BASE/dupdb"; my $LOGLEVEL = 1; my $SPAMASSASSIN = 0; my $SPAMC = 0; my $SPAMC_PATH = "spamc"; my $PANIC_MBOX = "$BASE/panic_mbox"; my $DRY_RUN = 0; =head1 OPTIONS =over 5 =item B<--help> Help! =item B<--mailbase > This option is prepended to any destinations you have. Default is ~/Maildir/. =item B<--logfile> Yamples logfile. Default is ~/.yample/log. =item B<--loglevel <0-4>> Loglevel. 4 - Debug, 3 - info, 2 - warnings, 1 - errors, 0 - nothing. =item B<--spamassassin> Load Mail::Spamassassin and run the mail through it. =item B<--spamc> Run the message through spamc. Yample will look for spamc in the $PATH unless you set B<--spamc-path>. =item B<--spamc-path> /path/to/spamc Where spamc resides. =item B<--dubdb > The message id database - used for duplicate suppression. =item B<--rules > The rule file. =back =head1 FILES =head2 ~/.yample/rules This file contains the rules which Yample uses to sort mail. Yample reads the mail from STDIN and then processes the rules, one by one. The rules consists of two parts; condition(s) and target. There is an implicit if .. then .. else between every rule. Please see the examples futher down. In the conditions which take a regular expression as a parameter you can use grouping to extract parts of the text and utilize this in the sorting. Like this: "subject((.*)) and rcpt(user@foo.org): reject(Your message with subject $1 was rejected)". Cool, eh? NOTE: We replace "/" and "." with "_" in grouped strings to make sure there won't be any funny business. =over 5 =cut GetOptions( "help" => \$HELP, "version" => \$SHOW_VERSION, "mailbase=s" => \$MAILBASE, "basedir=s" => \$BASE, "logfile=s" => \$LOGFILE, "loglevel=i" => \$LOGLEVEL, "dupdb=s" => \$DUPDB, "spamassassin" => \$SPAMASSASSIN, "spamc" => \$SPAMC, "spamc-path" => \$SPAMC_PATH, "dry-run" => \$DRY_RUN, "rules=s" => \$RULESFILE, ) or pod2usage( -msg => "$! Type $0 --help for help", -exitval => 1, -verbose => 0, -output => \*STDERR ); if ($HELP) { pod2usage( -msg => 'Try "perldoc yample" for a in-depth description', -exitval => 0, -verbose => 1, -output => \*STDOUT ); } if ($SHOW_VERSION) { print("$VERSION"); exit; } my $logger = new Yample::Logger( $LOGFILE, $LOGLEVEL ); $logger->log( 3, "hi! Yample $VERSION is starting up." ); if ( $SPAMC && $SPAMASSASSIN ) { $logger->log( 1, "Both spamc and spamassassin are enabled - disabeling spamassassin" ); undef $SPAMASSASSIN; } @RULES = getsortinglist(); my $yample = Yample::Mail->new( 'emergency' => $PANIC_MBOX, 'dupdb' => $DUPDB, 'logger' => $logger, 'SPAMC' => $SPAMC, 'SPAMASSASSIN' => $SPAMASSASSIN, ); # we are not spam - sort the mail. # first sort out the mailing lists (rcptlist) # Rules: my %CONDITIONS = ( 'sender' => \&Yample::Rules::sender, 'rcpt' => \&Yample::Rules::rcpt, 'subject' => \&Yample::Rules::subject, 'list' => \&Yample::Rules::list, 'spam' => \&Yample::Rules::spam, 'head' => \&Yample::Rules::head, 'dup' => \&Yample::Rules::dup, 'perl' => \&Yample::Rules::perl, ); # print (Dumper(\@RULES)); # prepare a dispatcher: my $dispatcher = new Yample::Actions ( $logger ); RULELIST: for my $rule (@RULES) { $logger->log(3, "Trying rule line # $rule->{line}"); my ($result, @matches) = try_rule($rule) ; if ($result) { my $target = $rule->{parameter}; if ($target =~ s/\$(\d)/$matches[$1 - 1]/eg) { $logger->log(3, "target altered: $rule->{parameter} --> $target"); } $logger->log(1, "\#$rule->{line} $yample->{msg_id}/$yample->{subject}: $rule->{action}($target)"); $dispatcher->dispatch($rule->{action}, $target, @matches ) unless ($DRY_RUN); if ($rule->{unseen}) { $logger->log(3, "Unseen delivery - will continue"); } else { done(); } } else { } } # try_rule($) # The while-loop marked RULELIST traverses the rules and passes them # them to this subqroutine which decides whether they match or not. sub try_rule { my ($rule) = @_; my $result = 0; # we default to 0 - "false"; my @expr; my @rules_matches; for my $condition ( @{ $rule->{cond} } ) { if (ref $condition) { my ($action, $parameter) = @{ $condition }; if (defined($CONDITIONS{$action})) { my ($result, @matches) = &{ $CONDITIONS{$action}}( $yample, $parameter); # strip off unsafe characters for (@matches) {s,[/.],_,g; } push(@expr, $result || '0'); $logger->log(3, "$action($parameter) --> $result"); push(@rules_matches, @matches); } else { STDERR->print("Undefined condition: $action\n"); } } else { if ($condition eq 'and' or $condition eq 'or' or $condition eq ')' or $condition eq '(' or $condition eq '!' ) { push( @expr, $condition); } else { # parser error } } } my $expr = join(' ', @expr); my $result = eval( $expr ); $logger->log(3, "eval($expr) ---> $result"); if ($@) { $logger->log(0, "Rule on line $rule->{line}: Eval of '$expr' failed - $@"); } return($result, @rules_matches); } $logger->log(1, "There was no rule to catch this mail - storing i PANIC MBOX ($PANIC_MBOX)"); $dispatcher->dispatch('mbox', $PANIC_MBOX) unless $DRY_RUN; done(); # done() # # Ends the program in a controlled fashion. sub done { $logger->log(3, "Yample is about to exit in an orderly fashion"); $logger->close; exit(0); } # match_replace($target, @matches) # # match_replace does the search and replace on the target. sub match_replace { my ( $target, @matches ) = @_; $logger->log( 3, "s/r on $target" ); if ( $target =~ s/\$(\d)/$matches[$1 - 1]/eg ) { $logger->log( 3, "target altered: now $target ($1 $2 $3 $4)" ); } return $target; } # getsortinglist() # sub getsortinglist reads ~/.yample/rules or whatever you spesify, # parses the rules and creates a list. The parser is a bit buggy - it # does not handle the rules properly - but it will cover 99.9% of your # needs, methink. Please let me know if you find a bug. sub getsortinglist { my ($list) = @_; my @LIST; my $LIST = new IO::File($RULESFILE) or $logger->log( 2, "Could not open rules($RULESFILE): $!" ); while ( my $line = <$LIST> ) { next if ( ( $line =~ m/^\s*\#/ ) or ( $line =~ m/^\s*$/ ) ); chomp($line); # ryletype(parameters): [unseen] ACTION(parameter) my (@cond, $unseen, $ac, $ac_par); my $state = S_COND; while ($state == S_COND) { if ($line =~ m/^\s*(\w+)(\(.*)/) { my ($cmd, $par) = ($1, $2); $line = $par; # $1 is the command # $2 is probably the parameter + $line my ($extracted, $remainder) = extract_bracketed( $line,'()'); $line = $remainder; # print "cmd: '$cmd' - '$extracted' - '$line'\n"; push(@cond, [$cmd, $extracted] ); } elsif ( $line =~ m/^\s*(and|or|\!|\(|\))(.*)/) { push(@cond, $1); $line = $2; } elsif ($line =~ m/^:\s*(.*)/) { $line = $1; $state = S_ACTION; } # print "After pop: $line\n"; } if ($line =~ m/unseen\s+(.*)/ ) { $unseen = 1; $line = $1; } if ($line =~ m/(\w+)\((.*)\)/ ) { ($ac, $ac_par) = ($1, $2); } else { # parse error. next; } # \( ([^\\)] | \\| \) )* \) # print "Cond: $1\n"; my $rule = { 'cond' => \@cond, 'unseen' => $unseen, 'action' => $ac, 'parameter' => $ac_par, 'line' => $LIST->input_line_number(), }; push( @LIST, $rule ); } $LIST->close(); return @LIST; } =item Yample::Rules This package contains subroutines which handle the individual rules. The rules are transformed into perl code which will call these methods to decide what to do with the message. =cut package Yample::Rules; use IO::File; use POSIX; =item dup() Detects duplicates. =cut sub dup { my ($yample) = @_; return $yample->{dup}; } =item rcpt() The rcpt rule matches against the To- and Cc-headers. =cut sub rcpt { my ($yample, $rx) = @_; my @matches; if ( ( @matches = $yample->to =~ m/$rx/i ) or ( @matches = $yample->cc =~ m/$rx/i ) ) { return(1, @matches); } else { return undef; } } =item sender() The sender rule matches against the From-header. =cut sub sender { my ($yample,$rx) = @_; my @matches; if ( @matches = $yample->from =~ m/$rx/i ) { return(1, @matches); } else { return undef; } } =item subject() Matches on the subject of the message. =cut sub subject { my ($yample, $rx) = @_; my @matches; if ( @matches = $yample->subject =~ m/$rx/i ) { return(1, @matches); } else { return undef; } } =item list() If Yample can load Mail::Listdetect then list() can be used to match against the name of the mailing list (unless the mailing list server is completely lame). You can use this rule like this: list((.*)): maildir(.lists.$1) =cut sub list { my ($yample, $rx) = @_; my @matches; if ( $yample->listname and ( @matches = $yample->listname =~ m/$rx/i ) ) { return(1, @matches); } else { return undef; } } =item head() Match against a arbitrary header. Note the caret (^) head(^X-Spam-Flag: YES): maildir(.junk.spam) head(^X-Infected:): maildir(.junk.virii) =cut sub head { my ( $yample, $rx ) = @_; my @matches; if ( @matches = ($yample->{head} =~ m/$rx/smi ) ) { return(1, @matches); } else { return undef; } } =item spam() If Yample loads Spamassassin (and runs the message through it) you can use spam() to determine the status of the message. =cut sub spam { my ($yample) = @_; return ( $yample->sa_status ); } =item perl() Run arbitrary perl code. Unless you are some sort of pervert you would not use this for anything but testing and debugging Yample. =cut sub perl { my ($yample, $expr, @matches) = @_; my @ret = eval($expr); if ($@) { $yample->logger->log(1, "perl($expr) yielded an error: $@"); } return( @ret ); } =item Yample::Actions Action dispatcher class. All the targets are defined here. =cut package Yample::Actions; # new() # # new() sets up the Action class (logging and such). use Fcntl ':flock'; # import LOCK_* constants use IO::File; use Sys::Hostname; sub new { my ($self, $logger) = @_; $self = {}; bless $self; $self->{logger} = $logger; $self->{actions} = actions(); return $self; } # dispatch() # # Dispatcher - call the apropiate subroutine. sub dispatch { my ($self, $action, $parameter) = @_; $self->{logger}->log(3, "Dispatching $action ($parameter)"); &{ $self->{actions}->{$action} }( $self, $parameter ); return $self; } # actions() # Defines the different actions. sub actions { my %ACTIONS = ( maildir => \&maildir, mbox => \&mbox, resend => \&resend, ignore => \&ignore, reject => \&reject, reply => \&reply, pipe => \&pipe, ); return \%ACTIONS; } =item maildir() Stores the message in a UW-style maildir more or less as defined per RFCXXXX. =cut sub maildir { my ($self, $dest) = @_; $dest = '' unless ($dest); my $folder; if ($dest =~ m,^[/~],) { $dest =~ s/^~/$ENV{HOME}/e; $folder = $dest; } else { $folder = "$MAILBASE/$dest"; } "$MAILBASE/$dest"; $self->{logger}->log( 3, "Storing message in Maildir $folder" ); if ( -f $folder ) { $self->{logger}->log( 1, "$folder is not a directory - it is a file - we will pretend it is a mbox" ); $self->mbox($dest); } elsif ( !-d $folder ) { $self->{logger}->log( 1, "No maildir found, creating $folder/(cur|new|tmp)" ); mkdir("$folder", 0700) || $self->{logger}->log( 1, "Unable to create directory $folder: $!" ); mkdir("$folder/cur", 0700) || $self->{logger}->log( 1, "Unable to create directory $folder $!" ); mkdir("$folder/new", 0700) || $self->{logger}->log( 1, "Unable to create directory $folder/new: $!" ); mkdir("$folder/tmp", 0700) || $self->{logger}->log( 1, "Unable to create directory $folder/tmp: $!" ); } # here we do the maildir delivery. my $fname = time() . ".$$." . hostname(); $self->{logger}->log(3, "Creating $folder/tmp/$fname"); my $target = IO::File->new("$folder/tmp/$fname", O_CREAT|O_WRONLY|O_APPEND); unless (defined $target) { $self->{logger}->log(1, "Could not create '$folder/tmp/$fname': $!"); exit(main::TEMPFAIL); } $yample->print( $target ); $target->close(); unless ( link("$folder/tmp/$fname", "$folder/new/$fname")) { $self->{logger}->log(1, "linking of '$folder/tmp/$fname' failed: $!"); exit(main::TEMPFAIL); } unless (unlink("$folder/tmp/$fname")) { $self->{logger}->log(1, "Unlink of '$folder/tmp/$fname' failed: $!"); exit(main::TEMPFAIL); } $self->{logger}->log(3, "linked into $folder/new/$fname"); } =item mbox() Delivers mail to a standard Unix mailbox. Parameters: The mailbox where the message is to be delivered. =cut sub mbox { my ($self, $dest) = @_; my $folder; if ($dest =~ m,^[/~],) { $dest =~ s/^~/$ENV{HOME}/; $folder = $dest; } else { $folder = "$MAILBASE/$dest"; } $self->{logger}->log( 3, "Storing in mbox '$folder'"); unless ( -f $folder ) { $self->{logger}->log( 3, "No mbox found, creating" ); } if ( -d $folder ) { $self->{logger}->log( 1, "$folder is a maildir - not a mbox - we will attempt Maildir-delivery" ); $self->maildir($dest); } else { # mbox delivery. my $locked = 0; my $mbox = new IO::File(">> $folder"); for my $i (0 .. 9) { if ( flock($mbox, LOCK_EX ) ) { $locked++; } else { # pick a number, any number. sleep(6); } } if (! $locked) { $self->{logger}->log(5, "Could not aquire lock"); exit(main::TEMPFAIL); } else { $mbox->seek(2,0); $yample->print( $mbox ); } } } =item resend() Parameters: Where the message is to be forwarded. =cut sub resend { my ($self, $dest) = @_; $self->{logger}->log( 3, "Resending mail to '$dest'"); # fixme: borken? Maybe not by SMTP? $yample->smtpsend( To => $dest ); } =item reject() Reject the message. This normally forces your mail server to create a bounce and mail this to the original sender. Parameters: Error message. This message will probably be included in the bounce generated. =cut sub reject { my ($self, $reason) = @_; $self->{logger}->log( 3, "Rejecting mail; '$reason'"); STDERR->print( "Rejecting message: \n", $reason, "\n", ); exit(main::PERMFAIL); } =item ignore() Ignore the message silently. Parameters: none =cut sub ignore { my ($self) = @_; $self->{logger}->log( 3, "Ignoring mail"); # uuhh. no-op. } =item reply() Reply to the message. Parameters: The body of the reply. =cut sub reply { my ($self, $body) = @_; if ($self->head->as_string =~ m/(^( ( (Mailing-List|Precedence):.* (junk|bulk|list) ) | ( (From|Sender|X-Envelope-From):.* (post(master|office)) ) ) )/xi) { $self->{logger}->log( 1, "Skipping reply - from postmaster."); } else { my $rcpt = $self->head->get("Resent-From") || $self->head->get("Reply-To") || $self->head->get("Return-Path") || $self->head->get("From") || $self->head->get("Sender"); $self->{logger}->log( 3, "Sending replay to $rcpt '$body'"); my $msg = new Mail::Send( Subject => "Re: ". ($self->subject) ? $self->subject : 'your message', To => $self->from); my @references; @references = ( split(' ', $self->head->get("References")), split(' ', $self->head->get("Message-ID"))); @references = grep { /^<.*>$/ } @references; $msg->set('References', join(' ',@references)); my $fh = $msg->open(); $fh->print($body); $fh->close(); } } =item pipe() Parameters: The command which is message is to be piped into. Executed through "/bin/sh -c". =cut sub pipe { my ($self, $program) = @_; $self->{logger}->log( 3, "Piping to '$program'"); open(PIPE, "|$program"); $yample->print( \*PIPE ); close PIPE; my $status = ($? >> 8); if ($status != 0) { $self->{logger}-> log(1, "'$program' returned non-zero value ($status)"); } } package Yample::Mail; # is you get dups with more than 2000 other messages inbetween - increase this. # (as if) use constant MAX_DUPDBSIZE => 2000; use Fcntl; # use Data::Dumper; use IPC::Open2; use Mail::Internet; use vars qw (@ISA $AUTOLOAD); @ISA = 'Mail::Internet'; # The mail object and everything releated to the email is stored here. sub new { my ($self, %OPTS ) = @_; #my $mail = # # ); $self = Mail::Internet->new( \*STDIN ); bless $self; @ISA = 'Mail::Internet'; $self->{logger} = $OPTS{logger}; $self->{encoding} = $self->get("Content-Transfer-Encoding"); $self->{to} = $self->head->get('To:'); $self->{cc} = $self->head->get('Cc:'); $self->{from} = $self->head->get('From:'); $self->{subject} = $self->head->get('Subject:'); $self->{msg_id} = $self->head->get("Message-Id"); $self->{head} = $self->head->as_string(); if ($self->{encoding}) { eval { require MIME::Words; import MIME::Words qw(:all); }; $self->{logger}->log(1, "Error while loading MIME::Words: '$!'") if ($@); } for ( qw(from subject to cc ) ) { chomp($self->{$_}); if ($self->{encoding}) { $self->{$_} = decode_mimewords($self->{$_}); } } $self->{listname} = listdetect( $self ); # $self->{dup} = 0; $self->{dup} = is_dup($self->{msg_id}, $OPTS{dupdb}); $self->{logger}->log(3, "Dup: " . $self->{dup} ); # do SA-stuff: $self->{sa_status} = undef; if ( $OPTS{SPAMC} ) { $self->{sa_status} = $self->do_spamc(); } elsif ($OPTS{SPAMASSASSIN} ) { $self->{sa_status} = $self->do_sa(); } return $self; } sub AUTOLOAD { my ($self, @args) = @_; my @name = split(/::/, $AUTOLOAD); my $method = pop(@name); return if $method eq 'DESTROY'; return $self->{$method}; } # this a blatant rip out of Mail::Audit::KillDups. I needed to change it # a bit. This code is (c) Simon Cozens sub is_dup { my ($mid, $dupdb) = @_; my $end_of_ring = 0; my $current_pos; chomp $mid; unless ( sysopen( MSGID, $dupdb, O_RDWR | O_CREAT ) ) { return 0; } while () { chomp; if ( $_ eq $mid ) { # found it. return 1; } $current_pos = tell MSGID; if ( $current_pos > MAX_DUPDBSIZE && $end_of_ring == 0 ) { # we've gotten too big, write this mid back at the top of the file last; } elsif ( $_ eq "" && $end_of_ring == 0 && $current_pos > 0 ) { # Found the end of the ring buffer, so save position. $end_of_ring = $current_pos - 1; } } # Didn't find mid, so write it to the end of the ring buffer unless ( seek MSGID, $end_of_ring, 0 ) { close MSGID; return 0; } print MSGID "$mid\n\n" unless ($DRY_RUN); close MSGID; return 0; } # end of rip-out :) sub listdetect { my ($mail) = @_; my $listname; return undef unless (main::LIST_SUPPORT); eval { require Mail::ListDetector; import Mail::ListDetector; my $listdet = new Mail::ListDetector($mail); $listname = $listdet->{data}->{listname}; unless ($listname) { my $post_addr = $listdet->{data}->{posting_address}; if ($post_addr) { ($listname) = $post_addr =~ m/(.*)@/ } } }; if ($@) { warn("Could not load Mail::ListDetector: $@" ); return undef; } else { return $listname; } } sub do_spamc { my ($self) = @_; my ($rfh, $wfh, $sa_status ); $self->{logger}->log( 3, "Starting spamc" ); if ( open2( $rfh, $wfh, "/usr/bin/spamc -c" ) ) { $wfh->print( $self->as_string() ); $wfh->close(); while (<$rfh>) { $sa_status .= $_; } $sa_status =~ s,/.*,,; $wfh->close(); $self->{logger}->log(1, "Spamc score: $sa_status"); return($sa_status); } else { $self->{logger}->log(1, "Problem running spamc: $!"); return undef; } } sub do_sa { my ($self) = @_; my ($sa_status); $self->{logger}->log( 3, "Loading SA" ); eval { require Mail::SpamAssassin; import Mail::SpamAssassin; }; if ($@) { $logger->log( 1, "Coult not load Mail::SpamAssassin: $@" ); return undef; } else { $logger->log(3, "SA loaded OK"); } my $spamassassin = Mail::SpamAssassin->new(); my $msg_rep = $spamassassin->check( $self ); if ( $msg_rep->is_spam() ) { $sa_status = $msg_rep->get_hits(); $msg_rep->rewrite_mail(); $self->{logger}->log(1, "Spamassassin score: $sa_status"); return $sa_status; } else { return undef; } } package Yample::Logger; use IO::File; use Fcntl; use POSIX qw(strftime); sub new { my ($self, $filename, $loglevel) = @_; $self = {}; bless $self; my $FD = new IO::File; $FD->open( $filename, O_WRONLY | O_APPEND | O_CREAT, 0600 ) or warn "Unable to open log ($LOGFILE: $!"; $FD->autoflush(1); $self->{FD} = $FD; $self->{loglevel} = $loglevel; return $self; } sub log { my ( $self, $level, @msg ) = @_; chomp(@msg); # high numbers are less important. return if ( $level > $self->{loglevel} ); my $now = strftime "%F %T", localtime; $self->{FD}->printf( "%s (pid:%6i,level:%-2i) - %s\n", $now, $$, $level, join( '', @msg ), "\n" ); } sub close { my ($self) = @_; $self->{FD}->close(); } package DB; sub log_error { STDERR->print(@_, "\n"); } sub backtrace { my ($file, $line) = (__FILE__, __LINE__); my $msg = "@_"; chomp($msg); log_error($msg); log_error("backtrace:") if caller(0); my $pack = ''; my $i = 0; while (1) { @DB::args = (); my @caller = caller($i); last unless @caller; my ($npack, $nfile, $nline, $subroutine, $hasargs, $wantarray, $evaltext, $is_require) = @caller; my $trace = ''; $trace .= " [$file:$line] "; $trace .= $wantarray ? "\@ " : "\$ "; $trace .= "$subroutine "; $trace .= "\"$evaltext\" " if defined($evaltext); $trace .= "(".join(", ", map { (my $a = $_ || "") =~ s/\n/\\n/g; "\"$a\""; } @DB::args).")" if $hasargs; log_error($trace); $i++; $file = $nfile; $line = $nline; $pack = $npack; } log_error(" [$file:$line] ${pack}::"); } __END__ =back =head2 ~/.yample/dupdb Yamples database of message IDs. Yample uses this to supress dupicate messages (see dup() rules). =head2 ~/.yample/log Your own personal logfile. You might want to use logrotate or similar programs to make sure it does not grow to big. =head2 ~/.forward Usually, your mail server looks for a file in your home directory called ".forward". This file contains information how your mail server should deliver your mail. If you want Yample as your MDA your .forward should look like this: |/full/path/to/yample =head1 EXAMPLES # throw away virii head(^X-Infected:): ignore() # throw away spam with a score higher than 8 head(^X-Spam-Score: \d+\.\d+ \(\+{8,}\) # The rest of the spam, tagged by spamassassin head(^X-Spam-Flag: YES): maildir(.junk.spam) dup(): maildir(.junk.duplicates) # auto-sort lists - requires Mail::Listdetect list((.*)): maildir(.lists.$1) sender(@fjase.net) and subject(Backup report): maildir(.backup_reports) # catch-all perl(1): maildir() =head1 VERSION Yample 0.30 =head1 AUTHOR Per Andreas Buer =head1 PREREQUSITES Yamples needs the following perl modules. Please download from CPAN, Yamples home page or other sources. Mail::Internet Mail::Send Text::Balanced Yample also uses these modules - but they are in the Perl distribution so they should always be there. Pod::Usage POSIX Sys::Hostname IO::File IPC::Open2 =head1 BUGS Yample with Spamassassin, Mail::ListDetector and the other bells and whistles is quite heavy. Please report bugs and functionality requests to the author. Yample lacks (as of now) LMTP and IMAP support. Both should be fairly easy to implement. =head1 COPYRIGHT Copyright © 2003 Per Andreas Buer This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =head1 SEE ALSO Mail::Internet (3), Mail::SpamAssassin (3), Mail::ListDetector (3). =cut yample-0.30/README.txt0100755001554500155450000000166510001072123013451 0ustar perbuperbuWhat is Yample? A very simple mail sorting language. How do I install it? Yample is a MDA - Mail Delivery Agent. It get the mail from the mail server and puts it where it should be, either some mail-folder or your garbage can. Yample can be put whereever you want to. If you want all the users to be able to use it put it in /usr/local/bin or somewhere similar. In order for Yample to function it needs a few Perl modules. These are: * Mail::Internet * Mail::Send http://search.cpan.org/~markov/MailTools/ * MIME::Words http://search.cpan.org/~eryq/MIME-tools/ * Mail::ListDetector http://search.cpan.org/~mstevens/Mail-ListDetector/ * Text::Balanced http://search.cpan.org/~dconway/Text-Balanced/ * Mail::Spamassassin http://search.cpan.org/~jmason/Mail-SpamAssassin/ With Perl 5.6 or higher and these modules, everything should be ok. -- Per Andreas Buer $Id: README.txt,v 1.6 2004/01/13 22:32:04 perbu Exp $ yample-0.30/yample.10100600001554500155450000002616210001072123013310 0ustar perbuperbu.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.13 .\" .\" Standard preamble: .\" ======================================================================== .de Sh \" Subsection heading .br .if t .Sp .ne 5 .PP \fB\\$1\fR .PP .. .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. | will give a .\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to .\" do unbreakable dashes and therefore won't be available. \*(C` and \*(C' .\" expand to `' in nroff, nothing in troff, for use with C<>. .tr \(*W-|\(bv\*(Tr .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' 'br\} .\" .\" If the F register is turned on, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .if \nF \{\ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . nr % 0 . rr F .\} .\" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .hy 0 .if n .na .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "YAMPLE 1" .TH YAMPLE 1 "2004-01-13" "perl v5.8.2" "User Contributed Perl Documentation" .SH "NAME" Yample \- Yet Another Mail Processing Language. .SH "DESCRIPTION" .IX Header "DESCRIPTION" Yample is an \s-1MDA\s0 \- a mail delivery agent. It accepts a message via standard input and stores this message in a maildir or in a mbox. .PP Yample tries to incorporate the power of Perl and Mail::Internet, Mail::Spamassassin and the other Mail modules whilst maintaining an friendly syntax. Yample was written due to a personal conflict with Procmails syntax. .PP Look at the following lines, taken from \*(L"man procmailex\*(R"; .PP :0 c * ^From.*peter * ^Subject:.*compilers ! william@somewhere.edu .PP .Vb 2 \& :0 A \& petcompil .Ve .PP This can be implemented like this in Yample; .PP sender(peter) and subject(compilers) unseen resend(william@somewhere.edu) sender(peter) and subject(compilers) mbox(petcompil) .SH "OPTIONS" .IX Header "OPTIONS" .IP "\fB\-\-help\fR" 5 .IX Item "--help" Help! .IP "\fB\-\-mailbase " 5 .IX Item "--mailbase " This option is prepended to any destinations you have. Default is ~/Maildir/. .IP "\fB\-\-logfile\fR" 5 .IX Item "--logfile" Yamples logfile. Default is ~/.yample/log. .IP "\fB\-\-loglevel <0\-4\fR>" 5 .IX Item "--loglevel <0-4>" Loglevel. 4 \- Debug, 3 \- info, 2 \- warnings, 1 \- errors, 0 \- nothing. .IP "\fB\-\-spamassassin\fR" 5 .IX Item "--spamassassin" Load Mail::Spamassassin and run the mail through it. .IP "\fB\-\-spamc\fR" 5 .IX Item "--spamc" Run the message through spamc. Yample will look for spamc in the \f(CW$PATH\fR unless you set \fB\-\-spamc\-path\fR. .IP "\fB\-\-spamc\-path\fR /path/to/spamc" 5 .IX Item "--spamc-path /path/to/spamc" Where spamc resides. .IP "\fB\-\-dubdb " 5 .IX Item "--dubdb " The message id database \- used for duplicate suppression. .IP "\fB\-\-rules " 5 .IX Item "--rules " The rule file. .SH "FILES" .IX Header "FILES" .Sh "~/.yample/rules" .IX Subsection "~/.yample/rules" This file contains the rules which Yample uses to sort mail. Yample reads the mail from \s-1STDIN\s0 and then processes the rules, one by one. .PP The rules consists of two parts; condition(s) and target. There is an implicit if .. then .. else between every rule. Please see the examples futher down. .PP In the conditions which take a regular expression as a parameter you can use grouping to extract parts of the text and utilize this in the sorting. Like this: \*(L"subject((.*)) and rcpt(user@foo.org): reject(Your message with subject \f(CW$1\fR was rejected)\*(R". Cool, eh? .PP \&\s-1NOTE:\s0 We replace \*(L"/\*(R" and \*(L".\*(R" with \*(L"_\*(R" in grouped strings to make sure there won't be any funny business. .IP "Yample::Rules" 5 .IX Item "Yample::Rules" This package contains subroutines which handle the individual rules. The rules are transformed into perl code which will call these methods to decide what to do with the message. .IP "\fIdup()\fR" 5 .IX Item "dup()" Detects duplicates. .IP "\fIrcpt()\fR" 5 .IX Item "rcpt()" The rcpt rule matches against the To\- and Cc\-headers. .IP "\fIsender()\fR" 5 .IX Item "sender()" The sender rule matches against the From\-header. .IP "\fIsubject()\fR" 5 .IX Item "subject()" Matches on the subject of the message. .IP "\fIlist()\fR" 5 .IX Item "list()" If Yample can load Mail::Listdetect then \fIlist()\fR can be used to match against the name of the mailing list (unless the mailing list server is completely lame). .Sp You can use this rule like this: .Sp list((.*)): maildir(.lists.$1) .IP "\fIhead()\fR" 5 .IX Item "head()" Match against a arbitrary header. Note the caret (^) .Sp head(^X\-Spam\-Flag: \s-1YES\s0): maildir(.junk.spam) head(^X\-Infected:): maildir(.junk.virii) .IP "\fIspam()\fR" 5 .IX Item "spam()" If Yample loads Spamassassin (and runs the message through it) you can use \fIspam()\fR to determine the status of the message. .IP "\fIperl()\fR" 5 .IX Item "perl()" Run arbitrary perl code. Unless you are some sort of pervert you would not use this for anything but testing and debugging Yample. .IP "Yample::Actions" 5 .IX Item "Yample::Actions" Action dispatcher class. All the targets are defined here. .IP "\fImaildir()\fR" 5 .IX Item "maildir()" Stores the message in a UW-style maildir more or less as defined per \&\s-1RFCXXXX\s0. .IP "\fImbox()\fR" 5 .IX Item "mbox()" Delivers mail to a standard Unix mailbox. .Sp Parameters: The mailbox where the message is to be delivered. .IP "\fIresend()\fR" 5 .IX Item "resend()" Parameters: Where the message is to be forwarded. .IP "\fIreject()\fR" 5 .IX Item "reject()" Reject the message. This normally forces your mail server to create a bounce and mail this to the original sender. .Sp Parameters: Error message. This message will probably be included in the bounce generated. .IP "\fIignore()\fR" 5 .IX Item "ignore()" Ignore the message silently. .Sp Parameters: none .IP "\fIreply()\fR" 5 .IX Item "reply()" Reply to the message. .Sp Parameters: The body of the reply. .IP "\fIpipe()\fR" 5 .IX Item "pipe()" Parameters: The command which is message is to be piped into. Executed through \*(L"/bin/sh \-c\*(R". .Sh "~/.yample/dupdb" .IX Subsection "~/.yample/dupdb" Yamples database of message IDs. Yample uses this to supress dupicate messages (see \fIdup()\fR rules). .Sh "~/.yample/log" .IX Subsection "~/.yample/log" Your own personal logfile. You might want to use logrotate or similar programs to make sure it does not grow to big. .Sh "~/.forward" .IX Subsection "~/.forward" Usually, your mail server looks for a file in your home directory called \&\*(L".forward\*(R". This file contains information how your mail server should deliver your mail. If you want Yample as your \s-1MDA\s0 your .forward should look like this: |/full/path/to/yample .SH "EXAMPLES" .IX Header "EXAMPLES" # throw away virii head(^X\-Infected:): \fIignore()\fR .PP # throw away spam with a score higher than 8 head(^X\-Spam\-Score: \ed+\e.\ed+ \e(\e+{8,}\e) .PP # The rest of the spam, tagged by spamassassin head(^X\-Spam\-Flag: \s-1YES\s0): maildir(.junk.spam) .PP \&\fIdup()\fR: maildir(.junk.duplicates) .PP # auto-sort lists \- requires Mail::Listdetect list((.*)): maildir(.lists.$1) .PP sender(@fjase.net) and subject(Backup report): maildir(.backup_reports) .PP # catch-all .PP \&\fIperl\fR\|(1): \fImaildir()\fR .SH "VERSION" .IX Header "VERSION" Yample 0.30 .SH "AUTHOR" .IX Header "AUTHOR" Per Andreas Buer .SH "PREREQUSITES" .IX Header "PREREQUSITES" Yamples needs the following perl modules. Please download from \s-1CPAN\s0, Yamples home page or other sources. .PP Mail::Internet Mail::Send Text::Balanced .PP Yample also uses these modules \- but they are in the Perl distribution so they should always be there. .PP Pod::Usage \&\s-1POSIX\s0 Sys::Hostname IO::File IPC::Open2 .SH "BUGS" .IX Header "BUGS" Yample with Spamassassin, Mail::ListDetector and the other bells and whistles is quite heavy. .PP Please report bugs and functionality requests to the author. .PP Yample lacks (as of now) \s-1LMTP\s0 and \s-1IMAP\s0 support. Both should be fairly easy to implement. .SH "COPYRIGHT" .IX Header "COPYRIGHT" Copyright © 2003 Per Andreas Buer .PP This is free software; see the source for copying conditions. There is \&\s-1NO\s0 warranty; not even for \s-1MERCHANTABILITY\s0 or \s-1FITNESS\s0 \s-1FOR\s0 A \s-1PARTICULAR\s0 \&\s-1PURPOSE\s0. .SH "SEE ALSO" .IX Header "SEE ALSO" Mail::Internet (3), Mail::SpamAssassin (3), Mail::ListDetector (3).