4f960c4424054c5efafced4039a13f3f94a52c8a
[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
51 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
52
53 =cut 
54
55 use strict;
56 use warnings;
57
58 use Getopt::Long;
59 use FindBin;
60 use File::Temp qw (tempfile);
61 use Net::Domain qw (hostdomain);
62
63 use lib "$FindBin::Bin/../lib", '/opt/clearscm/lib';
64
65 use MAPS;
66 use MAPSLog;
67
68 use Display;
69 use Utils;
70
71 my $verbose    = 0;
72 my $execute    = 1;
73 my $userid     = $ENV{USER};
74
75 my $logpath    = "$FindBin::Bin/../log";
76 my $logfile    = "$logpath/debug.log";
77 my $forwardto = $ENV{MAPS_FORWARDTO} || 'adefaria@gmail.com';
78
79 # For some reason I'm not parsing messages correctly but it only seems to
80 # happen when the message is piped in from the MTA. This routine will
81 # temporarily save the messages in a file.
82 sub SaveStdin () {
83   # Generate tempfile
84   my $msgfile = tempfile ();
85
86   # Read STDIN and write it out to the tempfile
87   while (<STDIN>) {
88     print $msgfile $_;
89   } # while
90
91   # Seek to the start of the file (Note if we closed it, it would be deleted)
92   seek $msgfile, 0, 0;
93
94   # Return the filehandle
95   return $msgfile;
96 } # SaveStdin
97
98 sub ValidDomainUser ($) {
99   my ($sender) = @_;
100
101   my ($username, $domainname);
102
103   if ($sender =~ /(.*)\@(.*)/) {
104     $username   = $1;
105     $domainname = $2;
106   } else {
107     return 1;
108   } # if
109
110   return 1 if $domainname ne hostdomain;
111
112   # Let BICE email come through
113   return 1 if $username eq "bice";
114
115   my $uid = getpwnam $username;
116
117   return defined $uid ? 1 : 0;
118 } # ValidDomainUser
119
120 sub ProcessMsgs ($$$) {
121   my ($msgfile, $username, $user_email) = @_;
122
123   return
124     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     # Special sender handling: 
160     if ($sender !~ /.+\@.+/) {
161       verbose "Sender not found in message or invalid";
162       next;
163     } # if
164
165     if ($sender eq $user_email and
166             (lc ($sender_long) !~ lc ("\"$username\" <$user_email>") and
167              lc ($sender_long) !~ lc ("$username <$user_email>"))) {
168       verbose "Nulllisting message from sender ($sender_long) pretending to be $user_email";
169       Nulllist $sender;
170       next;
171     } # if
172
173     # Check whitelist:
174     ($onlist, $rule, $sequence, $hit_count) = OnWhitelist $sender;
175
176     if ($onlist) {
177       if (ValidDomainUser $sender) {
178         verbose "Whitelisting $sender";
179         Whitelist $sender, $data, $sequence, $hit_count;
180       } else {
181         verbose "Sender from this domain but user not found";
182         Nulllist $sender;
183       } # if
184
185       next;
186     } # if
187
188     # Check blacklist:
189     ($onlist, $rule, $sequence, $hit_count) = OnBlacklist $sender;
190
191     if ($onlist) {
192       verbose "Blacklisting $sender";
193       my @msg = split /\n/, $data;
194
195       Blacklist $sender, $sequence, $hit_count, @msg;
196       next;
197     } # if 
198
199     # Check nulllist:
200     ($onlist, $rule, $sequence, $hit_count) = OnNulllist $sender;
201
202     if ($onlist) {
203       verbose "Nulllisting $sender";
204       Nulllist $sender, $sequence, $hit_count;
205       next;
206     } # if
207
208     # Return processing:
209     verbose "Returning message from $sender";
210     ReturnMsg $sender, $reply_to, $subject, $data;
211   } # while
212 } # ProcessMsgs
213
214 # Main
215 GetOptions (
216   'user=s'      => \$userid,
217   'verbose'     => sub { set_verbose },
218   'debug'       => sub { set_debug },
219   'execute!'    => \$execute,
220   'forwardto=s' => \$forwardto
221 ) || Usage;
222
223 my $msgfile;
224
225 if ($ARGV[0] and $ARGV[0] ne "") {
226   open $msgfile, $ARGV[0];
227
228   if (!$msgfile) {
229     Error "Unable to open file ($ARGV[0]): $!\n";
230     exit 1;
231   } # if
232 } else {
233   $msgfile = SaveStdin;
234 } # if 
235
236 verbose "Starting MAPS....";
237
238 my ($username, $user_email) = SetContext $userid
239   or die "$userid is not a registered MAPS user\n";
240
241 ProcessMsgs $msgfile, $username, $user_email;
242
243 exit 0;