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