2 #################################################################################
4 # File: $RCSfile: MAPS.pm,v $
5 # Revision: $Revision: 1.1 $
6 # Description: Main module for Mail Authentication and Permission System (MAPS)
7 # Author: Andrew@DeFaria.com
8 # Created: Fri Nov 29 14:17:21 2002
9 # Modified: $Date: 2013/06/12 14:05:47 $
12 # (c) Copyright 2000-2018, Andrew@DeFaria.com, all rights reserved.
14 ################################################################################
23 use vars qw(@ISA @EXPORT);
32 my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER};
99 my $mapsbase = "$FindBin::Bin/..";
101 sub Add2Blacklist($$$) {
102 # Add2Blacklist will add an entry to the blacklist
103 my ($sender, $userid, $comment) = @_;
105 # First SetContext to the userid whose black list we are adding to
109 AddList("black", $sender, 0, $comment);
111 # Log that we black listed the sender
112 Info("Added $sender to " . ucfirst $userid . "'s black list");
115 my $count = DeleteEmail($sender);
117 # Log out many emails we managed to remove
118 Info("Removed $count emails from $sender");
123 sub Add2Nulllist($$;$$) {
124 # Add2Nulllist will add an entry to the nulllist
125 my ($sender, $userid, $comment, $hit_count) = @_;
127 # First SetContext to the userid whose null list we are adding to
131 AddList("null", $sender, 0, $comment, $hit_count);
133 # Log that we null listed the sender
134 Info("Added $sender to " . ucfirst $userid . "'s null list");
137 my $count = DeleteEmail($sender);
139 # Log out many emails we managed to remove
140 Info("Removed $count emails from $sender");
145 sub Add2Whitelist($$;$) {
146 # Add2Whitelist will add an entry to the whitelist
147 my ($sender, $userid, $comment) = @_;
149 # First SetContext to the userid whose white list we are adding to
153 AddList('white', $sender, 0, $comment);
155 # Log that we registered a user
156 Logmsg("registered", $sender, "Registered new sender");
158 # Check to see if there are any old messages to deliver
159 my $handle = FindEmail($sender);
161 my ($dbsender, $subject, $timestamp, $message);
165 my $return_status = 0;
167 while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail($handle)) {
170 $return_status = Whitelist($sender, $message);
172 last if $return_status;
180 # Return if we has a problem delivering email
181 return $return_status if $return_status;
183 # Remove delivered messages.
184 DeleteEmail($sender);
190 my ($sender, $subject, $data) = @_;
192 # "Sanitize" some fields so that characters that are illegal to SQL are escaped
193 $sender = 'Unknown' if (!defined $sender || $sender eq '');
194 $sender = $DB->quote($sender);
195 $subject = $DB->quote($subject);
196 $data = $DB->quote($data);
198 my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime));
199 my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)";
202 or DBError('AddEmail: Unable to do statement', $statement);
207 sub AddList($$$;$$$) {
208 my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_;
210 $hit_count //= CountMsg($pattern);
212 my ($user, $domain) = split /\@/, $pattern;
214 if (!$domain || $domain eq '') {
216 $pattern = $DB->quote($user);
218 $domain = "'$domain'";
223 $pattern = $DB->quote($user);
227 if (!$comment || $comment eq '') {
230 $comment = $DB->quote($comment);
233 # Get next sequence #
234 if ($sequence == 0) {
235 $sequence = GetNextSequenceNo($userid, $listtype);
238 $last_hit //= UnixDatetime2SQLDatetime(scalar (localtime));
240 my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hit_count, \"$last_hit\")";
243 or DBError('AddList: Unable to do statement', $statement);
249 my ($type, $sender, $msg) = @_;
251 my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime));
254 # Use quote to protect ourselves
255 $msg = $DB->quote($msg);
258 $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)";
260 $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)";
264 or DBError('AddLog: Unable to do statement', $statement);
270 my ($userid, $realname, $email, $password) = @_;
272 $password = Encrypt($password, $userid);
274 if (UserExists($userid)) {
277 my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')";
280 or DBError('AddUser: Unable to do statement', $statement);
286 sub AddUserOptions($%) {
287 my ($userid, %options) = @_;
289 for (keys %options) {
290 return 1 if !UserExists($userid);
292 my $statement = "insert into useropts values ('$userid', '$_', '$options{$_}')";
295 or DBError('AddUserOption: Unable to do statement', $statement);
302 # Blacklist will send a message back to the $sender telling them that
303 # they've been blacklisted. Currently we save a copy of the message.
304 # In the future we should just disregard the message.
305 my ($sender, $sequence, $hit_count, @msg) = @_;
307 # Check to see if this sender has already emailed us.
308 my $msg_count = CountMsg($sender);
310 if ($msg_count < 5) {
312 SendMsg($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg);
313 Logmsg("blacklist", $sender, "Sent blacklist reply");
315 Logmsg("mailloop", $sender, "Mail loop encountered");
318 RecordHit("black", $sequence, ++$hit_count) if $sequence;
323 sub CheckOnList ($$;$) {
324 # CheckOnList will check to see if the $sender is on the $listfile.
325 # Return 1 if found 0 if not.
326 my ($listtype, $sender, $update) = @_;
331 my ($rule, $sequence, $hit_count);
333 my $statement = 'select pattern, domain, comment, sequence, hit_count '
334 . "from list where userid = '$userid' and type = '$listtype' "
335 . 'order by sequence';
337 my $sth = $DB->prepare($statement)
338 or DBError('CheckOnList: Unable to prepare statement', $statement);
341 or DBError('CheckOnList: Unable to execute statement', $statement);
343 while (my @row = $sth->fetchrow_array) {
346 $hit_count = pop (@row);
347 $sequence = pop (@row);
348 my $comment = pop (@row);
349 my $domain = pop (@row);
350 my $pattern = pop (@row);
354 $email_on_file = $pattern;
357 $email_on_file = '@' . $domain;
359 $email_on_file = $pattern . '@' . $domain;
363 # Escape some special characters
364 $email_on_file =~ s/\@/\\@/;
365 $email_on_file =~ s/^\*/.\*/;
367 # We want to terminate the search string with a "$" iff there's an
368 # "@" in there. This is because some "email_on_file" may have no
369 # domain (e.g. "mailer-daemon" with no domain). In that case we
370 # don't want to terminate the search string with a "$" rather we
371 # wish to terminate it with an "@". But in the case of say
372 # "@ti.com" if we don't terminate the search string with "$" then
373 # "@ti.com" would also match "@tixcom.com"!
374 my $search_for = $email_on_file =~ /\@/
379 if ($sender =~ /$search_for/i) {
380 $rule = "Matching rule: ($listtype:$sequence) \"$email_on_file\"";
381 $rule .= " - $comment" if $comment and $comment ne '';
384 RecordHit($listtype, $sequence, ++$hit_count) if $update;
392 return ($status, $rule, $sequence, $hit_count);
396 my ($timestamp) = @_;
398 # First see if anything needs to be deleted
401 my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'";
404 my $sth = $DB->prepare($statement)
405 or DBError('CleanEmail: Unable to prepare statement', $statement);
409 or DBError('CleanEmail: Unable to execute statement', $statement);
411 # Get return value, which should be how many entries were deleted
412 my @row = $sth->fetchrow_array;
417 # Retrieve returned value
424 # Just return if there's nothing to delete
425 return $count if ($count == 0);
427 # Delete emails for userid whose older than $timestamp
428 $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
431 $sth = $DB->prepare($statement)
432 or DBError('CleanEmail: Unable to prepare statement', $statement);
436 or DBError('CleanEmail: Unable to execute statement', $statement);
442 my ($timestamp) = @_;
444 # First see if anything needs to be deleted
447 my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'";
450 my $sth = $DB->prepare($statement)
451 or DBError($DB, 'CleanLog: Unable to prepare statement', $statement);
455 or DBError('CleanLog: Unable to execute statement', $statement);
457 # Get return value, which should be how many entries were deleted
458 my @row = $sth->fetchrow_array;
463 # Retrieve returned value
470 # Just return if there's nothing to delete
471 return $count if ($count == 0);
473 # Delete log entries for userid whose older than $timestamp
474 $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
477 $sth = $DB->prepare($statement)
478 or DBError('CleanLog: Unable to prepare statement', $statement);
482 or DBError('CleanLog: Unable to execute statement', $statement);
488 my ($timestamp, $listtype) = @_;
490 $listtype //= 'null';
492 # First see if anything needs to be deleted
495 my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
498 my $sth = $DB->prepare($statement)
499 or DBError($DB, 'CleanList: Unable to prepare statement', $statement);
503 or DBError('CleanList: Unable to execute statement', $statement);
505 # Get return value, which should be how many entries were deleted
506 my @row = $sth->fetchrow_array;
511 # Retrieve returned value
512 $count = $row[0] ? $row[0] : 0;
514 # Just return if there's nothing to delete
515 return $count if ($count == 0);
517 # Get data for these entries
518 $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
521 $sth = $DB->prepare($statement)
522 or DBError('CleanList: Unable to prepare statement', $statement);
526 or DBError('CleanList: Unable to execute statement', $statement);
530 while (my @row = $sth->fetchrow_array) {
533 my $hit_count = pop(@row);
534 my $sequence = pop(@row);
535 my $listtype = pop(@row);
537 if ($hit_count == 0) {
540 $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence";
542 or DBError('CleanList: Unable to execute statement', $statement);
544 # Age entry: Sometimes entries are initially very popular and
545 # the $hit_count gets very high quickly. Then the domain is
546 # abandoned and no activity happens. One case recently observed
547 # was for phentermine.com. The $hit_count initially soared to
548 # 1920 within a few weeks. Then it all stopped as of
549 # 07/13/2007. Obvisously this domain was shutdown. With the
550 # previous aging algorithm of simply subtracting 1 this
551 # phentermine.com entry would hang around for over 5 years!
553 # So the tack here is to age the entry by 10% until the $hit_count
554 # is less than 30 then we revert to the old method of subtracting 1.
555 if ($hit_count < 30) {
558 $hit_count = int($hit_count / 1.1);
561 $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;";
563 or DBError('CleanList: Unable to execute statement', $statement);
567 ResequenceList($userid, $listtype);
581 return count('email', "userid = '$userid' and sender like '%$sender%'");
585 my ($msg, $statement) = @_;
587 print 'MAPS::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n";
590 print "SQL Statement: $statement\n";
597 my ($password, $userid) = @_;
599 my $statement = "select decode('$password','$userid')";
601 my $sth = $DB->prepare($statement)
602 or DBError('Decrypt: Unable to prepare statement', $statement);
605 or DBError('Decrypt: Unable to execute statement', $statement);
607 # Get return value, which should be the encoded password
608 my @row = $sth->fetchrow_array;
619 my ($username, $domain) = split /@/, $sender;
622 if ($username eq '') {
623 $condition = "userid = '$userid' and sender like '%\@$domain'";
625 $condition = "userid = '$userid' and sender = '$sender'";
628 # First see if anything needs to be deleted
629 my $count = count('email', $condition);
631 # Just return if there's nothing to delete
632 return $count if ($count == 0);
634 my $statement = 'delete from email where ' . $condition;
637 or DBError('DeleteEmail: Unable to execute statement', $statement);
643 my ($type, $sequence) = @_;
645 # First see if anything needs to be deleted
646 my $count = count('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
648 # Just return if there's nothing to delete
649 return $count if ($count == 0);
651 my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
654 or DBError('DeleteList: Unable to execute statement', $statement);
662 my ($username, $domain) = split /@/, $sender;
665 if ($username eq '') {
666 $condition = "userid = '$userid' and sender like '%\@$domain'";
668 $condition = "userid = '$userid' and sender = '$sender'";
671 # First see if anything needs to be deleted
672 my $count = count('log', $condition);
674 # Just return if there's nothing to delete
675 return $count if ($count == 0);
677 my $statement = 'delete from log where ' . $condition;
680 or DBError('DeleteLog: Unable to execute statement', $statement);
686 my ($password, $userid) = @_;
688 my $statement = "select encode('$password','$userid')";
690 my $sth = $DB->prepare($statement)
691 or DBError('Encrypt: Unable to prepare statement', $statement);
694 or DBError('Encrypt: Unable to execute statement', $statement);
696 # Get return value, which should be the encoded password
697 my @row = $sth->fetchrow_array;
710 if (!defined $sender || $sender eq '') {
711 $statement = "select * from email where userid = '$userid'";
713 $statement = "select * from email where userid = '$userid' and sender = '$sender'";
716 my $sth = $DB->prepare($statement)
717 or DBError('FindEmail: Unable to prepare statement', $statement);
720 or DBError('FindEmail: Unable to execute statement', $statement);
726 my ($type, $sender) = @_;
731 $statement = "select * from list where userid = '$userid' and type = '$type'";
733 my ($pattern, $domain) = split /\@/, $sender;
734 $statement = "select * from list where userid = '$userid' and type = '$type' " .
735 "and pattern = '$pattern' and domain = '$domain'";
739 my $sth = $DB->prepare($statement)
740 or DBError('FindList: Unable to prepare statement', $statement);
744 or DBError('FindList: Unable to execute statement', $statement);
746 # Get return value, which should be how many entries were deleted
754 my $end_at = countlog();
757 $start_at = $end_at - abs ($how_many);
758 $start_at = 0 if ($start_at < 0);
761 my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
764 my $sth = $DB->prepare($statement)
765 or DBError('FindLog: Unable to prepare statement', $statement);
769 or DBError('FindLog: Unable to execute statement', $statement);
771 # Get return value, which should be how many entries were deleted
780 if (!defined $userid || $userid eq '') {
781 $statement = 'select * from user';
783 $statement = "select * from user where userid = '$userid'";
786 my $sth = $DB->prepare($statement)
787 or DBError('FindUser: Unable to prepare statement', $statement);
790 or DBError('FindUser: Unable to execute statement', $statement);
804 if (@email = $sth->fetchrow_array) {
805 my $message = pop @email;
806 my $timestamp = pop @email;
807 my $subject = pop @email;
808 my $sender = pop @email;
809 my $userid = pop @email;
810 return $userid, $sender, $subject, $timestamp, $message;
821 if (@list = $sth->fetchrow_array) {
822 my $last_hit = pop @list;
823 my $hit_count = pop @list;
824 my $sequence = pop @list;
825 my $comment = pop @list;
826 my $domain = pop @list;
827 my $pattern = pop @list;
828 my $type = pop @list;
829 my $userid = pop @list;
830 return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
841 if (@log = $sth->fetchrow_array) {
842 my $message = pop @log;
844 my $sender = pop @log;
845 my $timestamp = pop @log;
846 my $userid = pop @log;
847 return $userid, $timestamp, $sender, $type, $message;
853 sub GetNextSequenceNo($$) {
854 my ($userid, $listtype) = @_;
856 my $count = count ('list', "userid = '$userid' and type = '$listtype'");
859 } # GetNextSequenceNo
866 if (@user = $sth->fetchrow_array) {
867 my $password = pop @user;
868 my $email = pop @user;
869 my $name = pop @user;
870 my $userid = pop @user;
871 return ($userid, $name, $email, $password);
880 my $statement = "select name, email from user where userid='$userid'";
882 my $sth = $DB->prepare($statement)
883 or DBError('GetUserInfo: Unable to prepare statement', $statement);
886 or DBError('GetUserInfo: Unable to execute statement', $statement);
888 my @userinfo = $sth->fetchrow_array;
889 my $user_email = lc (pop @userinfo);
890 my $username = lc (pop @userinfo);
894 return ($username, $user_email);
897 sub GetUserOptions($) {
900 my $statement = "select * from useropts where userid = '$userid'";
902 my $sth = $DB->prepare($statement)
903 or DBError('GetUserOptions: Unable to prepare statement', $statement);
906 or DBError('GetUserOptions: Unable to execute statement', $statement);
913 while (@useropts = $sth->fetchrow_array) {
914 my $value = pop @useropts;
915 my $name = pop @useropts;
919 $useropts{$name} = $value;
928 my ($statement) = @_;
930 my $sth = $DB->prepare($statement)
931 or DBError('Unable to prepare statement' , $statement);
934 or DBError('Unable to execute statement' , $statement);
938 while (my @row = $sth->fetchrow_array) {
948 my ($userid, $password) = @_;
950 $password = Encrypt($password, $userid);
952 # Check if user exists
953 my $dbpassword = UserExists($userid);
955 # Return -1 if user doesn't exist
956 return -1 if !$dbpassword;
958 # Return -2 if password does not match
959 if ($password eq $dbpassword) {
968 # Nulllist will simply discard the message.
969 my ($sender, $sequence, $hit_count) = @_;
971 RecordHit("null", $sequence, ++$hit_count) if $sequence;
974 Logmsg("nulllist", $sender, "Discarded message");
979 sub OnBlacklist($;$) {
980 my ($sender, $update) = @_;
982 return CheckOnList('black', $sender, $update);
985 sub OnNulllist($;$) {
986 my ($sender, $update) = @_;
988 return CheckOnList("null", $sender, $update);
991 sub OnWhitelist($;$$) {
992 my ($sender, $userid, $update) = @_;
994 SetContext($userid) if $userid;
996 return CheckOnList("white", $sender, $update);
1000 my ($username, $password) = @_;
1002 my $dbname = 'MAPS';
1003 my $dbdriver = 'mysql';
1004 my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
1006 if (!$DB || $DB eq '') {
1007 #$dbserver='localhost';
1008 $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
1009 or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
1016 my $MAPS_username = "maps";
1017 my $MAPS_password = "spam";
1019 OpenDB($MAPS_username, $MAPS_password);
1028 my $statement = 'lock tables email read, list read, log read, user read, useropts read';
1029 my $sth = $DB->prepare($statement)
1030 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1033 or DBError('OptimizeDB: Unable to execute statement', $statement);
1035 $statement = 'check table email, list, log, user, useropts';
1036 $sth = $DB->prepare($statement)
1037 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1040 or DBError('OptimizeDB: Unable to execute statement', $statement);
1042 $statement = 'unlock tables';
1043 $sth = $DB->prepare($statement)
1044 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1047 or DBError('OptimizeDB: Unable to execute statement', $statement);
1049 $statement = 'optimize table email, list, log, user, useropts';
1050 $sth = $DB->prepare($statement)
1051 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1054 or DBError('OptimizeDB: Unable to execute statement', $statement);
1060 # Reads an email message file from $input. Returns sender, subject,
1061 # date and data, which is a copy of the entire message.
1065 my $sender_long = '';
1066 my $envelope_sender = '';
1072 # Find first message's "From " line indicating start of message
1078 # If we hit eof here then the message was garbled. Return indication of this
1080 $data = "Garbled message - unable to find From line";
1081 return $sender, $sender_long, $reply_to, $subject, $data;
1085 $envelope_sender = $1;
1086 $sender_long = $envelope_sender;
1089 push @data, $_ if /^From /;
1095 # Blank line indicates start of message body
1096 last if ($_ eq "" || $_ eq "\r");
1098 # Extract sender's address
1100 $_ = substr ($_, 6);
1104 if (/<(\S*)@(\S*)>/) {
1105 $sender = lc ("$1\@$2");
1106 } elsif (/(\S*)@(\S*)\ /) {
1107 $sender = lc ("$1\@$2");
1108 } elsif (/(\S*)@(\S*)/) {
1109 $sender = lc ("$1\@$2");
1111 } elsif (/^subject: .*/i) {
1112 $subject = substr ($_, 9);
1113 } elsif (/^reply-to: .*/i) {
1114 $_ = substr ($_, 10);
1115 if (/<(\S*)@(\S*)>/) {
1116 $reply_to = lc ("$1\@$2");
1117 } elsif (/(\S*)@(\S*)\ /) {
1118 $reply_to = lc ("$1\@$2");
1119 } elsif (/(\S*)@(\S*)/) {
1120 $reply_to = lc ("$1\@$2");
1133 # Set file pointer back by length of the line just read
1134 seek ($input, -length () - 1, 1) if !eof $input;
1136 # Sanitize email addresses
1137 $envelope_sender =~ s/\<//g;
1138 $envelope_sender =~ s/\>//g;
1139 $envelope_sender =~ s/\"//g;
1140 $envelope_sender =~ s/\'//g;
1145 $reply_to =~ s/\<//g;
1146 $reply_to =~ s/\>//g;
1147 $reply_to =~ s/\"//g;
1148 $reply_to =~ s/\'//g;
1150 # Determine best addresses
1151 $sender = $envelope_sender if $sender eq "";
1152 $reply_to = $sender if $reply_to eq "";
1154 return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
1157 sub RecordHit($$$) {
1158 my ($listtype, $sequence, $hit_count) = @_;
1160 my $current_date = UnixDatetime2SQLDatetime(scalar(localtime));
1162 my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
1165 or DBError('RecordHit: Unable to do statement', $statement);
1170 sub ResequenceList($$) {
1171 my ($userid, $type) = @_;
1173 return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1175 return 2 unless UserExists($userid);
1177 my $statement = 'lock tables list write';
1178 my $sth = $DB->prepare($statement)
1179 or DBError('ResquenceList: Unable to prepare statement', $statement);
1182 or DBError('ResequenceList: Unable to execute statement', $statement);
1184 # Now get all of the list entries renumbering as we go
1185 $statement = <<"END";
1196 userid = '$userid' and
1202 $sth = $DB->prepare($statement)
1203 or DBError('ResequenceList: Unable to prepare statement', $statement);
1206 or DBError('ResequenceList: Unable to execute statement', $statement);
1211 while (my @row = $sth->fetchrow_array) {
1215 last_hit => pop @row,
1216 hit_count => pop @row,
1217 new_sequence => $sequence++,
1218 old_sequence => pop @row,
1219 comment => $DB->quote(pop @row) || '',
1220 domain => $DB->quote(pop @row) || '',
1221 pattern => $DB->quote(pop @row) || '',
1224 push @new_rows, \%record;
1227 # Delete all of the list entries for this $userid and $type
1228 $statement = "delete from list where userid='$userid' and type='$type'";
1231 or DBError('ResequenceList: Unable to do statement', $statement);
1233 # Re-add list with new sequence numbers
1236 my $statement = <<"END";
1245 '$record{new_sequence}',
1246 '$record{hit_count}',
1252 or DBError('ResequenceList: Unable to do statement', $statement);
1255 $statement = 'unlock tables';
1256 $sth = $DB->prepare($statement)
1257 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1260 or DBError('OptimizeDB: Unable to execute statement', $statement);
1265 sub ResequenceListold($$) {
1266 my ($userid, $type) = @_;
1268 return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1270 return 2 unless UserExists($userid);
1272 my $statement = "select sequence from list where userid = '$userid' "
1273 . " and type = '$type' order by sequence";
1275 my $sth = $DB->prepare($statement)
1276 or DBError('ResequenceList: Unable to prepare statement', $statement);
1279 or DBError('ResequenceList: Unable to execute statement', $statement);
1283 while (my @row = $sth->fetchrow_array) {
1286 my $old_sequence = pop @row;
1288 if ($old_sequence != $sequence) {
1289 my $update_statement = "update list set sequence = $sequence " .
1290 "where userid = '$userid' and " .
1291 "type = '$type' and sequence = $old_sequence";
1293 $DB->do($update_statement)
1294 or DBError('ResequenceList: Unable to do statement', $statement);
1303 sub ReturnEmails($$$;$$) {
1304 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1311 my $sod = $date . ' 00:00:00';
1312 my $eod = $date . ' 23:59:59';
1314 if ($type eq 'returned') {
1315 $statement = <<"END";
1322 log.sender = email.sender and
1323 log.userid = '$userid' and
1324 log.timestamp > '$sod' and
1325 log.timestamp < '$eod' and
1330 $start_at, $nbr_emails
1333 $statement = <<"END";
1339 userid = '$userid' and
1340 timestamp > '$sod' and
1341 timestamp < '$eod' and
1346 $start_at, $nbr_emails
1350 if ($type eq 'returned') {
1351 $statement = <<"END";
1358 log.sender = email.sender and
1359 log.userid = '$userid' and
1366 $start_at, $nbr_emails
1369 $statement = <<"END";
1375 userid = '$userid' and
1382 $start_at, $nbr_emails
1387 my $sth = $DB->prepare($statement)
1388 or DBError('ReturnEmails: Unable to prepare statement', $statement);
1391 or DBError('ReturnEmails: Unable to execute statement', $statement);
1395 while (my $sender = $sth->fetchrow_array) {
1398 # Get emails for this sender. Format an array of subjects and timestamps.
1401 $statement = "select timestamp, subject from email where userid = '$userid' " .
1402 "and sender = '$sender'";
1404 my $sth2 = $DB->prepare($statement)
1405 or DBError('ReturnEmails: Unable to prepare statement', $statement);
1408 or DBError('ReturnEmails: Unable to execute statement', $statement);
1410 while (my @row = $sth2->fetchrow_array) {
1411 my $subject = pop @row;
1412 my $date = pop @row;
1414 if ($earliestDate) {
1415 my $earliestDateShort = substr $earliestDate, 0, 10;
1416 my $dateShort = substr $date, 0, 10;
1418 if ($earliestDateShort eq $dateShort and
1419 $earliestDate > $date) {
1420 $earliestDate = $date if $earliestDateShort eq $dateShort;
1423 $earliestDate = $date;
1426 push @messages, [$subject, $date];
1432 $earliestDate ||= '';
1434 unless ($type eq 'returned') {
1435 push @emails, [$earliestDate, [$sender, @messages]];
1437 push @emails, [$earliestDate, [$sender, @messages]]
1448 sub ReturnList($$$) {
1449 my ($type, $start_at, $lines) = @_;
1456 $statement = "select * from list where userid = '$userid' " .
1457 "and type = '$type' order by sequence " .
1458 "limit $start_at, $lines";
1460 $statement = "select * from list where userid = '$userid' " .
1461 "and type = '$type' order by sequence";
1464 my $sth = $DB->prepare($statement)
1465 or DBError('ReturnList: Unable to prepare statement', $statement);
1468 or DBError('ReturnList: Unable to execute statement', $statement);
1473 while (my @row = $sth->fetchrow_array) {
1474 last if $i++ > $lines;
1478 $list{last_hit} = pop @row;
1479 $list{hit_count} = pop @row;
1480 $list{sequence} = pop @row;
1481 $list{comment} = pop @row;
1482 $list{domain} = pop @row;
1483 $list{pattern} = pop @row;
1484 $list{type} = pop @row;
1485 $list{userid} = pop @row;
1492 sub ReturnListEntry($$) {
1493 my ($type, $sequence) = @_;
1495 my $statement = "select * from list where userid = '$userid' " .
1496 "and type = '$type' and sequence = '$sequence'";
1498 my $sth = $DB->prepare($statement)
1499 or DBError('ReturnListEntry: Unable to prepare statement', $statement);
1502 or DBError('ReturnListEntry: Unable to execute statement', $statement);
1505 my @row = $sth->fetchrow_array;
1507 $list{sequence} = pop @row;
1508 $list{comment} = pop @row;
1509 $list{domain} = pop @row;
1510 $list{pattern} = pop @row;
1511 $list{type} = pop @row;
1512 $list{userid} = pop @row;
1517 # Added reply_to. Previously we passed reply_to into here as sender. This
1518 # caused a problem in that we were filtering as per sender but logging it
1519 # as reply_to. We only need reply_to for SendMsg so as to honor reply_to
1520 # so we now pass in both sender and reply_to
1521 sub ReturnMsg($$$$) {
1522 # ReturnMsg will send back to the $sender the register message.
1523 # Messages are saved to be delivered when the $sender registers.
1524 my ($sender, $reply_to, $subject, $data) = @_;
1526 # Check to see if this sender has already emailed us.
1527 my $msg_count = CountMsg($sender);
1529 if ($msg_count < 5) {
1530 # Return register message
1533 for (split /\n/,$data) {
1538 "Your email has been returned by MAPS",
1539 "$mapsbase/register.html",
1543 Logmsg("returned", $sender, "Sent register reply");
1545 SaveMsg($sender, $subject, $data);
1547 Add2Nulllist($sender, GetContext, "Auto Null List - Mail loop");
1548 Logmsg("mailloop", $sender, "Mail loop encountered");
1554 sub ReturnMessages($$) {
1555 my ($userid, $sender) = @_;
1557 my $statement = <<"END";
1564 userid = '$userid' and
1570 my $sth = $DB->prepare($statement)
1571 or DBError('ReturnMessages: Unable to prepare statement', $statement);
1574 or DBError('ReturnMessages: Unable to execute statement', $statement);
1578 while (my @row = $sth->fetchrow_array) {
1579 my $date = pop @row;
1580 my $subject = pop @row;
1582 push @messages, [$subject, $date];
1590 # This subroutine returns an array of senders in reverse chronological
1591 # order based on time timestamp from the log table of when we returned
1592 # their message. The complication here is that a single sender may
1593 # send multiple times in a single day. So if spammer@foo.com sends
1594 # spam @ 1 second after midnight and then again at 2 Pm there will be
1595 # at least two records in the log table saying that we returned his
1596 # email. Getting records sorted by timestamp desc will have
1597 # spammer@foo.com listed twice. But we want him listed only once, as
1598 # the first entry in the returned array. Plus we may be called
1599 # repeatedly with different $start_at's. Therefore we need to process
1600 # the whole list of returns for today, eliminate duplicate entries for
1601 # a single sender then slice the resulting array.
1602 sub ReturnSenders($$$;$$) {
1603 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1610 my $sod = $date . ' 00:00:00';
1611 my $eod = $date . ' 23:59:59';
1613 $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
1616 my $statement = <<"END";
1623 userid = '$userid' and
1630 my $sth = $DB->prepare($statement)
1631 or DBError('ReturnSenders: Unable to prepare statement', $statement);
1634 or DBError('ReturnSenders: Unable to execute statement', $statement);
1636 # Watch the distinction between senders (plural) and sender (singular)
1637 my (%senders, %sendersByTimestamp);
1639 # Run through the results and add to %senders by sender key. This
1640 # results in a hash that has the sender in it and the first
1641 # timestamp value. Since we already sorted timestamp desc by the
1642 # above select statement, and we've narrowed it down to only log
1643 # message that occurred for the given $date, we will have a hash
1644 # containing 1 sender and the latest timestamp for the day.
1645 while (my $senderRef = $sth->fetchrow_hashref) {
1646 my %sender = %{$senderRef};
1648 $senders{$sender{sender}} = $sender{timestamp}
1649 unless $senders{$sender{sender}};
1654 # Make a hash whose keys are the timestamp (so we can later sort on
1656 while (my ($key, $value) = each %senders) {
1657 $sendersByTimestamp{$value} = $key;
1662 # Sort by timestamp desc and push on to the @senders array
1663 push @senders, $sendersByTimestamp{$_}
1664 for (sort { $b cmp $a } keys %sendersByTimestamp);
1666 # Finally slice for the given range
1667 my $end_at = $start_at + $nbr_emails - 1;
1669 $end_at = (@senders - 1)
1670 if $end_at > @senders;
1672 return (@senders) [$start_at .. $end_at];
1676 my ($sender, $subject, $data) = @_;
1678 AddEmail($sender, $subject, $data);
1683 sub SearchEmails($$) {
1684 my ($userid, $searchfield) = @_;
1689 "select sender, subject, timestamp from email where userid = '$userid' and (
1690 sender like '%$searchfield%' or subject like '%$searchfield%')
1691 order by timestamp desc";
1693 my $sth = $DB->prepare($statement)
1694 or DBError('SearchEmails: Unable to prepare statement', $statement);
1697 or DBError('SearchEmails: Unable to execute statement', $statement);
1699 while (my @row = $sth->fetchrow_array) {
1700 my $date = pop @row;
1701 my $subject = pop @row;
1702 my $sender = pop @row;
1704 push @emails, [$sender, $subject, $date];
1712 sub SendMsg($$$$@) {
1713 # SendMsg will send the message contained in $msgfile.
1714 my ($sender, $subject, $msgfile, $userid, @spammsg) = @_;
1718 # Open return message template file
1719 open my $return_msg_file, '<', $msgfile
1720 or die "Unable to open return msg file ($msgfile): $!\n";
1722 # Read return message template file and print it to $msg_body
1723 while (<$return_msg_file>) {
1726 s/\$userid/$userid/;
1730 s/\$sender/$sender/;
1736 close $return_msg_file;
1738 # Create the message, and set up the mail headers:
1739 my $msg = MIME::Entity->build(
1740 From => "MAPS\@DeFaria.com",
1742 Subject => $subject,
1743 Type => "text/html",
1747 # Need to obtain the spam message here...
1750 Disposition => "attachment",
1755 open my $mail, '|-', '/usr/lib/sendmail -t -oi -oem'
1756 or croak "SendMsg: Unable to open pipe to sendmail $!";
1758 $msg->print(\*$mail);
1768 my $old_user = $userid;
1770 if (UserExists($to_user)) {
1773 GetUserOptions($userid);
1774 return GetUserInfo $userid;
1783 my $total_space = 0;
1786 my $statement = "select * from email where userid = '$userid'";
1787 my $sth = $DB->prepare($statement)
1788 or DBError('Unable to prepare statement', $statement);
1791 or DBError('Unable to execute statement', $statement);
1793 while (my @row = $sth->fetchrow_array) {
1796 my $data = pop @row;
1797 my $timestamp = pop @row;
1798 my $subject = pop @row;
1799 my $sender = pop @row;
1800 my $user = pop @row;
1806 length ($timestamp) +
1809 $total_space += $msg_space;
1810 $msg_space{$sender} += $msg_space;
1815 return wantarray ? %msg_space : $total_space;
1818 sub UpdateList($$$$$$$) {
1819 my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1821 if (!$pattern || $pattern eq '') {
1824 $pattern = "'" . quotemeta ($pattern) . "'";
1827 if (!$domain || $domain eq '') {
1830 $domain = "'" . quotemeta ($domain) . "'";
1833 if (!$comment || $comment eq '') {
1836 $comment = "'" . quotemeta ($comment) . "'";
1839 if (!$hit_count || $hit_count eq '') {
1842 # TODO: Check if numeric
1846 'update list set ' .
1847 "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
1848 "where userid = '$userid' and type = '$type' and sequence = $sequence";
1851 or DBError('UpdateList: Unable to do statement', $statement);
1856 sub UpdateUser($$$$) {
1857 my ($userid, $fullname, $email, $password) = @_;
1859 return 1 if !UserExists($userid);
1863 if (!defined $password || $password eq '') {
1864 $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1866 $password = Encrypt $password, $userid;
1867 $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1871 or DBError('UpdateUser: Unable to do statement', $statement);
1876 sub UpdateUserOptions ($@) {
1877 my ($userid, %options) = @_;
1879 return unless UserExists($userid);
1881 for (keys(%options)) {
1882 my $statement = "update useropts set value='$options{$_}' where userid='$userid' and name='$_'";
1885 or DBError('UpdateUserOption: Unable to do statement', $statement);
1889 } # UpdateUserOptions
1894 return 0 unless $userid;
1896 my $statement = "select userid, password from user where userid = '$userid'";
1898 my $sth = $DB->prepare($statement)
1899 or DBError('UserExists: Unable to prepare statement', $statement);
1902 or DBError('UserExists: Unable to execute statement', $statement);
1904 my @userdata = $sth->fetchrow_array;
1908 return 0 if scalar(@userdata) == 0;
1910 my $dbpassword = pop @userdata;
1911 my $dbuserid = pop @userdata;
1913 if ($dbuserid ne $userid) {
1920 sub Whitelist ($$;$$) {
1921 # Whitelist will deliver the message.
1922 my ($sender, $data, $sequence, $hit_count) = @_;
1924 my $userid = GetContext;
1926 # Dump message into a file
1927 open my $message, '>', "/tmp/MAPSMessage.$$"
1928 or Error("Unable to open message file (/tmp/MAPSMessage.$$): $!\n"), return -1;
1930 print $message $data;
1934 # Now call MAPSDeliver
1935 my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
1937 unlink "/tmp/MAPSMessage.$$";
1940 Logmsg("whitelist", $sender, "Delivered message");
1942 Error("Unable to deliver message - is MAPSDeliver setgid? - $!");
1945 RecordHit("white", $sequence, ++$hit_count) if $sequence;
1951 my ($table, $condition) = @_;
1956 $statement = "select count(*) from $table where $condition";
1958 $statement = "select count(*) from $table";
1961 my $sth = $DB->prepare($statement)
1962 or DBError('count: Unable to prepare statement', $statement);
1965 or DBError('count: Unable to execute statement', $statement);
1967 # Get return value, which should be how many message there are
1968 my @row = $sth->fetchrow_array;
1975 # Retrieve returned value
1985 sub count_distinct($$$) {
1986 my ($table, $column, $condition) = @_;
1991 $statement = "select count(distinct $column) from $table where $condition";
1993 $statement = "select count(distinct $column) from $table";
1996 my $sth = $DB->prepare($statement)
1997 or DBError('count: Unable to prepare statement', $statement);
2000 or DBError('count: Unable to execute statement', $statement);
2002 # Get return value, which should be how many message there are
2003 my @row = $sth->fetchrow_array;
2008 # Retrieve returned value
2017 my ($additional_condition) = @_;
2019 my $condition = "userid=\'$userid\' ";
2021 $condition .= "and $additional_condition" if $additional_condition;
2023 return count_distinct('log', 'sender', $condition);