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-2006, Andrew@DeFaria.com, all rights reserved.
14 ################################################################################
27 use vars qw (@ISA @EXPORT);
87 my $mapsbase = "$FindBin::Bin/..";
137 sub UpdateUserOptions;
142 my $MAPS_username = "mapsadmin";
143 my $MAPS_password = "mapsadmin";
145 OpenDB $MAPS_username, $MAPS_password;
153 # Add2Blacklist will add an entry to the blacklist
154 my ($sender, $userid, $comment) = @_;
156 # First SetContext to the userid whose black list we are adding to
157 MAPSDB::SetContext $userid;
160 AddList "black", $sender, 0, $comment;
162 # Log that we black listed the sender
163 Info "Added $sender to " . ucfirst $userid . "'s black list";
166 my $count = DeleteEmail $sender;
168 # Log out many emails we managed to remove
169 Info "Removed $count emails from $sender"
172 sub Add2Nulllist ($$;$$) {
173 # Add2Nulllist will add an entry to the nulllist
174 my ($sender, $userid, $comment, $hit_count) = @_;
176 # First SetContext to the userid whose null list we are adding to
177 MAPSDB::SetContext $userid;
180 AddList "null", $sender, 0, $comment, $hit_count;
182 # Log that we null listed the sender
183 Info "Added $sender to " . ucfirst $userid . "'s null list";
186 my $count = DeleteEmail $sender;
188 # Log out many emails we managed to remove
189 Info "Removed $count emails from $sender"
192 sub Add2Whitelist ($$;$) {
193 # Add2Whitelist will add an entry to the whitelist
194 my ($sender, $userid, $comment) = @_;
196 # First SetContext to the userid whose white list we are adding to
197 MAPSDB::SetContext $userid;
200 AddList 'white', $sender, 0, $comment;
202 # Log that we registered a user
203 Logmsg "registered", $sender, "Registered new sender";
205 # Check to see if there are any old messages to deliver
206 my $handle = FindEmail $sender;
208 my ($dbsender, $subject, $timestamp, $message);
212 my $return_status = 0;
214 while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail $handle) {
218 $return_status = Whitelist $sender, $message;
229 # Return if we has a problem delivering email
230 return $return_status
233 # Remove delivered messages.
240 my ($sender, $subject, $data) = @_;
242 MAPSDB::AddEmail $sender, $subject, $data;
245 sub AddList ($$$;$$$) {
246 my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_;
248 $hit_count //= CountMsg $pattern;
250 MAPSDB::AddList $listtype, $pattern, $sequence, $comment, $hit_count, $last_hit;
254 my ($userid, $realname, $email, $password) = @_;
256 return MAPSDB::AddUser $userid, $realname, $email, $password;
259 sub AddUserOptions ($%) {
260 my ($userid, %options) = @_;
264 foreach (keys (%options)) {
265 $status = MAPSDB::AddUserOption $userid, $_, $options{$_};
266 last if $status ne 0;
272 sub Blacklist ($$$@) {
273 # Blacklist will send a message back to the $sender telling them that
274 # they've been blacklisted. Currently we save a copy of the message.
275 # In the future we should just disregard the message.
276 my ($sender, $sequence, $hit_count, @msg) = @_;
278 # Check to see if this sender has already emailed us.
279 my $msg_count = CountMsg $sender;
281 if ($msg_count lt 5) {
283 SendMsg ($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg);
284 Logmsg "blacklist", $sender, "Sent blacklist reply";
286 Logmsg "mailloop", $sender, "Mail loop encountered";
289 RecordHit "black", $sequence, ++$hit_count if $sequence;
293 my ($timestamp) = @_;
295 MAPSDB::CleanEmail $timestamp;
299 my ($timestamp) = @_;
301 MAPSDB::CleanLog $timestamp;
304 sub CleanList ($;$) {
305 my ($timestamp, $listtype) = @_;
307 MAPSDB::CleanList $timestamp, $listtype;
313 return MAPSDB::CountMsg $sender;
317 my ($password, $userid) = @_;
319 return MAPSDB::Decrypt $password, shift;
322 sub DeleteEmail ($) {
325 return MAPSDB::DeleteEmail $sender;
328 sub DeleteList ($$) {
329 my ($type, $sequence) = @_;
331 return MAPSDB::DeleteList $type, $sequence;
337 return MAPSDB::DeleteLog $sender;
341 my ($password, $userid) = @_;
343 return MAPSDB::Encrypt $password, $userid;
349 return MAPSDB::FindEmail $sender;
353 my ($type, $sender) = @_;
355 return MAPSDB::FindList $type, $sender;
362 my $end_at = MAPSDB::countlog ();
365 $start_at = $end_at - abs ($how_many);
366 $start_at = 0 if ($start_at < 0);
369 return MAPSDB::FindLog $start_at, $end_at;
375 return MAPSDB::FindUser $userid
379 return MAPSDB::GetContext ();
385 return MAPSDB::GetEmail $handle;
391 return MAPSDB::GetList $handle;
397 return MAPSDB::GetLog $handle;
403 return MAPSDB::GetUser $handle;
406 sub GetUserOptions ($) {
409 return MAPSDB::GetUserOptions $userid;
413 my ($userid, $password) = @_;
415 $password = Encrypt $password, $userid;
417 # Check if user exists
418 my $dbpassword = UserExists $userid;
420 # Return -1 if user doesn't exist
421 return -1 if !$dbpassword;
423 # Return -2 if password does not match
424 if ($password eq $dbpassword) {
425 MAPSDB::SetContext $userid;
432 sub Nulllist ($;$$) {
433 # Nulllist will simply discard the message.
434 my ($sender, $sequence, $hit_count) = @_;
436 RecordHit "null", $sequence, ++$hit_count if $sequence;
439 Logmsg "nulllist", $sender, "Discarded message";
442 sub OnBlacklist ($) {
445 return CheckOnList "black", $sender;
451 return CheckOnList "null", $sender;
455 my ($sender, $userid) = @_;
457 if (defined $userid) {
458 MAPSDB::SetContext $userid;
461 return CheckOnList "white", $sender;
465 return MAPSDB::OptimizeDB ();
469 # Reads an email message file from $input. Returns sender, subject,
470 # date and data, which is a copy of the entire message.
474 my $sender_long = "";
475 my $envelope_sender = "";
481 # Find first message's "From " line indicating start of message
487 # If we hit eof here then the message was garbled. Return indication of this
489 $data = "Garbled message - unable to find From line";
490 return $sender, $sender_long, $reply_to, $subject, $data;
494 $envelope_sender = $1;
495 $sender_long = $envelope_sender;
498 push @data, $_ if /^From /;
504 # Blank line indicates start of message body
505 last if ($_ eq "" || $_ eq "\r");
507 # Extract sender's address
513 if (/<(\S*)@(\S*)>/) {
514 $sender = lc ("$1\@$2");
515 } elsif (/(\S*)@(\S*)\ /) {
516 $sender = lc ("$1\@$2");
517 } elsif (/(\S*)@(\S*)/) {
518 $sender = lc ("$1\@$2");
520 } elsif (/^subject: .*/i) {
521 $subject = substr ($_, 9);
522 } elsif (/^reply-to: .*/i) {
523 $_ = substr ($_, 10);
524 if (/<(\S*)@(\S*)>/) {
525 $reply_to = lc ("$1\@$2");
526 } elsif (/(\S*)@(\S*)\ /) {
527 $reply_to = lc ("$1\@$2");
528 } elsif (/(\S*)@(\S*)/) {
529 $reply_to = lc ("$1\@$2");
542 # Set file pointer back by length of the line just read
543 seek ($input, -length () - 1, 1) if !eof $input;
545 # Sanitize email addresses
546 $envelope_sender =~ s/\<//g;
547 $envelope_sender =~ s/\>//g;
548 $envelope_sender =~ s/\"//g;
549 $envelope_sender =~ s/\'//g;
554 $reply_to =~ s/\<//g;
555 $reply_to =~ s/\>//g;
556 $reply_to =~ s/\"//g;
557 $reply_to =~ s/\'//g;
559 # Determine best addresses
560 $sender = $envelope_sender if $sender eq "";
561 $reply_to = $sender if $reply_to eq "";
563 return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
566 sub ResequenceList ($$) {
567 my ($userid, $type) = @_;
569 return MAPSDB::ResequenceList $userid, $type;
572 sub ReturnMessages ($$) {
573 my ($userid, $sender) = @_;
575 return MAPSDB::ReturnMessages $userid, $sender;
578 sub ReturnSenders ($$$;$$) {
579 my ($userid, $type, $next, $lines, $date) = @_;
581 return MAPSDB::ReturnSenders $userid, $type, $next, $lines, $date;
584 sub ReturnList ($$$) {
585 my ($type, $start_at, $lines) = @_;
587 return MAPSDB::ReturnList $type, $start_at, $lines;
590 sub ReturnListEntry ($$) {
591 my ($type, $sequence) = @_;
593 return MAPSDB::ReturnListEntry $type, $sequence;
596 # Added reply_to. Previously we passed reply_to into here as sender. This
597 # caused a problem in that we were filtering as per sender but logging it
598 # as reply_to. We only need reply_to for SendMsg so as to honor reply_to
599 # so we now pass in both sender and reply_to
600 sub ReturnMsg ($$$$) {
601 # ReturnMsg will send back to the $sender the register message.
602 # Messages are saved to be delivered when the $sender registers.
603 my ($sender, $reply_to, $subject, $data) = @_;
605 # Check to see if this sender has already emailed us.
606 my $msg_count = CountMsg $sender;
608 if ($msg_count < 5) {
609 # Return register message
611 foreach (split /\n/,$data) {
615 "Your email has been returned by MAPS",
616 "$mapsbase/register.html",
620 Logmsg "returned", $sender, "Sent register reply";
622 SaveMsg $sender, $subject, $data;
624 Add2Nulllist $sender, GetContext, "Auto Null List - Mail loop";
625 Logmsg "mailloop", $sender, "Mail loop encountered";
630 my ($sender, $subject, $data) = @_;
632 AddEmail $sender, $subject, $data;
635 sub SearchEmails ($$) {
636 my ($userid, $searchfield) = @_;
638 return MAPSDB::SearchEmails $userid, $searchfield;
641 sub ForwardMsg ($$$) {
642 my ($sender, $subject, $data) = @_;
644 my @lines = split /\n/, $data;
646 while ($_ = shift @lines) {
647 last if ($_ eq "" || $_ eq "\r");
650 my $to = "renn.leech\@compassbank.com";
652 my $msg = MIME::Entity->build (
661 open MAIL, "| /usr/lib/sendmail -t -oi -oem"
662 or die "ForwardMsg: Unable to open pipe to sendmail $!";
667 sub SendMsg ($$$$@) {
668 # SendMsg will send the message contained in $msgfile.
669 my ($sender, $subject, $msgfile, $userid, @spammsg) = @_;
673 # Open return message template file
674 open RETURN_MSG_FILE, "$msgfile"
675 or die "Unable to open return msg file ($msgfile): $!\n";
677 # Read return message template file and print it to $msg_body
678 while (<RETURN_MSG_FILE>) {
690 # Close RETURN_MSG_FILE
691 close RETURN_MSG_FILE;
693 # Create the message, and set up the mail headers:
694 my $msg = MIME::Entity->build (
695 From => "MAPS\@DeFaria.com",
702 # Need to obtain the spam message here...
705 Disposition => "attachment",
710 open MAIL, "| /usr/lib/sendmail -t -oi -oem"
711 or die "SendMsg: Unable to open pipe to sendmail $!";
719 return MAPSDB::SetContext $new_user;
725 return MAPSDB::Space $userid;
728 sub UpdateList ($$$$$$$) {
729 my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
731 return MAPSDB::UpdateList $userid, $type, $pattern, $domain, $comment, $hit_count, $sequence;
734 sub UpdateUser ($$$$) {
735 my ($userid, $fullname, $email, $password) = @_;
737 return MAPSDB::UpdateUser $userid, $fullname, $email, $password;
740 sub UpdateUserOptions ($@) {
741 my ($userid, %options) = @_;
745 foreach (keys (%options)) {
746 $status = MAPSDB::UpdateUserOption $userid, $_, $options{$_};
747 last if $status ne 0;
751 } # UpdateUserOptions
756 return MAPSDB::UserExists $userid
759 sub Whitelist ($$;$$) {
760 # Whitelist will deliver the message.
761 my ($sender, $data, $sequence, $hit_count) = @_;
763 my $userid = GetContext;
765 # Dump message into a file
766 open MESSAGE, ">/tmp/MAPSMessage.$$"
767 or Error "Unable to open message file (/tmp/MAPSMessage.$$): $!\n", return -1;
773 # Now call MAPSDeliver
774 my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
776 unlink "/tmp/MAPSMessage.$$";
779 Logmsg "whitelist", $sender, "Delivered message";
781 Error "Unable to deliver message - is MAPSDeliver setgid? - $!";
784 RecordHit "white", $sequence, ++$hit_count if $sequence;