Fixed but when attempting to nulllist people pretending to be me
[clearscm.git] / 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 ProcessMsgs ($$$) {
126   my ($msgfile, $username, $user_email) = @_;
127
128   return unless $opts{execute};
129
130   while (!eof $msgfile) {
131     my ($sender, $sender_long, $reply_to, $subject, $data) = ReadMsg ($msgfile);
132
133     my ($onlist, $rule, $sequence, $hit_count);
134
135     # Algorithm change: We now first check to see if the sender is not found
136     # in the message and skip it if so. Then we handle if we are the sender
137     # and that the from address is formatted properly. Spammers often use 
138     # the senders email address (i.e. andrew@defaria.com) as their from address
139     # so we check "Andrew DeFaria <Andrew@DeFaria.com>", which they have never
140     # forged. This catches a lot of spam actually.
141     #
142     # Next we check to see if the sender is on our whitelist. If so then we let
143     # them in. This allows us to say whitelist josephrosenberg@hotmail.com while
144     # still nulllisting all of the other hotmail.com spammers.
145     #
146     # Next we process blacklisted people as they are also of high priority.
147     #
148     # Then we process nulllist people.
149     #
150     # Finally, we handle return processing
151
152     # Discard any email with an invalid email address
153     next unless Email::Valid->address($sender);
154
155     if ($sender eq $user_email and
156             (lc ($sender_long) !~ lc ("\"$username\" <$user_email>") and
157              lc ($sender_long) !~ lc ("$username <$user_email>"))) {
158       $log->msg("Nulllisting message from sender ($sender_long) pretending to be $user_email");
159       Nulllist $sender;
160       next;
161     } # if
162
163     # Check whitelist:
164     ($onlist, $rule, $sequence, $hit_count) = OnWhitelist $sender;
165
166     if ($onlist) {
167       if (ValidDomainUser $sender) {
168         $log->msg("Whitelisting $sender");
169
170         Whitelist $sender, $data, $sequence, $hit_count;
171       } else {
172         $log->msg("Sender from this domain but user not found");
173
174         Nulllist $sender;
175       } # if
176
177       next;
178     } # if
179
180     # Check blacklist:
181     ($onlist, $rule, $sequence, $hit_count) = OnBlacklist $sender;
182
183     if ($onlist) {
184       $log->msg("Blacklisting $sender");
185
186       Blacklist(
187         userid    => $userid,
188         sender    => $sender,
189         sequence  => $sequence,
190         hit_count => $hit_count,
191         data      => $data,
192       );
193
194       next;
195     } # if 
196
197     # Check nulllist:
198     ($onlist, $rule, $sequence, $hit_count) = OnNulllist $sender;
199
200     if ($onlist) {
201       $log->msg("Nulllisting $sender");
202       Nulllist $sender, $sequence, $hit_count;
203       next;
204     } # if
205
206     # Return processing:
207     $log->msg("Returning message from $sender");
208
209     ReturnMsg(
210       userid   => $userid,
211       sender   => $sender,
212       reply_to => $reply_to,
213       subject  => $subject,
214       data     => $data,
215     );
216   } # while
217 } # ProcessMsgs
218
219 # Main
220 GetOptions(
221   \%opts,
222   'user=s',
223   'verbose',
224   'debug',
225   'execute!',
226 ) or pod2usage;
227
228 $log = Logger->new(
229   path        => '/var/local/log',
230   timestamped => 'yes',
231   append      => 'yes',
232 );
233
234 my $msgfile;
235
236 if ($ARGV[0] and $ARGV[0] ne "") {
237   open $msgfile, '<', $ARGV[0];
238
239   unless ($msgfile) {
240     $log->err("Unable to open file ($ARGV[0]): $!");
241     exit 1;
242   } # if
243 } else {
244   $msgfile = SaveStdin;
245 } # if 
246
247 # Get user
248 FindUser(userid => $userid);
249
250 my $user = GetUser;
251
252 ProcessMsgs $msgfile, $user->{name}, lc $user->{email};
253
254 exit 0;