maps/bin/maps

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 =head1 NAME $RCSfile: maps,v $
   6
   7 This script filters mail based on the files nulllist, blacklist and whitelist.
   8 Input is an email message. This script extracts the From line and then parses
   9 the email address. If the email is from a sender who should be /dev/null'ed
  10 (e.g. bounce messages from mail daemons) the message will be discarded. If the
  11 sender is on the blacklist then a message is sent back informing the sender that
  12 he's been blacklisted. If the sender is on the white list then the email is
  13 appended to the mail drop file. Otherwise a message is sent back informing the
  14 sender that in order to successfully send email the sender must register for the
  15 permission to do so, along with a URL that allows the sender to sign up.
  16
  17 =head1 VERSION
  18
  19 =over
  20
  21 =item Author
  22
  23 Andrew DeFaria <Andrew@DeFaria.com>
  24
  25 =item Revision
  26
  27 $Revision: 1.1 $
  28
  29 =item Created:
  30
  31 Fri Nov 29 14:17:21  2002
  32
  33 =item Modified:
  34
  35 $Date: 2013/06/12 14:05:47 $
  36
  37 =back
  38
  39 =head1 SYNOPSIS
  40
  41  Usage maps: [-u|ser <username>] [-ve|rbose] [-deb|ug] [-e|xecute]
  42
  43  Where:
  44    -u|ser <username>: Set context to this username
  45
  46    -v|erbose:         Be verbose
  47    -de|bug:           Output debug messages
  48
  49    -[no]e|xecute:     Set execute mode.
  50
  51 # (c) Copyright 2000-2021, Andrew@DeFaria.com, all rights reserved.
  52
  53 =cut
  54
  55 use strict;
  56 use warnings;
  57
  58 use Getopt::Long;
  59 use Email::Valid;
  60 use FindBin;
  61 use File::Temp qw (tempfile);
  62 use Net::Domain qw (hostdomain);
  63
  64 use lib "$FindBin::Bin/../lib";
  65 use lib "$FindBin::Bin/../../lib";
  66
  67 use MAPS;
  68 use MAPSLog;
  69
  70 use Display;
  71 use Utils;
  72
  73 my $verbose   = 0;
  74 my $execute   = 1;
  75 my $userid    = $ENV{USER};
  76
  77 # For some reason I'm not parsing messages correctly but it only seems to
  78 # happen when the message is piped in from the MTA. This routine will
  79 # temporarily save the messages in a file.
  80 sub SaveStdin() {
  81   # Generate tempfile
  82   my $msgfile = tempfile ();
  83
  84   # Read STDIN and write it out to the tempfile
  85   while (<STDIN>) {
  86     print $msgfile $_;
  87   } # while
  88
  89   # Seek to the start of the file (Note if we closed it, it would be deleted)
  90   seek $msgfile, 0, 0;
  91
  92   # Return the filehandle
  93   return $msgfile;
  94 } # SaveStdin
  95
  96 sub ValidDomainUser($) {
  97   my ($sender) = @_;
  98
  99   my ($username, $domainname);
 100
 101   if ($sender =~ /(.*)\@(.*)/) {
 102     $username   = $1;
 103     $domainname = $2;
 104   } else {
 105     return 1;
 106   } # if
 107
 108   return 1 if $domainname ne hostdomain;
 109
 110   # Let BICE email come through
 111   return 1 if $username eq "bice";
 112
 113   my $uid = getpwnam $username;
 114
 115   return defined $uid ? 1 : 0;
 116 } # ValidDomainUser
 117
 118 sub ProcessMsgs ($$$) {
 119   my ($msgfile, $username, $user_email) = @_;
 120
 121   return unless $execute;
 122
 123   while (!eof *$msgfile) {
 124     my ($sender, $sender_long, $reply_to, $subject, $data) = ReadMsg (*$msgfile);
 125
 126     my ($onlist, $rule, $sequence, $hit_count);
 127
 128     # Algorithm change: We now first check to see if the sender is not found
 129     # in the message and skip it if so. Then we handle if we are the sender
 130     # and that the from address is formatted properly. Spammers often use
 131     # the senders email address (i.e. andrew@defaria.com) as their from address
 132     # so we check "Andrew DeFaria <Andrew@DeFaria.com>", which they have never
 133     # forged. This catches a lot of spam actually.
 134     #
 135     # Next we check to see if the sender is on our whitelist. If so then we let
 136     # them in. This allows us to say whitelist josephrosenberg@hotmail.com while
 137     # still nulllisting all of the other hotmail.com spammers.
 138     #
 139     # Next we process blacklisted people as they are also of high priority.
 140     #
 141     # Then we process nulllist people.
 142     #
 143     # Finally, we handle return processing
 144
 145     # Discard any email with an invalid email address
 146     next unless Email::Valid->address($sender);
 147
 148     if ($sender eq $user_email and
 149             (lc ($sender_long) !~ lc ("\"$username\" <$user_email>") and
 150              lc ($sender_long) !~ lc ("$username <$user_email>"))) {
 151       verbose "Nulllisting message from sender ($sender_long) pretending to be $user_email";
 152       Nulllist $sender;
 153       next;
 154     } # if
 155
 156     # Check whitelist:
 157     ($onlist, $rule, $sequence, $hit_count) = OnWhitelist $sender;
 158
 159     if ($onlist) {
 160       if (ValidDomainUser $sender) {
 161         verbose "Whitelisting $sender";
 162         Whitelist $sender, $data, $sequence, $hit_count;
 163       } else {
 164         verbose "Sender from this domain but user not found";
 165         Nulllist $sender;
 166       } # if
 167
 168       next;
 169     } # if
 170
 171     # Check blacklist:
 172     ($onlist, $rule, $sequence, $hit_count) = OnBlacklist $sender;
 173
 174     if ($onlist) {
 175       verbose "Blacklisting $sender";
 176
 177       Blacklist(
 178         userid    => $userid,
 179         sender    => $sender,
 180         sequence  => $sequence,
 181         hit_count => $hit_count,
 182         data      => $data,
 183       );
 184
 185       next;
 186     } # if
 187
 188     # Check nulllist:
 189     ($onlist, $rule, $sequence, $hit_count) = OnNulllist $sender;
 190
 191     if ($onlist) {
 192       verbose "Nulllisting $sender";
 193       Nulllist $sender, $sequence, $hit_count;
 194       next;
 195     } # if
 196
 197     # Return processing:
 198     verbose "Returning message from $sender";
 199     ReturnMsg(
 200       userid   => $userid,
 201       sender   => $sender,
 202       reply_to => $reply_to,
 203       subject  => $subject,
 204       data     => $data,
 205     );
 206   } # while
 207 } # ProcessMsgs
 208
 209 # Main
 210 GetOptions(
 211   'user=s'      => \$userid,
 212   'verbose'     => sub { set_verbose },
 213   'debug'       => sub { set_debug },
 214   'execute!'    => \$execute,
 215 ) || Usage;
 216
 217 my $msgfile;
 218
 219 if ($ARGV[0] and $ARGV[0] ne "") {
 220   open $msgfile, '<', $ARGV[0];
 221
 222   unless ($msgfile) {
 223     Error "Unable to open file ($ARGV[0]): $!\n";
 224     exit 1;
 225   } # if
 226 } else {
 227   $msgfile = SaveStdin;
 228 } # if
 229
 230 verbose "Starting MAPS....";
 231
 232 my %userOptions = SetContext $userid
 233   or die "$userid is not a registered MAPS user\n";
 234
 235 ProcessMsgs $msgfile, $userOptions{name}, $userOptions{email};
 236
 237 exit 0;