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) = @_;
176 # First SetContext to the userid whose null list we are adding to
177 MAPSDB::SetContext $userid;
180 AddList "null", $sender, 0, $comment;
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) = @_;
248 MAPSDB::AddList $listtype, $pattern, $sequence, $comment, CountMsg $pattern;
252 my ($userid, $realname, $email, $password) = @_;
254 return MAPSDB::AddUser $userid, $realname, $email, $password;
257 sub AddUserOptions ($%) {
258 my ($userid, %options) = @_;
262 foreach (keys (%options)) {
263 $status = MAPSDB::AddUserOption $userid, $_, $options{$_};
264 last if $status ne 0;
270 sub Blacklist ($$$@) {
271 # Blacklist will send a message back to the $sender telling them that
272 # they've been blacklisted. Currently we save a copy of the message.
273 # In the future we should just disregard the message.
274 my ($sender, $sequence, $hit_count, @msg) = @_;
276 # Check to see if this sender has already emailed us.
277 my $msg_count = CountMsg $sender;
279 if ($msg_count lt 5) {
281 SendMsg ($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg);
282 Logmsg "blacklist", $sender, "Sent blacklist reply";
284 Logmsg "mailloop", $sender, "Mail loop encountered";
287 RecordHit "black", $sequence, ++$hit_count if $sequence;
291 my ($timestamp) = @_;
293 MAPSDB::CleanEmail $timestamp;
297 my ($timestamp) = @_;
299 MAPSDB::CleanLog $timestamp;
302 sub CleanList ($;$) {
303 my ($timestamp, $listtype) = @_;
305 MAPSDB::CleanList $timestamp, $listtype;
311 return MAPSDB::CountMsg $sender;
315 my ($password, $userid) = @_;
317 return MAPSDB::Decrypt $password, shift;
320 sub DeleteEmail ($) {
323 return MAPSDB::DeleteEmail $sender;
326 sub DeleteList ($$) {
327 my ($type, $sequence) = @_;
329 return MAPSDB::DeleteList $type, $sequence;
335 return MAPSDB::DeleteLog $sender;
339 my ($password, $userid) = @_;
341 return MAPSDB::Encrypt $password, $userid;
347 return MAPSDB::FindEmail $sender;
351 my ($type, $sender) = @_;
353 return MAPSDB::FindList $type, $sender;
360 my $end_at = MAPSDB::countlog ();
363 $start_at = $end_at - abs ($how_many);
364 $start_at = 0 if ($start_at < 0);
367 return MAPSDB::FindLog $start_at, $end_at;
373 return MAPSDB::FindUser $userid
377 return MAPSDB::GetContext ();
383 return MAPSDB::GetEmail $handle;
389 return MAPSDB::GetList $handle;
395 return MAPSDB::GetLog $handle;
401 return MAPSDB::GetUser $handle;
404 sub GetUserOptions ($) {
407 return MAPSDB::GetUserOptions $userid;
411 my ($userid, $password) = @_;
413 $password = Encrypt $password, $userid;
415 # Check if user exists
416 my $dbpassword = UserExists $userid;
418 # Return -1 if user doesn't exist
419 return -1 if !$dbpassword;
421 # Return -2 if password does not match
422 if ($password eq $dbpassword) {
423 MAPSDB::SetContext $userid;
430 sub Nulllist ($;$$) {
431 # Nulllist will simply discard the message.
432 my ($sender, $sequence, $hit_count) = @_;
434 RecordHit "null", $sequence, ++$hit_count if $sequence;
437 Logmsg "nulllist", $sender, "Discarded message";
440 sub OnBlacklist ($) {
443 return CheckOnList "black", $sender;
449 return CheckOnList "null", $sender;
453 my ($sender, $userid) = @_;
455 if (defined $userid) {
456 MAPSDB::SetContext $userid;
459 return CheckOnList "white", $sender;
463 return MAPSDB::OptimizeDB ();
467 # Reads an email message file from $input. Returns sender, subject,
468 # date and data, which is a copy of the entire message.
472 my $sender_long = "";
473 my $envelope_sender = "";
479 # Find first message's "From " line indicating start of message
485 # If we hit eof here then the message was garbled. Return indication of this
487 $data = "Garbled message - unable to find From line";
488 return $sender, $sender_long, $reply_to, $subject, $data;
492 $envelope_sender = $1;
493 $sender_long = $envelope_sender;
496 push @data, $_ if /^From /;
502 # Blank line indicates start of message body
503 last if ($_ eq "" || $_ eq "\r");
505 # Extract sender's address
509 if (/<(\S*)@(\S*)>/) {
510 $sender = lc ("$1\@$2");
511 } elsif (/(\S*)@(\S*)\ /) {
512 $sender = lc ("$1\@$2");
513 } elsif (/(\S*)@(\S*)/) {
514 $sender = lc ("$1\@$2");
516 } elsif (/^subject: .*/i) {
517 $subject = substr ($_, 9);
518 } elsif (/^reply-to: .*/i) {
519 $_ = substr ($_, 10);
520 if (/<(\S*)@(\S*)>/) {
521 $reply_to = lc ("$1\@$2");
522 } elsif (/(\S*)@(\S*)\ /) {
523 $reply_to = lc ("$1\@$2");
524 } elsif (/(\S*)@(\S*)/) {
525 $reply_to = lc ("$1\@$2");
540 # Set file pointer back by length of the line just read
541 seek ($input, -length () - 1, 1) if !eof $input;
543 # Sanitize email addresses
544 $envelope_sender =~ s/\<//g;
545 $envelope_sender =~ s/\>//g;
546 $envelope_sender =~ s/\"//g;
547 $envelope_sender =~ s/\'//g;
552 $reply_to =~ s/\<//g;
553 $reply_to =~ s/\>//g;
554 $reply_to =~ s/\"//g;
555 $reply_to =~ s/\'//g;
557 # Now let's pack the @data array to a scalar
559 $data = $data . $_ . "\n";
562 # Determine best addresses
563 $sender = $envelope_sender if $sender eq "";
564 $reply_to = $sender if $reply_to eq "";
566 return $sender, $sender_long, $reply_to, $subject, $data;
569 sub ResequenceList ($$) {
570 my ($userid, $type) = @_;
572 return MAPSDB::ResequenceList $userid, $type;
575 sub ReturnMessages ($$) {
576 my ($userid, $sender) = @_;
578 return MAPSDB::ReturnMessages $userid, $sender;
581 sub ReturnSenders ($$$;$$) {
582 my ($userid, $type, $next, $lines, $date) = @_;
584 return MAPSDB::ReturnSenders $userid, $type, $next, $lines, $date;
587 sub ReturnList ($$$) {
588 my ($type, $start_at, $lines) = @_;
590 return MAPSDB::ReturnList $type, $start_at, $lines;
593 sub ReturnListEntry ($$) {
594 my ($type, $sequence) = @_;
596 return MAPSDB::ReturnListEntry $type, $sequence;
599 # Added reply_to. Previously we passed reply_to into here as sender. This
600 # caused a problem in that we were filtering as per sender but logging it
601 # as reply_to. We only need reply_to for SendMsg so as to honor reply_to
602 # so we now pass in both sender and reply_to
603 sub ReturnMsg ($$$$) {
604 # ReturnMsg will send back to the $sender the register message.
605 # Messages are saved to be delivered when the $sender registers.
606 my ($sender, $reply_to, $subject, $data) = @_;
608 # Check to see if this sender has already emailed us.
609 my $msg_count = CountMsg $sender;
611 if ($msg_count < 5) {
612 # Return register message
614 foreach (split /\n/,$data) {
618 "Your email has been returned by MAPS",
619 "$mapsbase/register.html",
623 Logmsg "returned", $sender, "Sent register reply";
625 SaveMsg $sender, $subject, $data;
627 Add2Nulllist $sender, GetContext, "Auto Null List - Mail loop";
628 Logmsg "mailloop", $sender, "Mail loop encountered";
633 my ($sender, $subject, $data) = @_;
635 AddEmail $sender, $subject, $data;
638 sub SearchEmails ($$) {
639 my ($userid, $searchfield) = @_;
641 return MAPSDB::SearchEmails $userid, $searchfield;
644 sub ForwardMsg ($$$) {
645 my ($sender, $subject, $data) = @_;
647 my @lines = split /\n/, $data;
649 while ($_ = shift @lines) {
650 last if ($_ eq "" || $_ eq "\r");
653 my $to = "renn.leech\@compassbank.com";
655 my $msg = MIME::Entity->build (
664 open MAIL, "| /usr/lib/sendmail -t -oi -oem"
665 or die "ForwardMsg: Unable to open pipe to sendmail $!";
670 sub SendMsg ($$$$@) {
671 # SendMsg will send the message contained in $msgfile.
672 my ($sender, $subject, $msgfile, $userid, @spammsg) = @_;
676 # Open return message template file
677 open RETURN_MSG_FILE, "$msgfile"
678 or die "Unable to open return msg file ($msgfile): $!\n";
680 # Read return message template file and print it to $msg_body
681 while (<RETURN_MSG_FILE>) {
693 # Close RETURN_MSG_FILE
694 close RETURN_MSG_FILE;
696 # Create the message, and set up the mail headers:
697 my $msg = MIME::Entity->build (
698 From => "MAPS\@DeFaria.com",
705 # Need to obtain the spam message here...
708 Disposition => "attachment",
713 open MAIL, "| /usr/lib/sendmail -t -oi -oem"
714 or die "SendMsg: Unable to open pipe to sendmail $!";
722 return MAPSDB::SetContext $new_user;
728 return MAPSDB::Space $userid;
731 sub UpdateList ($$$$$$) {
732 my ($userid, $type, $pattern, $domain, $comment, $sequence) = @_;
734 return MAPSDB::UpdateList $userid, $type, $pattern, $domain, $comment, $sequence;
737 sub UpdateUser ($$$$) {
738 my ($userid, $fullname, $email, $password) = @_;
740 return MAPSDB::UpdateUser $userid, $fullname, $email, $password;
743 sub UpdateUserOptions ($@) {
744 my ($userid, %options) = @_;
748 foreach (keys (%options)) {
749 $status = MAPSDB::UpdateUserOption $userid, $_, $options{$_};
750 last if $status ne 0;
754 } # UpdateUserOptions
759 return MAPSDB::UserExists $userid
762 sub Whitelist ($$;$$) {
763 # Whitelist will deliver the message.
764 my ($sender, $data, $sequence, $hit_count) = @_;
766 my $userid = GetContext;
768 # Dump message into a file
769 open MESSAGE, ">/tmp/MAPSMessage.$$"
770 or Error "Unable to open message file (/tmp/MAPSMessage.$$): $!\n", return -1;
776 # Now call MAPSDeliver
777 my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
779 unlink "/tmp/MAPSMessage.$$";
782 Logmsg "whitelist", $sender, "Delivered message";
784 Error "Unable to deliver message - is MAPSDeliver setgid? - $!";
787 RecordHit "white", $sequence, ++$hit_count if $sequence;