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 and $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;
706 my ($sender, $date) = @_;
713 $statement = "select * from email where userid = '$userid'";
715 # Add conditions if present
716 $statement .= " and sender = '$sender'" if $sender;
717 $statement .= " and timestamp = '$date'" if $date;
719 my $sth = $DB->prepare($statement)
720 or DBError('FindEmail: Unable to prepare statement', $statement);
723 or DBError('FindEmail: Unable to execute statement', $statement);
729 my ($type, $sender) = @_;
734 $statement = "select * from list where userid = '$userid' and type = '$type'";
736 my ($pattern, $domain) = split /\@/, $sender;
737 $statement = "select * from list where userid = '$userid' and type = '$type' " .
738 "and pattern = '$pattern' and domain = '$domain'";
742 my $sth = $DB->prepare($statement)
743 or DBError('FindList: Unable to prepare statement', $statement);
747 or DBError('FindList: Unable to execute statement', $statement);
749 # Get return value, which should be how many entries were deleted
757 my $end_at = countlog();
760 $start_at = $end_at - abs ($how_many);
761 $start_at = 0 if ($start_at < 0);
764 my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
767 my $sth = $DB->prepare($statement)
768 or DBError('FindLog: Unable to prepare statement', $statement);
772 or DBError('FindLog: Unable to execute statement', $statement);
774 # Get return value, which should be how many entries were deleted
783 if (!defined $userid || $userid eq '') {
784 $statement = 'select * from user';
786 $statement = "select * from user where userid = '$userid'";
789 my $sth = $DB->prepare($statement)
790 or DBError('FindUser: Unable to prepare statement', $statement);
793 or DBError('FindUser: Unable to execute statement', $statement);
807 if (@email = $sth->fetchrow_array) {
808 my $message = pop @email;
809 my $timestamp = pop @email;
810 my $subject = pop @email;
811 my $sender = pop @email;
812 my $userid = pop @email;
813 return $userid, $sender, $subject, $timestamp, $message;
824 if (@list = $sth->fetchrow_array) {
825 my $last_hit = pop @list;
826 my $hit_count = pop @list;
827 my $sequence = pop @list;
828 my $comment = pop @list;
829 my $domain = pop @list;
830 my $pattern = pop @list;
831 my $type = pop @list;
832 my $userid = pop @list;
833 return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
844 if (@log = $sth->fetchrow_array) {
845 my $message = pop @log;
847 my $sender = pop @log;
848 my $timestamp = pop @log;
849 my $userid = pop @log;
850 return $userid, $timestamp, $sender, $type, $message;
856 sub GetNextSequenceNo($$) {
857 my ($userid, $listtype) = @_;
859 my $count = count ('list', "userid = '$userid' and type = '$listtype'");
862 } # GetNextSequenceNo
869 if (@user = $sth->fetchrow_array) {
870 my $password = pop @user;
871 my $email = pop @user;
872 my $name = pop @user;
873 my $userid = pop @user;
874 return ($userid, $name, $email, $password);
883 my $statement = "select name, email from user where userid='$userid'";
885 my $sth = $DB->prepare($statement)
886 or DBError('GetUserInfo: Unable to prepare statement', $statement);
889 or DBError('GetUserInfo: Unable to execute statement', $statement);
891 my @userinfo = $sth->fetchrow_array;
892 my $user_email = lc (pop @userinfo);
893 my $username = lc (pop @userinfo);
897 return ($username, $user_email);
900 sub GetUserOptions($) {
903 my $statement = "select * from useropts where userid = '$userid'";
905 my $sth = $DB->prepare($statement)
906 or DBError('GetUserOptions: Unable to prepare statement', $statement);
909 or DBError('GetUserOptions: Unable to execute statement', $statement);
916 while (@useropts = $sth->fetchrow_array) {
917 my $value = pop @useropts;
918 my $name = pop @useropts;
922 $useropts{$name} = $value;
931 my ($statement) = @_;
933 my $sth = $DB->prepare($statement)
934 or DBError('Unable to prepare statement' , $statement);
937 or DBError('Unable to execute statement' , $statement);
941 while (my @row = $sth->fetchrow_array) {
951 my ($userid, $password) = @_;
953 $password = Encrypt($password, $userid);
955 # Check if user exists
956 my $dbpassword = UserExists($userid);
958 # Return -1 if user doesn't exist
959 return -1 if !$dbpassword;
961 # Return -2 if password does not match
962 if ($password eq $dbpassword) {
971 # Nulllist will simply discard the message.
972 my ($sender, $sequence, $hit_count) = @_;
974 RecordHit("null", $sequence, ++$hit_count) if $sequence;
977 Logmsg("nulllist", $sender, "Discarded message");
982 sub OnBlacklist($;$) {
983 my ($sender, $update) = @_;
985 return CheckOnList('black', $sender, $update);
988 sub OnNulllist($;$) {
989 my ($sender, $update) = @_;
991 return CheckOnList("null", $sender, $update);
994 sub OnWhitelist($;$$) {
995 my ($sender, $userid, $update) = @_;
997 SetContext($userid) if $userid;
999 return CheckOnList("white", $sender, $update);
1003 my ($username, $password) = @_;
1005 my $dbname = 'MAPS';
1006 my $dbdriver = 'mysql';
1007 my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
1009 if (!$DB || $DB eq '') {
1010 #$dbserver='localhost';
1011 $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
1012 or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
1019 my $MAPS_username = "maps";
1020 my $MAPS_password = "spam";
1022 OpenDB($MAPS_username, $MAPS_password);
1031 my $statement = 'lock tables email read, list read, log read, user read, useropts read';
1032 my $sth = $DB->prepare($statement)
1033 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1036 or DBError('OptimizeDB: Unable to execute statement', $statement);
1038 $statement = 'check table email, list, log, user, useropts';
1039 $sth = $DB->prepare($statement)
1040 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1043 or DBError('OptimizeDB: Unable to execute statement', $statement);
1045 $statement = 'unlock tables';
1046 $sth = $DB->prepare($statement)
1047 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1050 or DBError('OptimizeDB: Unable to execute statement', $statement);
1052 $statement = 'optimize table email, list, log, user, useropts';
1053 $sth = $DB->prepare($statement)
1054 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1057 or DBError('OptimizeDB: Unable to execute statement', $statement);
1063 # Reads an email message file from $input. Returns sender, subject,
1064 # date and data, which is a copy of the entire message.
1068 my $sender_long = '';
1069 my $envelope_sender = '';
1075 # Find first message's "From " line indicating start of message
1081 # If we hit eof here then the message was garbled. Return indication of this
1083 $data = "Garbled message - unable to find From line";
1084 return $sender, $sender_long, $reply_to, $subject, $data;
1088 $envelope_sender = $1;
1089 $sender_long = $envelope_sender;
1092 push @data, $_ if /^From /;
1098 # Blank line indicates start of message body
1099 last if ($_ eq "" || $_ eq "\r");
1101 # Extract sender's address
1103 $_ = substr ($_, 6);
1107 if (/<(\S*)@(\S*)>/) {
1108 $sender = lc ("$1\@$2");
1109 } elsif (/(\S*)@(\S*)\ /) {
1110 $sender = lc ("$1\@$2");
1111 } elsif (/(\S*)@(\S*)/) {
1112 $sender = lc ("$1\@$2");
1114 } elsif (/^subject: .*/i) {
1115 $subject = substr ($_, 9);
1116 } elsif (/^reply-to: .*/i) {
1117 $_ = substr ($_, 10);
1118 if (/<(\S*)@(\S*)>/) {
1119 $reply_to = lc ("$1\@$2");
1120 } elsif (/(\S*)@(\S*)\ /) {
1121 $reply_to = lc ("$1\@$2");
1122 } elsif (/(\S*)@(\S*)/) {
1123 $reply_to = lc ("$1\@$2");
1136 # Set file pointer back by length of the line just read
1137 seek ($input, -length () - 1, 1) if !eof $input;
1139 # Sanitize email addresses
1140 $envelope_sender =~ s/\<//g;
1141 $envelope_sender =~ s/\>//g;
1142 $envelope_sender =~ s/\"//g;
1143 $envelope_sender =~ s/\'//g;
1148 $reply_to =~ s/\<//g;
1149 $reply_to =~ s/\>//g;
1150 $reply_to =~ s/\"//g;
1151 $reply_to =~ s/\'//g;
1153 # Determine best addresses
1154 $sender = $envelope_sender if $sender eq "";
1155 $reply_to = $sender if $reply_to eq "";
1157 return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
1160 sub RecordHit($$$) {
1161 my ($listtype, $sequence, $hit_count) = @_;
1163 my $current_date = UnixDatetime2SQLDatetime(scalar(localtime));
1165 my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
1168 or DBError('RecordHit: Unable to do statement', $statement);
1173 sub ResequenceList($$) {
1174 my ($userid, $type) = @_;
1176 return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1178 return 2 unless UserExists($userid);
1180 my $statement = 'lock tables list write';
1181 my $sth = $DB->prepare($statement)
1182 or DBError('ResquenceList: Unable to prepare statement', $statement);
1185 or DBError('ResequenceList: Unable to execute statement', $statement);
1187 # Now get all of the list entries renumbering as we go
1188 $statement = <<"END";
1199 userid = '$userid' and
1205 $sth = $DB->prepare($statement)
1206 or DBError('ResequenceList: Unable to prepare statement', $statement);
1209 or DBError('ResequenceList: Unable to execute statement', $statement);
1214 while (my @row = $sth->fetchrow_array) {
1218 last_hit => pop @row,
1219 hit_count => pop @row,
1220 new_sequence => $sequence++,
1221 old_sequence => pop @row,
1222 comment => $DB->quote(pop @row) || '',
1223 domain => $DB->quote(pop @row) || '',
1224 pattern => $DB->quote(pop @row) || '',
1227 push @new_rows, \%record;
1230 # Delete all of the list entries for this $userid and $type
1231 $statement = "delete from list where userid='$userid' and type='$type'";
1234 or DBError('ResequenceList: Unable to do statement', $statement);
1236 # Re-add list with new sequence numbers
1239 my $statement = <<"END";
1248 '$record{new_sequence}',
1249 '$record{hit_count}',
1255 or DBError('ResequenceList: Unable to do statement', $statement);
1258 $statement = 'unlock tables';
1259 $sth = $DB->prepare($statement)
1260 or DBError('OptimizeDB: Unable to prepare statement', $statement);
1263 or DBError('OptimizeDB: Unable to execute statement', $statement);
1268 sub ResequenceListold($$) {
1269 my ($userid, $type) = @_;
1271 return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1273 return 2 unless UserExists($userid);
1275 my $statement = "select sequence from list where userid = '$userid' "
1276 . " and type = '$type' order by sequence";
1278 my $sth = $DB->prepare($statement)
1279 or DBError('ResequenceList: Unable to prepare statement', $statement);
1282 or DBError('ResequenceList: Unable to execute statement', $statement);
1286 while (my @row = $sth->fetchrow_array) {
1289 my $old_sequence = pop @row;
1291 if ($old_sequence != $sequence) {
1292 my $update_statement = "update list set sequence = $sequence " .
1293 "where userid = '$userid' and " .
1294 "type = '$type' and sequence = $old_sequence";
1296 $DB->do($update_statement)
1297 or DBError('ResequenceList: Unable to do statement', $statement);
1306 sub ReturnEmails($$$;$$) {
1307 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1314 my $sod = $date . ' 00:00:00';
1315 my $eod = $date . ' 23:59:59';
1317 if ($type eq 'returned') {
1318 $statement = <<"END";
1325 log.sender = email.sender and
1326 log.userid = '$userid' and
1327 log.timestamp > '$sod' and
1328 log.timestamp < '$eod' and
1333 $start_at, $nbr_emails
1336 $statement = <<"END";
1342 userid = '$userid' and
1343 timestamp > '$sod' and
1344 timestamp < '$eod' and
1349 $start_at, $nbr_emails
1353 if ($type eq 'returned') {
1354 $statement = <<"END";
1361 log.sender = email.sender and
1362 log.userid = '$userid' and
1369 $start_at, $nbr_emails
1372 $statement = <<"END";
1378 userid = '$userid' and
1385 $start_at, $nbr_emails
1390 my $sth = $DB->prepare($statement)
1391 or DBError('ReturnEmails: Unable to prepare statement', $statement);
1394 or DBError('ReturnEmails: Unable to execute statement', $statement);
1398 while (my $sender = $sth->fetchrow_array) {
1401 # Get emails for this sender. Format an array of subjects and timestamps.
1404 $statement = "select timestamp, subject from email where userid = '$userid' " .
1405 "and sender = '$sender'";
1407 my $sth2 = $DB->prepare($statement)
1408 or DBError('ReturnEmails: Unable to prepare statement', $statement);
1411 or DBError('ReturnEmails: Unable to execute statement', $statement);
1413 while (my @row = $sth2->fetchrow_array) {
1414 my $subject = pop @row;
1415 my $date = pop @row;
1417 if ($earliestDate) {
1418 my $earliestDateShort = substr $earliestDate, 0, 10;
1419 my $dateShort = substr $date, 0, 10;
1421 if ($earliestDateShort eq $dateShort and
1422 $earliestDate > $date) {
1423 $earliestDate = $date if $earliestDateShort eq $dateShort;
1426 $earliestDate = $date;
1429 push @messages, [$subject, $date];
1435 $earliestDate ||= '';
1437 unless ($type eq 'returned') {
1438 push @emails, [$earliestDate, [$sender, @messages]];
1440 push @emails, [$earliestDate, [$sender, @messages]]
1451 sub ReturnList($$$) {
1452 my ($type, $start_at, $lines) = @_;
1459 $statement = "select * from list where userid = '$userid' " .
1460 "and type = '$type' order by sequence " .
1461 "limit $start_at, $lines";
1463 $statement = "select * from list where userid = '$userid' " .
1464 "and type = '$type' order by sequence";
1467 my $sth = $DB->prepare($statement)
1468 or DBError('ReturnList: Unable to prepare statement', $statement);
1471 or DBError('ReturnList: Unable to execute statement', $statement);
1476 while (my @row = $sth->fetchrow_array) {
1477 last if $i++ > $lines;
1481 $list{last_hit} = pop @row;
1482 $list{hit_count} = pop @row;
1483 $list{sequence} = pop @row;
1484 $list{comment} = pop @row;
1485 $list{domain} = pop @row;
1486 $list{pattern} = pop @row;
1487 $list{type} = pop @row;
1488 $list{userid} = pop @row;
1495 sub ReturnListEntry($$) {
1496 my ($type, $sequence) = @_;
1498 my $statement = "select * from list where userid = '$userid' " .
1499 "and type = '$type' and sequence = '$sequence'";
1501 my $sth = $DB->prepare($statement)
1502 or DBError('ReturnListEntry: Unable to prepare statement', $statement);
1505 or DBError('ReturnListEntry: Unable to execute statement', $statement);
1508 my @row = $sth->fetchrow_array;
1510 $list{sequence} = pop @row;
1511 $list{comment} = pop @row;
1512 $list{domain} = pop @row;
1513 $list{pattern} = pop @row;
1514 $list{type} = pop @row;
1515 $list{userid} = pop @row;
1520 # Added reply_to. Previously we passed reply_to into here as sender. This
1521 # caused a problem in that we were filtering as per sender but logging it
1522 # as reply_to. We only need reply_to for SendMsg so as to honor reply_to
1523 # so we now pass in both sender and reply_to
1524 sub ReturnMsg($$$$) {
1525 # ReturnMsg will send back to the $sender the register message.
1526 # Messages are saved to be delivered when the $sender registers.
1527 my ($sender, $reply_to, $subject, $data) = @_;
1529 # Check to see if this sender has already emailed us.
1530 my $msg_count = CountMsg($sender);
1532 if ($msg_count < 5) {
1533 # Return register message
1536 for (split /\n/,$data) {
1541 "Your email has been returned by MAPS",
1542 "$mapsbase/register.html",
1546 Logmsg("returned", $sender, "Sent register reply");
1548 SaveMsg($sender, $subject, $data);
1550 Add2Nulllist($sender, GetContext, "Auto Null List - Mail loop");
1551 Logmsg("mailloop", $sender, "Mail loop encountered");
1557 sub ReturnMessages($$) {
1558 my ($userid, $sender) = @_;
1560 my $statement = <<"END";
1567 userid = '$userid' and
1573 my $sth = $DB->prepare($statement)
1574 or DBError('ReturnMessages: Unable to prepare statement', $statement);
1577 or DBError('ReturnMessages: Unable to execute statement', $statement);
1581 while (my @row = $sth->fetchrow_array) {
1582 my $date = pop @row;
1583 my $subject = pop @row;
1585 push @messages, [$subject, $date];
1593 # This subroutine returns an array of senders in reverse chronological
1594 # order based on time timestamp from the log table of when we returned
1595 # their message. The complication here is that a single sender may
1596 # send multiple times in a single day. So if spammer@foo.com sends
1597 # spam @ 1 second after midnight and then again at 2 Pm there will be
1598 # at least two records in the log table saying that we returned his
1599 # email. Getting records sorted by timestamp desc will have
1600 # spammer@foo.com listed twice. But we want him listed only once, as
1601 # the first entry in the returned array. Plus we may be called
1602 # repeatedly with different $start_at's. Therefore we need to process
1603 # the whole list of returns for today, eliminate duplicate entries for
1604 # a single sender then slice the resulting array.
1605 sub ReturnSenders($$$;$$) {
1606 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1613 my $sod = $date . ' 00:00:00';
1614 my $eod = $date . ' 23:59:59';
1616 $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
1619 my $statement = <<"END";
1626 userid = '$userid' and
1633 my $sth = $DB->prepare($statement)
1634 or DBError('ReturnSenders: Unable to prepare statement', $statement);
1637 or DBError('ReturnSenders: Unable to execute statement', $statement);
1639 # Watch the distinction between senders (plural) and sender (singular)
1640 my (%senders, %sendersByTimestamp);
1642 # Run through the results and add to %senders by sender key. This
1643 # results in a hash that has the sender in it and the first
1644 # timestamp value. Since we already sorted timestamp desc by the
1645 # above select statement, and we've narrowed it down to only log
1646 # message that occurred for the given $date, we will have a hash
1647 # containing 1 sender and the latest timestamp for the day.
1648 while (my $senderRef = $sth->fetchrow_hashref) {
1649 my %sender = %{$senderRef};
1651 $senders{$sender{sender}} = $sender{timestamp}
1652 unless $senders{$sender{sender}};
1657 # Make a hash whose keys are the timestamp (so we can later sort on
1659 while (my ($key, $value) = each %senders) {
1660 $sendersByTimestamp{$value} = $key;
1665 # Sort by timestamp desc and push on to the @senders array
1666 push @senders, $sendersByTimestamp{$_}
1667 for (sort { $b cmp $a } keys %sendersByTimestamp);
1669 # Finally slice for the given range
1670 my $end_at = $start_at + $nbr_emails - 1;
1672 $end_at = (@senders - 1)
1673 if $end_at > @senders;
1675 return (@senders) [$start_at .. $end_at];
1679 my ($sender, $subject, $data) = @_;
1681 AddEmail($sender, $subject, $data);
1686 sub SearchEmails($$) {
1687 my ($userid, $searchfield) = @_;
1692 "select sender, subject, timestamp from email where userid = '$userid' and (
1693 sender like '%$searchfield%' or subject like '%$searchfield%')
1694 order by timestamp desc";
1696 my $sth = $DB->prepare($statement)
1697 or DBError('SearchEmails: Unable to prepare statement', $statement);
1700 or DBError('SearchEmails: Unable to execute statement', $statement);
1702 while (my @row = $sth->fetchrow_array) {
1703 my $date = pop @row;
1704 my $subject = pop @row;
1705 my $sender = pop @row;
1707 push @emails, [$sender, $subject, $date];
1715 sub SendMsg($$$$@) {
1716 # SendMsg will send the message contained in $msgfile.
1717 my ($sender, $subject, $msgfile, $userid, @spammsg) = @_;
1721 # Open return message template file
1722 open my $return_msg_file, '<', $msgfile
1723 or die "Unable to open return msg file ($msgfile): $!\n";
1725 # Read return message template file and print it to $msg_body
1726 while (<$return_msg_file>) {
1729 s/\$userid/$userid/;
1733 s/\$sender/$sender/;
1739 close $return_msg_file;
1741 # Create the message, and set up the mail headers:
1742 my $msg = MIME::Entity->build(
1743 From => "MAPS\@DeFaria.com",
1745 Subject => $subject,
1746 Type => "text/html",
1750 # Need to obtain the spam message here...
1753 Disposition => "attachment",
1758 open my $mail, '|-', '/usr/lib/sendmail -t -oi -oem'
1759 or croak "SendMsg: Unable to open pipe to sendmail $!";
1761 $msg->print(\*$mail);
1771 my $old_user = $userid;
1773 if (UserExists($to_user)) {
1776 GetUserOptions($userid);
1777 return GetUserInfo $userid;
1786 my $total_space = 0;
1789 my $statement = "select * from email where userid = '$userid'";
1790 my $sth = $DB->prepare($statement)
1791 or DBError('Unable to prepare statement', $statement);
1794 or DBError('Unable to execute statement', $statement);
1796 while (my @row = $sth->fetchrow_array) {
1799 my $data = pop @row;
1800 my $timestamp = pop @row;
1801 my $subject = pop @row;
1802 my $sender = pop @row;
1803 my $user = pop @row;
1809 length ($timestamp) +
1812 $total_space += $msg_space;
1813 $msg_space{$sender} += $msg_space;
1818 return wantarray ? %msg_space : $total_space;
1821 sub UpdateList($$$$$$$) {
1822 my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1824 if (!$pattern || $pattern eq '') {
1827 $pattern = "'" . quotemeta ($pattern) . "'";
1830 if (!$domain || $domain eq '') {
1833 $domain = "'" . quotemeta ($domain) . "'";
1836 if (!$comment || $comment eq '') {
1839 $comment = "'" . quotemeta ($comment) . "'";
1842 if (!$hit_count || $hit_count eq '') {
1845 # TODO: Check if numeric
1849 'update list set ' .
1850 "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
1851 "where userid = '$userid' and type = '$type' and sequence = $sequence";
1854 or DBError('UpdateList: Unable to do statement', $statement);
1859 sub UpdateUser($$$$) {
1860 my ($userid, $fullname, $email, $password) = @_;
1862 return 1 if !UserExists($userid);
1866 if (!defined $password || $password eq '') {
1867 $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1869 $password = Encrypt $password, $userid;
1870 $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1874 or DBError('UpdateUser: Unable to do statement', $statement);
1879 sub UpdateUserOptions ($@) {
1880 my ($userid, %options) = @_;
1882 return unless UserExists($userid);
1884 for (keys(%options)) {
1885 my $statement = "update useropts set value='$options{$_}' where userid='$userid' and name='$_'";
1888 or DBError('UpdateUserOption: Unable to do statement', $statement);
1892 } # UpdateUserOptions
1897 return 0 unless $userid;
1899 my $statement = "select userid, password from user where userid = '$userid'";
1901 my $sth = $DB->prepare($statement)
1902 or DBError('UserExists: Unable to prepare statement', $statement);
1905 or DBError('UserExists: Unable to execute statement', $statement);
1907 my @userdata = $sth->fetchrow_array;
1911 return 0 if scalar(@userdata) == 0;
1913 my $dbpassword = pop @userdata;
1914 my $dbuserid = pop @userdata;
1916 if ($dbuserid ne $userid) {
1923 sub Whitelist ($$;$$) {
1924 # Whitelist will deliver the message.
1925 my ($sender, $data, $sequence, $hit_count) = @_;
1927 my $userid = GetContext;
1929 # Dump message into a file
1930 open my $message, '>', "/tmp/MAPSMessage.$$"
1931 or Error("Unable to open message file (/tmp/MAPSMessage.$$): $!\n"), return -1;
1933 print $message $data;
1937 # Now call MAPSDeliver
1938 my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
1940 unlink "/tmp/MAPSMessage.$$";
1943 Logmsg("whitelist", $sender, "Delivered message");
1945 Error("Unable to deliver message - is MAPSDeliver setgid? - $!");
1948 RecordHit("white", $sequence, ++$hit_count) if $sequence;
1954 my ($table, $condition) = @_;
1959 $statement = "select count(*) from $table where $condition";
1961 $statement = "select count(*) from $table";
1964 my $sth = $DB->prepare($statement)
1965 or DBError('count: Unable to prepare statement', $statement);
1968 or DBError('count: Unable to execute statement', $statement);
1970 # Get return value, which should be how many message there are
1971 my @row = $sth->fetchrow_array;
1978 # Retrieve returned value
1988 sub count_distinct($$$) {
1989 my ($table, $column, $condition) = @_;
1994 $statement = "select count(distinct $column) from $table where $condition";
1996 $statement = "select count(distinct $column) from $table";
1999 my $sth = $DB->prepare($statement)
2000 or DBError('count: Unable to prepare statement', $statement);
2003 or DBError('count: Unable to execute statement', $statement);
2005 # Get return value, which should be how many message there are
2006 my @row = $sth->fetchrow_array;
2011 # Retrieve returned value
2020 my ($additional_condition) = @_;
2022 my $condition = "userid=\'$userid\' ";
2024 $condition .= "and $additional_condition" if $additional_condition;
2026 return count_distinct('log', 'sender', $condition);