maps/bin/MAPS.pm

   1 #!/usr/bin/perl
   2 #################################################################################
   3 #
   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 $
  10 # Language:     perl
  11 #
  12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 package MAPS;
  16
  17 use strict;
  18
  19 use FindBin;
  20
  21 use MAPSDB;
  22 use MAPSLog;
  23 use MAPSFile;
  24 use MAPSUtil;
  25 use MIME::Entity;
  26
  27 use vars qw (@ISA @EXPORT);
  28 use Exporter;
  29
  30 @ISA = qw (Exporter);
  31
  32 @EXPORT = qw (
  33   Add2Blacklist
  34   Add2Nulllist
  35   Add2Whitelist
  36   AddEmail
  37   AddList
  38   AddUser
  39   AddUserOptions
  40   Blacklist
  41   CleanEmail
  42   CleanLog
  43   CleanList
  44   CountMsg
  45   Decrypt
  46   DeleteEmail
  47   DeleteList
  48   DeleteLog
  49   Encrypt
  50   FindEmail
  51   FindList
  52   FindLog
  53   FindUser
  54   ForwardMsg
  55   GetContext
  56   GetEmail
  57   GetList
  58   GetLog
  59   GetUser
  60   GetUserOptions
  61   ListLog
  62   ListUsers
  63   Login
  64   Nulllist
  65   OnBlacklist
  66   OnNulllist
  67   OnWhitelist
  68   OptimizeDB
  69   ReadMsg
  70   ResequenceList
  71   ReturnList
  72   ReturnListEntry
  73   ReturnMsg
  74   ReturnMessages
  75   ReturnSenders
  76   SaveMsg
  77   SearchEmails
  78   SetContext
  79   Space
  80   UpdateList
  81   UpdateUser
  82   UpdateUserOptions
  83   UserExists
  84   Whitelist
  85 );
  86
  87 my $mapsbase = "$FindBin::Bin/..";
  88
  89 # Forwards
  90 sub Add2Blacklist;
  91 sub Add2Nulllist;
  92 sub Add2Whitelist;
  93 sub AddEmail;
  94 sub AddList;
  95 sub AddUser;
  96 sub AddUserOptions;
  97 sub Blacklist;
  98 sub CleanEmail;
  99 sub CleanLog;
 100 sub CountMsg;
 101 sub Decrypt;
 102 sub DeleteEmail;
 103 sub DeleteList;
 104 sub DeleteLog;
 105 sub Encrypt;
 106 sub FindEmail;
 107 sub FindList;
 108 sub FindLog;
 109 sub FindUser;
 110 sub ForwardMsg;
 111 sub GetContext;
 112 sub GetEmail;
 113 sub GetList;
 114 sub GetLog;
 115 sub GetUser;
 116 sub GetUserOptions;
 117 sub Login;
 118 sub Nulllist;
 119 sub OnBlacklist;
 120 sub OnNulllist;
 121 sub OnWhitelist;
 122 sub OptimizeDB;
 123 sub ReadMsg;
 124 sub ResequenceList;
 125 sub ReturnList;
 126 sub ReturnListEntry;
 127 sub ReturnMsg;
 128 sub ReturnMessages;
 129 sub ReturnSenders;
 130 sub SaveMsg;
 131 sub SearchEmails;
 132 sub SendMsg;
 133 sub SetContext;
 134 sub Space;
 135 sub UpdateList;
 136 sub UpdateUser;
 137 sub UpdateUserOptions;
 138 sub UserExists;
 139 sub Whitelist;
 140
 141 BEGIN {
 142   my $MAPS_username = "mapsadmin";
 143   my $MAPS_password = "mapsadmin";
 144
 145   OpenDB $MAPS_username, $MAPS_password;
 146 } # BEGIN
 147
 148 END {
 149   CloseDB;
 150 } # END
 151
 152 sub Add2Blacklist {
 153   # Add2Blacklist will add an entry to the blacklist
 154   my ($sender, $userid, $comment) = @_;
 155
 156   # First SetContext to the userid whose black list we are adding to
 157   MAPSDB::SetContext $userid;
 158
 159   # Add to black list
 160   AddList "black", $sender, 0, $comment;
 161
 162   # Log that we black listed the sender
 163   Info "Added $sender to " . ucfirst $userid . "'s black list";
 164
 165   # Delete old emails
 166   my $count = DeleteEmail $sender;
 167
 168   # Log out many emails we managed to remove
 169   Info "Removed $count emails from $sender"
 170 } # Add2Blacklist
 171
 172 sub Add2Nulllist ($$;$) {
 173   # Add2Nulllist will add an entry to the nulllist
 174   my ($sender, $userid, $comment) = @_;
 175
 176   # First SetContext to the userid whose null list we are adding to
 177   MAPSDB::SetContext $userid;
 178
 179   # Add to null list
 180   AddList "null", $sender, 0, $comment;
 181
 182   # Log that we null listed the sender
 183   Info "Added $sender to " . ucfirst $userid . "'s null list";
 184
 185   # Delete old emails
 186   my $count = DeleteEmail $sender;
 187
 188   # Log out many emails we managed to remove
 189   Info "Removed $count emails from $sender"
 190 } # Add2Nulllist
 191
 192 sub Add2Whitelist ($$;$) {
 193   # Add2Whitelist will add an entry to the whitelist
 194   my ($sender, $userid, $comment) = @_;
 195
 196   # First SetContext to the userid whose white list we are adding to
 197   MAPSDB::SetContext $userid;
 198
 199   # Add to white list
 200   AddList 'white', $sender, 0, $comment;
 201
 202   # Log that we registered a user
 203   Logmsg "registered", $sender, "Registered new sender";
 204
 205   # Check to see if there are any old messages to deliver
 206   my $handle = FindEmail $sender;
 207
 208   my ($dbsender, $subject, $timestamp, $message);
 209
 210   # Deliver old emails
 211   my $messages    = 0;
 212   my $return_status  = 0;
 213
 214   while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail $handle) {
 215     last
 216       unless $userid;
 217
 218     $return_status = Whitelist $sender, $message;
 219
 220     last
 221       if $return_status;
 222
 223     $messages++;
 224   } # while
 225
 226   # Done with $handle
 227   $handle->finish;
 228
 229   # Return if we has a problem delivering email
 230   return $return_status
 231     if $return_status;
 232
 233   # Remove delivered messages.
 234   DeleteEmail $sender;
 235
 236   return $messages;
 237 } # Add2Whitelist
 238
 239 sub AddEmail ($$$) {
 240   my ($sender, $subject, $data) = @_;
 241
 242   MAPSDB::AddEmail $sender, $subject, $data;
 243 } # AddEmail
 244
 245 sub AddList ($$$;$) {
 246   my ($listtype, $pattern, $sequence, $comment) = @_;
 247
 248   MAPSDB::AddList $listtype, $pattern, $sequence, $comment, CountMsg $pattern;
 249 } # AddList
 250
 251 sub AddUser ($$$$) {
 252   my ($userid, $realname, $email, $password) = @_;
 253
 254   return MAPSDB::AddUser $userid, $realname, $email, $password;
 255 } # AddUser
 256
 257 sub AddUserOptions ($%) {
 258   my ($userid, %options) = @_;
 259
 260   my $status;
 261
 262   foreach (keys (%options)) {
 263     $status = MAPSDB::AddUserOption $userid, $_, $options{$_};
 264     last if $status ne 0;
 265   } # foreach
 266
 267   return $status;
 268 } # AddUserOptions
 269
 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)  = @_;
 275
 276   # Check to see if this sender has already emailed us.
 277   my $msg_count = CountMsg $sender;
 278
 279   if ($msg_count lt 5) {
 280     # Bounce email
 281     SendMsg ($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg);
 282     Logmsg "blacklist", $sender, "Sent blacklist reply";
 283   } else {
 284     Logmsg "mailloop", $sender, "Mail loop encountered";
 285   } # if
 286
 287   RecordHit "black", $sequence, ++$hit_count if $sequence;
 288 } # Blacklist
 289
 290 sub CleanEmail ($) {
 291   my ($timestamp) = @_;
 292
 293   MAPSDB::CleanEmail $timestamp;
 294 } # CleanEmail
 295
 296 sub CleanLog ($) {
 297   my ($timestamp) = @_;
 298
 299   MAPSDB::CleanLog $timestamp;
 300 } # CleanLog
 301
 302 sub CleanList ($;$) {
 303   my ($timestamp, $listtype) = @_;
 304
 305   MAPSDB::CleanList $timestamp, $listtype;
 306 } # CleanList
 307
 308 sub CountMsg ($) {
 309   my ($sender) = @_;
 310
 311   return MAPSDB::CountMsg $sender;
 312 } # CountMsg
 313
 314 sub Decrypt ($$) {
 315   my ($password, $userid) = @_;
 316
 317   return MAPSDB::Decrypt $password, shift;
 318 } # Decrypt
 319
 320 sub DeleteEmail ($) {
 321   my ($sender) = @_;
 322
 323   return MAPSDB::DeleteEmail $sender;
 324 } # DeleteEmail
 325
 326 sub DeleteList ($$) {
 327   my ($type, $sequence) = @_;
 328
 329   return MAPSDB::DeleteList $type, $sequence;
 330 } # DeleteList
 331
 332 sub DeleteLog ($) {
 333   my ($sender) = @_;
 334
 335   return MAPSDB::DeleteLog $sender;
 336 } # DeleteLog
 337
 338 sub Encrypt ($$) {
 339   my ($password, $userid) = @_;
 340
 341   return MAPSDB::Encrypt $password, $userid;
 342 } # Encrypt
 343
 344 sub FindEmail (;$) {
 345   my ($sender) = @_;
 346
 347   return MAPSDB::FindEmail $sender;
 348 } # FindEmail
 349
 350 sub FindList ($;$) {
 351   my ($type, $sender) = @_;
 352
 353   return MAPSDB::FindList $type, $sender;
 354 } # FindList
 355
 356 sub FindLog ($) {
 357   my ($how_many) = @_;
 358
 359   my $start_at = 0;
 360   my $end_at   = MAPSDB::countlog ();
 361
 362   if ($how_many < 0) {
 363     $start_at = $end_at - abs ($how_many);
 364     $start_at = 0 if ($start_at < 0);
 365   } # if
 366
 367   return MAPSDB::FindLog $start_at, $end_at;
 368 } # FindLog
 369
 370 sub FindUser (;$) {
 371   my ($userid) = @_;
 372
 373   return MAPSDB::FindUser $userid
 374 } # FindUser
 375
 376 sub GetContext () {
 377   return MAPSDB::GetContext ();
 378 } # GetContext
 379
 380 sub GetEmail ($) {
 381   my ($handle) = @_;
 382
 383   return MAPSDB::GetEmail $handle;
 384 } # GetEmail
 385
 386 sub GetList ($) {
 387   my ($handle) = @_;
 388
 389   return MAPSDB::GetList $handle;
 390 } # GetList
 391
 392 sub GetLog ($) {
 393   my ($handle) = @_;
 394
 395   return MAPSDB::GetLog $handle;
 396 } # GetLog
 397
 398 sub GetUser ($) {
 399   my ($handle) = @_;
 400
 401   return MAPSDB::GetUser $handle;
 402 } # GetUser
 403
 404 sub GetUserOptions ($) {
 405   my ($userid) = @_;
 406
 407   return MAPSDB::GetUserOptions $userid;
 408 } # GetUserOptions
 409
 410 sub Login ($$) {
 411   my ($userid, $password) = @_;
 412
 413   $password = Encrypt $password, $userid;
 414
 415   # Check if user exists
 416   my $dbpassword = UserExists $userid;
 417
 418   # Return -1 if user doesn't exist
 419   return -1 if !$dbpassword;
 420
 421   # Return -2 if password does not match
 422   if ($password eq $dbpassword) {
 423     MAPSDB::SetContext $userid;
 424     return 0
 425   } else {
 426     return -2
 427   } # if
 428 } # Login
 429
 430 sub Nulllist ($;$$) {
 431   # Nulllist will simply discard the message.
 432   my ($sender, $sequence, $hit_count) = @_;
 433
 434   RecordHit "null", $sequence, ++$hit_count if $sequence;
 435
 436   # Discard Message
 437   Logmsg "nulllist", $sender, "Discarded message";
 438 } # Nulllist
 439
 440 sub OnBlacklist ($) {
 441   my ($sender) = @_;
 442
 443   return CheckOnList "black", $sender;
 444 } # CheckOnBlacklist
 445
 446 sub OnNulllist ($) {
 447   my ($sender) = @_;
 448
 449   return CheckOnList "null", $sender;
 450 } # CheckOnNulllist
 451
 452 sub OnWhitelist {
 453   my ($sender, $userid) = @_;
 454
 455   if (defined $userid) {
 456     MAPSDB::SetContext $userid;
 457   } # if
 458
 459   return CheckOnList "white", $sender;
 460 } # OnWhitelist
 461
 462 sub OptimizeDB () {
 463   return MAPSDB::OptimizeDB ();
 464 } # OptimizeDB
 465
 466 sub ReadMsg ($) {
 467   # Reads an email message file from $input. Returns sender, subject,
 468   # date and data, which is a copy of the entire message.
 469   my ($input) = @_;
 470
 471   my $sender           = "";
 472   my $sender_long      = "";
 473   my $envelope_sender  = "";
 474   my $reply_to         = "";
 475   my $subject          = "";
 476   my $data             = "";
 477   my @data;
 478
 479   # Find first message's "From " line indicating start of message
 480   while (<$input>) {
 481     chomp;
 482     last if /^From /;
 483   } # while
 484
 485   # If we hit eof here then the message was garbled. Return indication of this
 486   if (eof $input) {
 487     $data = "Garbled message - unable to find From line";
 488     return $sender, $sender_long, $reply_to, $subject, $data;
 489   } # if
 490
 491   if (/From (\S*)/) {
 492     $envelope_sender = $1;
 493     $sender_long     = $envelope_sender;
 494   } # if
 495
 496   push @data, $_ if /^From /;
 497
 498   while (<$input>) {
 499     chomp;
 500     push @data, $_;
 501
 502     # Blank line indicates start of message body
 503     last if ($_ eq "" || $_ eq "\r");
 504
 505     # Extract sender's address
 506     if (/^from: .*/i) {
 507       $_ = substr ($_, 6);
 508
 509       $sender_long = $_;
 510
 511       if (/<(\S*)@(\S*)>/) {
 512         $sender = lc ("$1\@$2");
 513       } elsif (/(\S*)@(\S*)\ /) {
 514         $sender = lc ("$1\@$2");
 515       } elsif (/(\S*)@(\S*)/) {
 516         $sender = lc ("$1\@$2");
 517       } # if
 518     } elsif (/^subject: .*/i) {
 519       $subject = substr ($_, 9);
 520     } elsif (/^reply-to: .*/i) {
 521       $_ = substr ($_, 10);
 522       if (/<(\S*)@(\S*)>/) {
 523         $reply_to = lc ("$1\@$2");
 524       } elsif (/(\S*)@(\S*)\ /) {
 525         $reply_to = lc ("$1\@$2");
 526       } elsif (/(\S*)@(\S*)/) {
 527         $reply_to = lc ("$1\@$2");
 528       } # if
 529     } # if
 530   } # while
 531
 532   # Read message body
 533   while (<$input>) {
 534     chomp;
 535
 536     last if (/^From /);
 537     push @data, $_;
 538   } # while
 539
 540   # Set file pointer back by length of the line just read
 541   seek ($input, -length () - 1, 1) if !eof $input;
 542
 543   # Sanitize email addresses
 544   $envelope_sender =~ s/\<//g;
 545   $envelope_sender =~ s/\>//g;
 546   $envelope_sender =~ s/\"//g;
 547   $envelope_sender =~ s/\'//g;
 548   $sender          =~ s/\<//g;
 549   $sender          =~ s/\>//g;
 550   $sender          =~ s/\"//g;
 551   $sender          =~ s/\'//g;
 552   $reply_to        =~ s/\<//g;
 553   $reply_to        =~ s/\>//g;
 554   $reply_to        =~ s/\"//g;
 555   $reply_to        =~ s/\'//g;
 556
 557   # Determine best addresses
 558   $sender    = $envelope_sender if $sender eq "";
 559   $reply_to  = $sender          if $reply_to eq "";
 560
 561   return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
 562 } # ReadMsg
 563
 564 sub ResequenceList ($$) {
 565   my ($userid, $type) = @_;
 566
 567   return MAPSDB::ResequenceList $userid, $type;
 568 } # ResequenceList
 569
 570 sub ReturnMessages ($$) {
 571   my ($userid, $sender) = @_;
 572
 573   return MAPSDB::ReturnMessages $userid, $sender;
 574 } # ReturnMessages
 575
 576 sub ReturnSenders ($$$;$$) {
 577   my ($userid, $type, $next, $lines, $date) = @_;
 578
 579   return MAPSDB::ReturnSenders $userid, $type, $next, $lines, $date;
 580 } # ReturnSenders
 581
 582 sub ReturnList ($$$) {
 583   my ($type, $start_at, $lines)  = @_;
 584
 585   return MAPSDB::ReturnList $type, $start_at, $lines;
 586 } # ReturnList
 587
 588 sub ReturnListEntry ($$) {
 589   my ($type, $sequence) = @_;
 590
 591   return MAPSDB::ReturnListEntry $type, $sequence;
 592 } # ReturnList
 593
 594 # Added reply_to. Previously we passed reply_to into here as sender. This
 595 # caused a problem in that we were filtering as per sender but logging it
 596 # as reply_to. We only need reply_to for SendMsg so as to honor reply_to
 597 # so we now pass in both sender and reply_to
 598 sub ReturnMsg ($$$$) {
 599   # ReturnMsg will send back to the $sender the register message.
 600   # Messages are saved to be delivered when the $sender registers.
 601   my ($sender, $reply_to, $subject, $data) = @_;
 602
 603   # Check to see if this sender has already emailed us.
 604   my $msg_count = CountMsg $sender;
 605
 606   if ($msg_count < 5) {
 607     # Return register message
 608     my @msg;
 609     foreach (split /\n/,$data) {
 610       push @msg, "$_\n";
 611     } # foreach
 612     SendMsg $reply_to,
 613             "Your email has been returned by MAPS",
 614             "$mapsbase/register.html",
 615             GetContext,
 616             @msg
 617       if $msg_count eq 0;
 618     Logmsg "returned", $sender, "Sent register reply";
 619     # Save message
 620     SaveMsg $sender, $subject, $data;
 621   } else {
 622     Add2Nulllist $sender, GetContext, "Auto Null List - Mail loop";
 623     Logmsg "mailloop", $sender, "Mail loop encountered";
 624   } # if
 625 } # ReturnMsg
 626
 627 sub SaveMsg ($$$) {
 628   my ($sender, $subject, $data) = @_;
 629
 630   AddEmail $sender, $subject, $data;
 631 } # SaveMsg
 632
 633 sub SearchEmails ($$) {
 634   my ($userid, $searchfield) = @_;
 635
 636   return MAPSDB::SearchEmails $userid, $searchfield;
 637 } # SearchEmails
 638
 639 sub ForwardMsg ($$$) {
 640   my ($sender, $subject, $data)  = @_;
 641
 642   my @lines = split /\n/, $data;
 643
 644   while ($_ = shift @lines) {
 645     last if ($_ eq "" || $_ eq "\r");
 646   } # while
 647
 648   my $to = "renn.leech\@compassbank.com";
 649
 650   my $msg = MIME::Entity->build (
 651     From  => $sender,
 652     To    => $to,
 653     Subject  => $subject,
 654     Type  => "text/html",
 655     Data  => \@lines,
 656   );
 657
 658   # Send it
 659   open MAIL, "| /usr/lib/sendmail -t -oi -oem"
 660     or die "ForwardMsg: Unable to open pipe to sendmail $!";
 661   $msg->print(\*MAIL);
 662   close MAIL;
 663 } # ForwardMsg
 664
 665 sub SendMsg ($$$$@) {
 666   # SendMsg will send the message contained in $msgfile.
 667   my ($sender, $subject, $msgfile, $userid, @spammsg) = @_;
 668
 669   my @lines;
 670
 671   # Open return message template file
 672   open RETURN_MSG_FILE, "$msgfile"
 673     or die "Unable to open return msg file ($msgfile): $!\n";
 674
 675   # Read return message template file and print it to $msg_body
 676   while (<RETURN_MSG_FILE>) {
 677     if (/\$userid/) {
 678       # Replace userid
 679       s/\$userid/$userid/;
 680     } # if
 681     if (/\$sender/) {
 682       # Replace sender
 683       s/\$sender/$sender/;
 684     } #if
 685     push @lines, $_;
 686   } # while
 687
 688   # Close RETURN_MSG_FILE
 689   close RETURN_MSG_FILE;
 690
 691   # Create the message, and set up the mail headers:
 692   my $msg = MIME::Entity->build (
 693     From  => "MAPS\@DeFaria.com",
 694     To    => $sender,
 695     Subject  => $subject,
 696     Type  => "text/html",
 697     Data  => \@lines
 698   );
 699
 700   # Need to obtain the spam message here...
 701   $msg->attach (
 702     Type  => "message",
 703     Disposition  => "attachment",
 704     Data  => \@spammsg
 705   );
 706
 707   # Send it
 708   open MAIL, "| /usr/lib/sendmail -t -oi -oem"
 709     or die "SendMsg: Unable to open pipe to sendmail $!";
 710   $msg->print(\*MAIL);
 711   close MAIL;
 712 } # SendMsg
 713
 714 sub SetContext ($) {
 715   my ($new_user) = @_;
 716
 717   return MAPSDB::SetContext $new_user;
 718 } # SetContext
 719
 720 sub Space ($) {
 721   my ($userid) = @_;
 722
 723   return MAPSDB::Space $userid;
 724 } # Space
 725
 726 sub UpdateList ($$$$$$) {
 727   my ($userid, $type, $pattern, $domain, $comment, $sequence) = @_;
 728
 729   return MAPSDB::UpdateList $userid, $type, $pattern, $domain, $comment, $sequence;
 730 } # UpdateList
 731
 732 sub UpdateUser ($$$$) {
 733   my ($userid, $fullname, $email, $password) = @_;
 734
 735   return MAPSDB::UpdateUser $userid, $fullname, $email, $password;
 736 } # UpdateUser
 737
 738 sub UpdateUserOptions ($@) {
 739   my ($userid, %options)  = @_;
 740
 741   my $status;
 742
 743   foreach (keys (%options)) {
 744     $status = MAPSDB::UpdateUserOption $userid, $_, $options{$_};
 745     last if $status ne 0;
 746   }
 747
 748   return $status;
 749 } # UpdateUserOptions
 750
 751 sub UserExists ($) {
 752   my ($userid) = @_;
 753
 754   return MAPSDB::UserExists $userid
 755 } # UserExists
 756
 757 sub Whitelist ($$;$$) {
 758   # Whitelist will deliver the message.
 759   my ($sender, $data, $sequence, $hit_count) = @_;
 760
 761   my $userid = GetContext;
 762
 763   # Dump message into a file
 764   open MESSAGE, ">/tmp/MAPSMessage.$$"
 765     or Error "Unable to open message file (/tmp/MAPSMessage.$$): $!\n", return -1;
 766
 767   print MESSAGE $data;
 768
 769   close MESSAGE;
 770
 771   # Now call MAPSDeliver
 772   my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
 773
 774   unlink "/tmp/MAPSMessage.$$";
 775
 776   if ($status eq 0) {
 777     Logmsg "whitelist", $sender, "Delivered message";
 778   } else {
 779     Error "Unable to deliver message - is MAPSDeliver setgid? - $!";
 780   } # if
 781
 782   RecordHit "white", $sequence, ++$hit_count if $sequence;
 783
 784   return $status;
 785 } # Whitelist
 786
 787 1;