@rem = '-*- Perl -*-';
@rem = '
@echo off
c:\perl\bin\perl f:/local/bin/checkmail.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
';
# This perl script can be used to pre-scan your POP mailbox on your ISP to
# delete any mail with objectionable headers before you go to the trouble of
# downloading the whole message. It only reads the headers, and can be
# customized to look for any patterns of interest.

# To use it you need the latest and greatest perl version 5.004 (soon to be
# released) and the Net::POP3 and Mail::Header optional modules installed.
# (Instructions for how to get perl won't fit here - see www.perl.com for
# lots of good info). You will need to edit the line after @echo off (above)
# to contain the full path name of perl and where you put this script.

# You also need to customize a lot of stuff in this script, including (but
# probably not limted to):
#
# * The lines up at the top with the absolute path names of perl and this
#   script in them.
#
# * The mail server and password information below.
#
# * The regular expressions and algorithms used to actually check the
#   mail headers for what you want to classify as spam and delete.

use Net::POP3;
use Mail::Header;

# Configure the interesting parameters here
#
$postoffice=''; # fill in this with something like postoffice.isp.com
$user=''; # fill this in with your mail user name
$password=''; # fill this in with your mail server password
$verbose=1;

# Call scan_header with the Mail::Header object as the first argument and
# the message size as the 2nd arg. If it returns a value, then that value is
# the reason the mail should be deleted. If it returns undef, the mail is
# left intact;
#
# NOTE: Edit this routine to put in your very own reasons for deleteing
#       mail.
#
sub scan_header {
   my $head, @rec, $r, @tags, $t, $msgsize;
   ($head, $msgsize) = @_;
   if ($msgsize > 100000) {
      return "Message bigger than 100K, probable mailbomb";
   }
   @tags = $head->tags();
   $goodguy = 0;
   foreach $t (@tags) {
      if ($t=~/^X-Advertisement/i) {
         return "Found X-Advertisement header";
      }
      if ($goodguy == 0) {

         # If this mail isn't explicity being sent to me or being sent on
         # one of the mailing lists I know about or forwarded from work, etc
         # then it is highly suspicious...

         if (($t=~/From/i) || ($t=~/To/i) || ($t=~/Cc/i)) {
            @rec = $head->get($t);
            foreach $r (@rec) {
               # Fill in tests to check for your mail address, the
               # mail addresses associated with any mailing lists you
               # are on, etc. These are only examples...
               if (($r=~/Tom\.Horsley\@worldnet\.att\.net/i) ||
                   ($r=~/kermit\@columbia\.edu/i) ||
                   ($r=~/fdc\@watsun\.cc\.columbia\.edu/i) ||
                   ($r=~/ntemacs\-users\@cs\.washington\.edu/i)) {
                  $goodguy = 1;
               }
            }
         }
      }

      # If any of these standard goons show up in any headers, trash the
      # sucker...

      if (($t=~/From/i) || ($t=~/Received/i) || ($t=~/Reply/i) ||
          ($t=~/Sender/i) || ($t=~/^X-/) || ($t=~/^To/i) ||
          ($t=~/Comments/i)) {
         @rec = $head->get($t);
         foreach $r (@rec) {
            # As above, replace any of these (or just add more) with
            # your own list of bad guys.
            if ($r=~/cyberpromo\.com/i) {
               return "Found cyberpromo.com in $t header";
            }
            if ($r=~/savetrees\.com/i) {
               return "Found savetrees\.com in $t header";
            }
            if ($r=~/earthlink\.net/i) {
               return "Found earthlink\.net in $t header";
            }
            if ($r=~/\@shoppingplanet\.com/i) {
               return "Found \@shoppingplanet.com in $t header";
            }
         }
      }
   }

   # These subjects were repeated over and over at one time, so I stuck
   # in an explicit check for them...

   @rec = $head->get('Subject');
   foreach $r (@rec) {
      if ($r=~/Free Fax/i) {
         return "Found \"Free Fax\" in Subject header";
      }
      if ($r=~/credit limit/i) {
         return "Found \"credit limit\" in Subject header";
      }
   }
   if ($goodguy == 0) {
      return "No good guys in any From: To: or Cc: header";
   }
   return undef;
}

# Call delete_spam with postoffice, user, password to be scanned.
#
sub delete_spam {
   my $postoffice, $user, $password, $pop, $msgcount, $i, $head, $reason,
      $subj, $from, $delcount;
   ($postoffice, $user, $password) = @_;
   $pop = Net::POP3->new($postoffice) ;

   if (! defined($pop)) {
      die "Net::POP3::new failed for postoffice $postoffice\n";
   }

   $msgcount = $pop->login($user, $password);
   if (! defined($msgcount)) {
      die "Cannot login to mailbox at $postoffice\n";
   }
   ($msgcount, $msgsize) = $pop->popstat();
   $delcount = 0;
   for ($i = 1; $i <= $msgcount; ++$i) {
      $msgsize = $pop->list($i);
      $head = new Mail::Header $pop->top($i, 0);
      if ($reason = &scan_header($head, $msgsize)) {
         if ($verbose) {
            $subj = $head->get('Subject');
            $from = $head->get('From');
            if (! defined($subj)) {
               $subj = "<no subject>\n";
            }
            if (! defined($from)) {
               $from = "<no from address>\n";
            }
            print "Deleteing mail:\n";
            print "  From: $from";
            print "  Subject: $subj";
            print "  Reason: $reason\n";
         }
         $pop->delete($i);
         ++$delcount;
      }
   }

   $pop->quit();
   if ($verbose && ($msgcount > 0)) {
      print "Looked at $msgcount message(s), Deleted $delcount\n";
   }
}

# Actually do everything.
#
&delete_spam($postoffice, $user, $password);

__END__
:endofperl