2 ################################################################################
4 # File: $RCSfile: checkaddress.cgi,v $
5 # Revision: $Revision: 1.1 $
6 # Description: Check an email address
7 # Author: Andrew@DeFaria.com
8 # Created: Mon Jan 16 20:25:32 PST 2006
9 # Modified: $Date: 2013/06/12 14:05:47 $
12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
14 ################################################################################
19 local $0 = $FindBin::Script;
21 use lib "$FindBin::Bin/../lib";
22 use lib "$FindBin::Bin/../../lib";
26 use CGI qw(:standard);
28 # Get MAPSUser from cookie
32 $userid = param 'user';
34 $userid = cookie 'MAPSUser';
37 $userid //= $ENV{USER};
39 my $sender = param 'sender';
42 my ($list, $email_on_file, $rec) = @_;
44 my $next = $rec->{sequence} - 1;
46 $rule .= $rec->{pattern} || '';
48 $rule .= $rec->{domain} || '';
51 -href => "/maps/php/list.php?type=$list&next=$next",
53 }, "$list:$rec->{sequence}";
56 if ($rec->{retention}) {
57 $rule .= "Retention: " . $rec->{retention} . br;
60 if ($rec->{comment}) {
61 $rule .= "Comment: " . $rec->{comment};
69 header (-title => "MAPS: Check Address"),
70 start_html (-title => "MAPS: Check Address",
71 -author => "Andrew\@DeFaria.com");
72 print h3 {-align => "center",
74 "MAPS: Checking address $sender";
82 # Algorithm change: We now first check to see if the sender is not found
83 # in the message and skip it if so. Then we handle if we are the sender
84 # and that the from address is formatted properly. Spammers often use
85 # the senders email address (i.e. andrew@defaria.com) as their from address
86 # so we check "Andrew DeFaria <Andrew@DeFaria.com>", which they have never
87 # forged. This catches a lot of spam actually.
89 # Next we check to see if the sender is on our whitelist. If so then we let
90 # them in. This allows us to say whitelist josephrosenberg@hotmail.com while
91 # still nulllisting all of the other hotmail.com spammers.
93 # Next we process blacklisted people as they are also of high priority.
95 # Then we process nulllist people.
97 # Finally, we handle return processing
99 # Some email addresses have a '+' in them (e.g.
100 # wipro+autoreply@talent.icims.com). The problem is that CGI.pm replaces the
101 # '+' with a space. Now email addresses cannot contain spaces so we're gonna
102 # assume that a space in the email should be a '+'.
103 $sender =~ s/\s/\+/g;
105 ($onlist, $rec) = OnWhitelist($sender, $userid, 0);
108 print div {-align => "center"},
109 font {-color => "green"},
110 "Messages from", b ($sender), "will be", b ("delivered"), br, hr;
111 print formatRule('white', $sender, $rec);
113 ($onlist, $rec) = OnBlacklist($sender, 0);
116 print div {-align => "center"},
117 font {-color => "black"},
118 "Messages from", b ($sender), "will be", b ("blacklisted"), br, hr;
119 print formatRule('black', $sender, $rec);
121 ($onlist, $rec) = OnNulllist($sender, 0);
124 print div {-align => "center"},
125 font {-color => "grey"},
126 "Messages from", b ($sender), "will be", b ("discarded"), br, hr;
127 print formatRule('null', $sender, $rec);
129 print div {-align => "center"},
130 font {-color => "red"},
131 "Messages from", b ($sender), "will be", b ("returned");
136 print br div {-align => "center"},
137 submit(-name => "submit",
139 -onClick => "window.close (self)");