#!/usr/bin/perl -w
#
# sprobe --crb3 14may03/05feb07
#
# --crb3 14may03        first working version.
# --crb3 13jun03        add -b switch just in case.
# --crb3 05Feb07        added lockfile
#
# spamprobe script, to be tailended onto getmail's crontab entry per
# scheme#1:
#
# */5 * * * * /usr/local/bin/getmail;\
#  /usr/local/bin/sprobe;/usr/local/bin/sprobe /var/vpopmail/users
#
# running it twice in this way catches real-users whose accounts are
# not symlinked into vpopmail's virtuals, and virtual users who have
# no system accounts. there's overlap on every symlinked account (where
# /var/vpopmail/users/USER/Maildir/ is a symlink to /home/USER/Maildir/),
# but that's benign.
#
# unchecked mail is found in $basedir/$user/Maildir/chk, and is moved into
# /new if good, /qrm if spam. (qrm is a Q-signal whose meaning is "manmade
# interference", the modern implication being that it's deliberate
# -- jamming, etc.)
#
# in this mailsystem, spam is held in /qrm until it's hand-checked for
# false-positives (with allmailscan -m qrm |less), then it's moved to dummy
# user sp2m's /qrt.  false positives are moved into user's /new, and copied
# into dummy user sp2m's /new for spamprobe "good" retraining with
# sprobe_learn. false negatives are moved into sp2m's /qrm for spamprobe
# "spam" retraining with sprobe_learn, then into sp2m's /qrt (Q-signal: stop
# transmitting) to await a batch run of abuse@ISP complaint-mail generation.
# that could just as easily be a pickup point for a cron'd spamcop burst.
#
$safety=0;      # if true, go through the motions but don't touch the mail
$chatty=0;      # if true, be verbose... very verbose.

$spamprobe="/usr/local/bin/spamprobe";
$basedir="/home";       # default. can be /var/vpopmail/users, etc.

$dolock=1;
$lock="/var/local/qrm/sprobe.lock";

if($dolock){
  if(-e $lock){
    loggit("found lockfile; going away.");
    exit(1);
  }
  `touch $lock`;
}

$logger="/usr/bin/logger";              # this works in linux
$myname=$0;                             # what we were invoked as
$myname =~ s/^.+\/// if(index($myname,'/')>-1);
$loglvl="alert";        # log in /var/log/maillog at qmail's verbosity

$args="_none_";
if(defined($ARGV[0])){          # pack all the args together for reporting
  $args=join(' ',(@ARGV));
  $args =~ s/\-//g;
}
loggit("run with args $args");

while(defined($ARGV[0]) and index($ARGV[0],'-')==0){
  $arg=shift(@ARGV);                    # get any the switches
  $key=lc(substr($arg,1,1));            # just 'verbose' and 'basedir'
  substr($arg,0,2)="";
  if($key eq "v"){                      # verbose
    $chatty ^= 1;
  }elsif($key eq "b"){                  # basedir: where the user accounts are
    $basedir=$arg;
  }else{
    warn "$0: unrecognized option -$key $arg\n";
  }
}
print "$0: run with args $args\n" if $chatty;

$basedir = $ARGV[0] if defined $ARGV[0];

chdir $basedir;
for(<*>){
  next unless -d;
  $hdir = $_;           # iterate through all the usernames shown
  print "$0: checking $basedir/$hdir/Maildir/chk...\n" if $chatty;

  next unless -d "$basedir/$hdir/Maildir/chk";  # where unchecked mail goes
  next unless -d "$basedir/$hdir/Maildir/qrm";  # where spam is shunted into
  chdir "$basedir/$hdir/Maildir/chk";
  for(<*>){
    next unless -f;
    $numail=$_;
    $ret = `$spamprobe receive $numail`;        # get a text judgement
    print "ret $ret for $numail.\n" if $chatty;
    if($safety){        # go through the motions but don't touch the mail
      print "mv $numail ../".(index($ret,"SPAM")>-1 ? "qrm" : "new")."\n";
    }else{
      if(index($ret,"SPAM")>-1){
        loggit("$ret, $hdir qrm: $numail");
        print "$ret, qrm: $numail\n" if $chatty;
        `mv $numail ../qrm`;
      }else{
        loggit("$ret, $hdir new: $numail");
        print "$ret, new: $numail\n" if $chatty;
        `mv $numail ../new`;
      }
    }
  }
  chdir $basedir;               # back down for next one
}

sub loggit {
  my $logmsg = shift(@_);

  my $cms = "$logger -p mail.$loglvl -t $myname \"$logmsg\"";
  CORE::system($cms);
}

`rm -f $lock` if $dolock;


 Grab a
gzipped
copy
here
 
Syntax highlighting using Syntax::Highlight::Engine::Kate