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", "$FindBin::Bin/../../lib";
  65
  66 use MAPS;
  67 use MAPSLog;
  68
  69 use Display;
  70 use Utils;
  71
  72 my $verbose   = 0;
  73 my $execute   = 1;
  74 my $userid    = $ENV{USER};
  75
  76 my $logpath   = "$FindBin::Bin/../log";
  77 my $logfile   = "$logpath/debug.log";
  78 my $forwardto = $ENV{MAPS_FORWARDTO} || 'adefaria@gmail.com';
  79
  80 # For some reason I'm not parsing messages correctly but it only seems to
  81 # happen when the message is piped in from the MTA. This routine will
  82 # temporarily save the messages in a file.
  83 sub SaveStdin() {
  84   # Generate tempfile
  85   my $msgfile = tempfile ();
  86
  87   # Read STDIN and write it out to the tempfile
  88   while (<STDIN>) {
  89     print $msgfile $_;
  90   } # while
  91
  92   # Seek to the start of the file (Note if we closed it, it would be deleted)
  93   seek $msgfile, 0, 0;
  94
  95   # Return the filehandle
  96   return $msgfile;
  97 } # SaveStdin
  98
  99 sub ValidDomainUser($) {
 100   my ($sender) = @_;
 101
 102   my ($username, $domainname);
 103
 104   if ($sender =~ /(.*)\@(.*)/) {
 105     $username   = $1;
 106     $domainname = $2;
 107   } else {
 108     return 1;
 109   } # if
 110
 111   return 1 if $domainname ne hostdomain;
 112
 113   # Let BICE email come through
 114   return 1 if $username eq "bice";
 115
 116   my $uid = getpwnam $username;
 117
 118   return defined $uid ? 1 : 0;
 119 } # ValidDomainUser
 120
 121 sub ProcessMsgs ($$$) {
 122   my ($msgfile, $username, $user_email) = @_;
 123
 124   return unless $execute;
 125
 126   while (!eof *$msgfile) {
 127     my ($sender, $sender_long, $reply_to, $subject, $data) = ReadMsg (*$msgfile);
 128
 129     #if ($forwardto) {
 130       # Forward a copy
 131       #open my $mail, '|', "/usr/lib/sendmail $forwardto"
 132         #or die "Unable to open pipe to sendmail - $!";
 133
 134       #print $mail "$data\n";
 135
 136       #close $mail
 137         #or die "Unable to forward email to $forwardto - $!";
 138     #} # if
 139
 140     my ($onlist, $rule, $sequence, $hit_count);
 141
 142     # Algorithm change: We now first check to see if the sender is not found
 143     # in the message and skip it if so. Then we handle if we are the sender
 144     # and that the from address is formatted properly. Spammers often use
 145     # the senders email address (i.e. andrew@defaria.com) as their from address
 146     # so we check "Andrew DeFaria <Andrew@DeFaria.com>", which they have never
 147     # forged. This catches a lot of spam actually.
 148     #
 149     # Next we check to see if the sender is on our whitelist. If so then we let
 150     # them in. This allows us to say whitelist josephrosenberg@hotmail.com while
 151     # still nulllisting all of the other hotmail.com spammers.
 152     #
 153     # Next we process blacklisted people as they are also of high priority.
 154     #
 155     # Then we process nulllist people.
 156     #
 157     # Finally, we handle return processing
 158
 159     # Discard any email with an invalid email address
 160     next unless Email::Valid->address($sender);
 161
 162     if ($sender eq $user_email and
 163             (lc ($sender_long) !~ lc ("\"$username\" <$user_email>") and
 164              lc ($sender_long) !~ lc ("$username <$user_email>"))) {
 165       verbose "Nulllisting message from sender ($sender_long) pretending to be $user_email";
 166       Nulllist $sender;
 167       next;
 168     } # if
 169
 170     # Check whitelist:
 171     ($onlist, $rule, $sequence, $hit_count) = OnWhitelist $sender;
 172
 173     if ($onlist) {
 174       if (ValidDomainUser $sender) {
 175         verbose "Whitelisting $sender";
 176         Whitelist $sender, $data, $sequence, $hit_count;
 177       } else {
 178         verbose "Sender from this domain but user not found";
 179         Nulllist $sender;
 180       } # if
 181
 182       next;
 183     } # if
 184
 185     # Check blacklist:
 186     ($onlist, $rule, $sequence, $hit_count) = OnBlacklist $sender;
 187
 188     if ($onlist) {
 189       verbose "Blacklisting $sender";
 190
 191       Blacklist(
 192         userid    => $userid,
 193         sender    => $sender,
 194         sequence  => $sequence,
 195         hit_count => $hit_count,
 196         data      => $data,
 197       );
 198
 199       next;
 200     } # if
 201
 202     # Check nulllist:
 203     ($onlist, $rule, $sequence, $hit_count) = OnNulllist $sender;
 204
 205     if ($onlist) {
 206       verbose "Nulllisting $sender";
 207       Nulllist $sender, $sequence, $hit_count;
 208       next;
 209     } # if
 210
 211     # Return processing:
 212     verbose "Returning message from $sender";
 213     ReturnMsg(
 214       userid   => $userid,
 215       sender   => $sender,
 216       reply_to => $reply_to,
 217       subject  => $subject,
 218       data     => $data,
 219     );
 220   } # while
 221 } # ProcessMsgs
 222
 223 # Main
 224 GetOptions(
 225   'user=s'      => \$userid,
 226   'verbose'     => sub { set_verbose },
 227   'debug'       => sub { set_debug },
 228   'execute!'    => \$execute,
 229   'forwardto=s' => \$forwardto
 230 ) || Usage;
 231
 232 my $msgfile;
 233
 234 if ($ARGV[0] and $ARGV[0] ne "") {
 235   open $msgfile, '<', $ARGV[0];
 236
 237   unless ($msgfile) {
 238     Error "Unable to open file ($ARGV[0]): $!\n";
 239     exit 1;
 240   } # if
 241 } else {
 242   $msgfile = SaveStdin;
 243 } # if
 244
 245 verbose "Starting MAPS....";
 246
 247 my %userOptions = SetContext $userid
 248   or die "$userid is not a registered MAPS user\n";
 249
 250 ProcessMsgs $msgfile, $userOptions{name}, $userOptions{email};
 251
 252 exit 0;