maps/lib/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-2018, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 package MAPS;
  16
  17 use strict;
  18 use warnings;
  19
  20 use DBI;
  21 use Carp;
  22 use FindBin;
  23 use vars qw(@ISA @EXPORT);
  24 use Exporter;
  25
  26 use MAPSLog;
  27 use MAPSFile;
  28 use MAPSUtil;
  29 use MIME::Entity;
  30
  31 # Globals
  32 my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER};
  33 my %useropts;
  34 my $DB;
  35
  36 @ISA = qw(Exporter);
  37
  38 @EXPORT = qw(
  39   Add2Blacklist
  40   Add2Nulllist
  41   Add2Whitelist
  42   AddEmail
  43   AddList
  44   AddLog
  45   AddUser
  46   AddUserOptions
  47   Blacklist
  48   CleanEmail
  49   CleanLog
  50   CleanList
  51   CountMsg
  52   Decrypt
  53   DeleteEmail
  54   DeleteList
  55   DeleteLog
  56   Encrypt
  57   FindEmail
  58   FindList
  59   FindLog
  60   FindUser
  61   ForwardMsg
  62   GetContext
  63   GetEmail
  64   GetList
  65   GetLog
  66   GetNextSequenceNo
  67   GetRows
  68   GetUser
  69   GetUserOptions
  70   ListLog
  71   ListUsers
  72   Login
  73   Nulllist
  74   OnBlacklist
  75   OnNulllist
  76   OnWhitelist
  77   OptimizeDB
  78   ReadMsg
  79   ResequenceList
  80   ReturnList
  81   ReturnListEntry
  82   ReturnMsg
  83   ReturnMessages
  84   ReturnSenders
  85   SaveMsg
  86   SearchEmails
  87   SetContext
  88   Space
  89   UpdateList
  90   UpdateUser
  91   UpdateUserOptions
  92   UserExists
  93   Whitelist
  94   count
  95   countlog
  96   count_distinct
  97 );
  98
  99 my $mapsbase = "$FindBin::Bin/..";
 100
 101 sub Add2Blacklist($$$) {
 102   # Add2Blacklist will add an entry to the blacklist
 103   my ($sender, $userid, $comment) = @_;
 104
 105   # First SetContext to the userid whose black list we are adding to
 106   SetContext($userid);
 107
 108   # Add to black list
 109   AddList("black", $sender, 0, $comment);
 110
 111   # Log that we black listed the sender
 112   Info("Added $sender to " . ucfirst $userid . "'s black list");
 113
 114   # Delete old emails
 115   my $count = DeleteEmail($sender);
 116
 117   # Log out many emails we managed to remove
 118   Info("Removed $count emails from $sender");
 119
 120   return;
 121 } # Add2Blacklist
 122
 123 sub Add2Nulllist($$;$$) {
 124   # Add2Nulllist will add an entry to the nulllist
 125   my ($sender, $userid, $comment, $hit_count) = @_;
 126
 127   # First SetContext to the userid whose null list we are adding to
 128   SetContext($userid);
 129
 130   # Add to null list
 131   AddList("null", $sender, 0, $comment, $hit_count);
 132
 133   # Log that we null listed the sender
 134   Info("Added $sender to " . ucfirst $userid . "'s null list");
 135
 136   # Delete old emails
 137   my $count = DeleteEmail($sender);
 138
 139   # Log out many emails we managed to remove
 140   Info("Removed $count emails from $sender");
 141
 142   return;
 143 } # Add2Nulllist
 144
 145 sub Add2Whitelist($$;$) {
 146   # Add2Whitelist will add an entry to the whitelist
 147   my ($sender, $userid, $comment) = @_;
 148
 149   # First SetContext to the userid whose white list we are adding to
 150   SetContext($userid);
 151
 152   # Add to white list
 153   AddList('white', $sender, 0, $comment);
 154
 155   # Log that we registered a user
 156   Logmsg("registered", $sender, "Registered new sender");
 157
 158   # Check to see if there are any old messages to deliver
 159   my $handle = FindEmail($sender);
 160
 161   my ($dbsender, $subject, $timestamp, $message);
 162
 163   # Deliver old emails
 164   my $messages      = 0;
 165   my $return_status = 0;
 166
 167   while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail($handle)) {
 168     last unless $userid;
 169
 170     $return_status = Whitelist($sender, $message);
 171
 172     last if $return_status;
 173
 174     $messages++;
 175   } # while
 176
 177   # Done with $handle
 178   $handle->finish;
 179
 180   # Return if we has a problem delivering email
 181   return $return_status if $return_status;
 182
 183   # Remove delivered messages.
 184   DeleteEmail($sender);
 185
 186   return $messages;
 187 } # Add2Whitelist
 188
 189 sub AddEmail($$$) {
 190   my ($sender, $subject, $data) = @_;
 191
 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);
 197
 198   my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime));
 199   my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)";
 200
 201   $DB->do ($statement)
 202     or DBError('AddEmail: Unable to do statement', $statement);
 203
 204   return;
 205 } # AddEmail
 206
 207 sub AddList($$$;$$$) {
 208   my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_;
 209
 210   $hit_count //= CountMsg($pattern);
 211
 212   my ($user, $domain)  = split /\@/, $pattern;
 213
 214   if (!$domain || $domain eq '') {
 215     $domain  = 'NULL';
 216     $pattern = $DB->quote($user);
 217   } else {
 218     $domain  = "'$domain'";
 219
 220     if ($user eq '') {
 221       $pattern = 'NULL';
 222     } else {
 223       $pattern = $DB->quote($user);
 224     } # if
 225   } # if
 226
 227   if (!$comment || $comment eq '') {
 228     $comment = 'NULL';
 229   } else {
 230     $comment = $DB->quote($comment);
 231   } # if
 232
 233   # Get next sequence #
 234   if ($sequence == 0) {
 235     $sequence = GetNextSequenceNo($userid, $listtype);
 236   } # if
 237
 238   $last_hit //= UnixDatetime2SQLDatetime(scalar (localtime));
 239
 240   my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hit_count, \"$last_hit\")";
 241
 242   $DB->do($statement)
 243     or DBError('AddList: Unable to do statement', $statement);
 244
 245   return;
 246 } # AddList
 247
 248 sub AddLog ($$$) {
 249   my ($type, $sender, $msg) = @_;
 250
 251   my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime));
 252   my $statement;
 253
 254   # Use quote to protect ourselves
 255   $msg = $DB->quote($msg);
 256
 257   if ($sender eq '') {
 258     $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)";
 259   } else {
 260     $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)";
 261   } # if
 262
 263   $DB->do($statement)
 264     or DBError('AddLog: Unable to do statement', $statement);
 265
 266   return;
 267 } # AddLog
 268
 269 sub AddUser($$$$) {
 270   my ($userid, $realname, $email, $password) = @_;
 271
 272   $password = Encrypt($password, $userid);
 273
 274   if (UserExists($userid)) {
 275     return 1;
 276   } else {
 277     my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')";
 278
 279     $DB->do($statement)
 280       or DBError('AddUser: Unable to do statement', $statement);
 281   } # if
 282
 283   return 0;
 284 } # Adduser
 285
 286 sub AddUserOptions($%) {
 287   my ($userid, %options) = @_;
 288
 289   for (keys %options) {
 290     return 1 if !UserExists($userid);
 291
 292     my $statement = "insert into useropts values ('$userid', '$_', '$options{$_}')";
 293
 294     $DB->do($statement)
 295       or DBError('AddUserOption: Unable to do statement', $statement);
 296   } # for
 297
 298   return 0;
 299 } # AddUserOptions
 300
 301 sub Blacklist($%) {
 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)  = @_;
 306
 307   # Check to see if this sender has already emailed us.
 308   my $msg_count = CountMsg($sender);
 309
 310   if ($msg_count < 5) {
 311     # Bounce email
 312     SendMsg($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg);
 313     Logmsg("blacklist", $sender, "Sent blacklist reply");
 314   } else {
 315     Logmsg("mailloop", $sender, "Mail loop encountered");
 316   } # if
 317
 318   RecordHit("black", $sequence, ++$hit_count) if $sequence;
 319
 320   return;
 321 } # Blacklist
 322
 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) = @_;
 327
 328   $update //= 1;
 329
 330   my $status = 0;
 331   my ($rule, $sequence, $hit_count);
 332
 333   my $statement = 'select pattern, domain, comment, sequence, hit_count '
 334                 . "from list where userid = '$userid' and type = '$listtype' "
 335                 . 'order by sequence';
 336
 337   my $sth = $DB->prepare($statement)
 338     or DBError('CheckOnList: Unable to prepare statement', $statement);
 339
 340   $sth->execute
 341     or DBError('CheckOnList: Unable to execute statement', $statement);
 342
 343   while (my @row = $sth->fetchrow_array) {
 344     last if !@row;
 345
 346        $hit_count = pop (@row);
 347        $sequence  = pop (@row);
 348     my $comment   = pop (@row);
 349     my $domain    = pop (@row);
 350     my $pattern   = pop (@row);
 351     my $email_on_file;
 352
 353     unless ($domain) {
 354       $email_on_file = $pattern;
 355     } else {
 356       unless ($pattern) {
 357         $email_on_file = '@' . $domain;
 358       } else {
 359         $email_on_file = $pattern . '@' . $domain;
 360       } # if
 361     } # unless
 362
 363     # Escape some special characters
 364     $email_on_file =~ s/\@/\\@/;
 365     $email_on_file =~ s/^\*/.\*/;
 366
 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 =~ /\@/
 375                    ? "$email_on_file\$"
 376                    : !defined $domain
 377                    ? "$email_on_file\@"
 378                    : $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 '';
 382       $status = 1;
 383
 384       RecordHit($listtype, $sequence, ++$hit_count) if $update;
 385
 386       last;
 387     } # if
 388   } # while
 389
 390   $sth->finish;
 391
 392   return ($status, $rule, $sequence, $hit_count);
 393 } # CheckOnList
 394
 395 sub CleanEmail($) {
 396   my ($timestamp) = @_;
 397
 398   # First see if anything needs to be deleted
 399   my $count = 0;
 400
 401   my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'";
 402
 403   # Prepare statement
 404   my $sth = $DB->prepare($statement)
 405     or DBError('CleanEmail: Unable to prepare statement', $statement);
 406
 407   # Execute statement
 408   $sth->execute
 409     or DBError('CleanEmail: Unable to execute statement', $statement);
 410
 411   # Get return value, which should be how many entries were deleted
 412   my @row = $sth->fetchrow_array;
 413
 414   # Done with $sth
 415   $sth->finish;
 416
 417   # Retrieve returned value
 418   unless ($row[0]) {
 419     $count = 0
 420   } else {
 421     $count = $row[0];
 422   } # unless
 423
 424   # Just return if there's nothing to delete
 425   return $count if ($count == 0);
 426
 427   # Delete emails for userid whose older than $timestamp
 428   $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
 429
 430   # Prepare statement
 431   $sth = $DB->prepare($statement)
 432     or DBError('CleanEmail: Unable to prepare statement', $statement);
 433
 434   # Execute statement
 435   $sth->execute
 436     or DBError('CleanEmail: Unable to execute statement', $statement);
 437
 438   return $count;
 439 } # ClearEmail
 440
 441 sub CleanLog($) {
 442   my ($timestamp) = @_;
 443
 444   # First see if anything needs to be deleted
 445   my $count = 0;
 446
 447   my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'";
 448
 449   # Prepare statement
 450   my $sth = $DB->prepare($statement)
 451     or DBError($DB, 'CleanLog: Unable to prepare statement', $statement);
 452
 453   # Execute statement
 454   $sth->execute
 455     or DBError('CleanLog: Unable to execute statement', $statement);
 456
 457   # Get return value, which should be how many entries were deleted
 458   my @row = $sth->fetchrow_array;
 459
 460   # Done with $sth
 461   $sth->finish;
 462
 463   # Retrieve returned value
 464   unless ($row[0]) {
 465     $count = 0
 466   } else {
 467     $count = $row[0];
 468   } # unless
 469
 470   # Just return if there's nothing to delete
 471   return $count if ($count == 0);
 472
 473   # Delete log entries for userid whose older than $timestamp
 474   $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
 475
 476   # Prepare statement
 477   $sth = $DB->prepare($statement)
 478     or DBError('CleanLog: Unable to prepare statement', $statement);
 479
 480   # Execute statement
 481   $sth->execute
 482     or DBError('CleanLog: Unable to execute statement', $statement);
 483
 484   return $count;
 485 } # CleanLog
 486
 487 sub CleanList($;$) {
 488   my ($timestamp, $listtype) = @_;
 489
 490   $listtype //= 'null';
 491
 492   # First see if anything needs to be deleted
 493   my $count = 0;
 494
 495   my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
 496
 497   # Prepare statement
 498   my $sth = $DB->prepare($statement)
 499     or DBError($DB, 'CleanList: Unable to prepare statement', $statement);
 500
 501   # Execute statement
 502   $sth->execute
 503     or DBError('CleanList: Unable to execute statement', $statement);
 504
 505   # Get return value, which should be how many entries were deleted
 506   my @row = $sth->fetchrow_array;
 507
 508   # Done with $sth
 509   $sth->finish;
 510
 511   # Retrieve returned value
 512   $count = $row[0] ? $row[0] : 0;
 513
 514   # Just return if there's nothing to delete
 515   return $count if ($count == 0);
 516
 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'";
 519
 520   # Prepare statement
 521   $sth = $DB->prepare($statement)
 522     or DBError('CleanList: Unable to prepare statement', $statement);
 523
 524   # Execute statement
 525   $sth->execute
 526     or DBError('CleanList: Unable to execute statement', $statement);
 527
 528   $count = 0;
 529
 530   while (my @row = $sth->fetchrow_array) {
 531     last if !@row;
 532
 533     my $hit_count = pop(@row);
 534     my $sequence  = pop(@row);
 535     my $listtype  = pop(@row);
 536
 537     if ($hit_count == 0) {
 538       $count++;
 539
 540       $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence";
 541       $DB->do($statement)
 542         or DBError('CleanList: Unable to execute statement', $statement);
 543     } else {
 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!
 552       #
 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) {
 556         $hit_count--;
 557       } else {
 558         $hit_count = int($hit_count / 1.1);
 559       } # if
 560
 561       $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;";
 562       $DB->do($statement)
 563         or DBError('CleanList: Unable to execute statement', $statement);
 564     } # if
 565   } # while
 566
 567   ResequenceList($userid, $listtype);
 568
 569   return $count;
 570 } # CleanList
 571
 572 sub CloseDB() {
 573   $DB->disconnect;
 574
 575   return;
 576 } # CloseDB
 577
 578 sub CountMsg($) {
 579   my ($sender) = @_;
 580
 581   return count('email', "userid = '$userid' and sender like '%$sender%'");
 582 } # CountMsg
 583
 584 sub DBError($$) {
 585   my ($msg, $statement) = @_;
 586
 587   print 'MAPS::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n";
 588
 589   if ($statement) {
 590     print "SQL Statement: $statement\n";
 591   } # if
 592
 593   exit $DB->err;
 594 } # DBError
 595
 596 sub Decrypt ($$) {
 597   my ($password, $userid) = @_;
 598
 599   my $statement = "select decode('$password','$userid')";
 600
 601   my $sth = $DB->prepare($statement)
 602     or DBError('Decrypt: Unable to prepare statement', $statement);
 603
 604   $sth->execute
 605     or DBError('Decrypt: Unable to execute statement', $statement);
 606
 607   # Get return value, which should be the encoded password
 608   my @row = $sth->fetchrow_array;
 609
 610   # Done with $sth
 611   $sth->finish;
 612
 613   return $row[0]
 614 } # Decrypt
 615
 616 sub DeleteEmail($) {
 617   my $sender = shift;
 618
 619   my ($username, $domain) = split /@/, $sender;
 620   my $condition;
 621
 622   if ($username eq '') {
 623     $condition = "userid = '$userid' and sender like '%\@$domain'";
 624   } else {
 625     $condition = "userid = '$userid' and sender = '$sender'";
 626   } # if
 627
 628   # First see if anything needs to be deleted
 629   my $count = count('email', $condition);
 630
 631   # Just return if there's nothing to delete
 632   return $count if ($count == 0);
 633
 634   my $statement = 'delete from email where ' . $condition;
 635
 636   $DB->do($statement)
 637     or DBError('DeleteEmail: Unable to execute statement', $statement);
 638
 639   return $count;
 640 } # DeleteEmail
 641
 642 sub DeleteList($$) {
 643   my ($type, $sequence) = @_;
 644
 645   # First see if anything needs to be deleted
 646   my $count = count('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
 647
 648   # Just return if there's nothing to delete
 649   return $count if ($count == 0);
 650
 651   my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
 652
 653   $DB->do($statement)
 654     or DBError('DeleteList: Unable to execute statement', $statement);
 655
 656   return $count;
 657 } # DeleteList
 658
 659 sub DeleteLog($) {
 660   my ($sender) = @_;
 661
 662   my ($username, $domain) = split /@/, $sender;
 663   my $condition;
 664
 665   if ($username eq '') {
 666     $condition = "userid = '$userid' and sender like '%\@$domain'";
 667   } else {
 668     $condition = "userid = '$userid' and sender = '$sender'";
 669   } # if
 670
 671   # First see if anything needs to be deleted
 672   my $count = count('log', $condition);
 673
 674   # Just return if there's nothing to delete
 675   return $count if ($count == 0);
 676
 677   my $statement = 'delete from log where ' . $condition;
 678
 679   $DB->do($statement)
 680     or DBError('DeleteLog: Unable to execute statement', $statement);
 681
 682   return $count;
 683 } # DeleteLog
 684
 685 sub Encrypt($$) {
 686   my ($password, $userid) = @_;
 687
 688   my $statement = "select encode('$password','$userid')";
 689
 690   my $sth = $DB->prepare($statement)
 691     or DBError('Encrypt: Unable to prepare statement', $statement);
 692
 693   $sth->execute
 694     or DBError('Encrypt: Unable to execute statement', $statement);
 695
 696   # Get return value, which should be the encoded password
 697   my @row = $sth->fetchrow_array;
 698
 699   # Done with $sth
 700   $sth->finish;
 701
 702   return $row[0];
 703 } # Encrypt
 704
 705 sub FindEmail(;$$) {
 706   my ($sender, $date) = @_;
 707
 708   my $statement;
 709
 710   $sender //= '';
 711   $date   //= '';
 712
 713   $statement  = "select * from email where userid = '$userid'";
 714
 715   # Add conditions if present
 716   $statement .= " and sender = '$sender'"  if $sender;
 717   $statement .= " and timestamp = '$date'" if $date;
 718
 719   my $sth = $DB->prepare($statement)
 720     or DBError('FindEmail: Unable to prepare statement', $statement);
 721
 722   $sth->execute
 723     or DBError('FindEmail: Unable to execute statement', $statement);
 724
 725   return $sth;
 726 } # FindEmail
 727
 728 sub FindList($;$) {
 729   my ($type, $sender) = @_;
 730
 731   my $statement;
 732
 733   unless ($sender) {
 734     $statement = "select * from list where userid = '$userid' and type = '$type'";
 735   } else {
 736     my ($pattern, $domain) = split /\@/, $sender;
 737     $statement = "select * from list where userid = '$userid' and type = '$type' " .
 738                  "and pattern = '$pattern' and domain = '$domain'";
 739   } # unless
 740
 741   # Prepare statement
 742   my $sth = $DB->prepare($statement)
 743     or DBError('FindList: Unable to prepare statement', $statement);
 744
 745   # Execute statement
 746   $sth->execute
 747     or DBError('FindList: Unable to execute statement', $statement);
 748
 749   # Get return value, which should be how many entries were deleted
 750   return $sth;
 751 } # FindList
 752
 753 sub FindLog($) {
 754   my ($how_many) = @_;
 755
 756   my $start_at = 0;
 757   my $end_at   = countlog();
 758
 759   if ($how_many < 0) {
 760     $start_at = $end_at - abs ($how_many);
 761     $start_at = 0 if ($start_at < 0);
 762   } # if
 763
 764   my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
 765
 766   # Prepare statement
 767   my $sth = $DB->prepare($statement)
 768     or DBError('FindLog: Unable to prepare statement', $statement);
 769
 770   # Execute statement
 771   $sth->execute
 772     or DBError('FindLog: Unable to execute statement', $statement);
 773
 774   # Get return value, which should be how many entries were deleted
 775   return $sth;
 776 } # FindLog
 777
 778 sub FindUser(;$) {
 779   my ($userid) = @_;
 780
 781   my $statement;
 782
 783   if (!defined $userid || $userid eq '') {
 784     $statement = 'select * from user';
 785   } else {
 786     $statement = "select * from user where userid = '$userid'";
 787   } # if
 788
 789   my $sth = $DB->prepare($statement)
 790     or DBError('FindUser: Unable to prepare statement', $statement);
 791
 792   $sth->execute
 793     or DBError('FindUser: Unable to execute statement', $statement);
 794
 795   return $sth;
 796 } # FindUser
 797
 798 sub GetContext() {
 799   return $userid;
 800 } # GetContext
 801
 802 sub GetEmail($) {
 803   my ($sth) = @_;
 804
 805   my @email;
 806
 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;
 814   } else {
 815     return;
 816   } # if
 817 } # GetEmail
 818
 819 sub GetList($) {
 820   my ($sth) = @_;
 821
 822   my @list;
 823
 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;
 834   } else {
 835     return;
 836   } # if
 837 } # GetList
 838
 839 sub GetLog($) {
 840   my ($sth) = @_;
 841
 842   my @log;
 843
 844   if (@log = $sth->fetchrow_array) {
 845     my $message   = pop @log;
 846     my $type      = pop @log;
 847     my $sender    = pop @log;
 848     my $timestamp = pop @log;
 849     my $userid    = pop @log;
 850     return $userid, $timestamp, $sender, $type, $message;
 851   } else {
 852     return;
 853   } # if
 854 } # GetLog
 855
 856 sub GetNextSequenceNo($$) {
 857   my ($userid, $listtype) = @_;
 858
 859   my $count = count ('list', "userid = '$userid' and type = '$listtype'");
 860
 861   return $count + 1;
 862 } # GetNextSequenceNo
 863
 864 sub GetUser($) {
 865   my ($sth) = @_;
 866
 867   my @user;
 868
 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);
 875   } else {
 876     return;
 877   } # if
 878 } # GetUser
 879
 880 sub GetUserInfo($) {
 881   my ($userid) = @_;
 882
 883   my $statement = "select name, email from user where userid='$userid'";
 884
 885   my $sth = $DB->prepare($statement)
 886     or DBError('GetUserInfo: Unable to prepare statement', $statement);
 887
 888   $sth->execute
 889     or DBError('GetUserInfo: Unable to execute statement', $statement);
 890
 891   my @userinfo   = $sth->fetchrow_array;
 892   my $user_email = lc (pop @userinfo);
 893   my $username   = lc (pop @userinfo);
 894
 895   $sth->finish;
 896
 897   return ($username, $user_email);
 898 } # GetUserInfo
 899
 900 sub GetUserOptions($) {
 901   my ($userid) = @_;
 902
 903   my $statement = "select * from useropts where userid = '$userid'";
 904
 905   my $sth = $DB->prepare($statement)
 906     or DBError('GetUserOptions: Unable to prepare statement', $statement);
 907
 908   $sth->execute
 909     or DBError('GetUserOptions: Unable to execute statement', $statement);
 910
 911   my @useropts;
 912
 913   # Empty hash
 914   %useropts = ();
 915
 916   while (@useropts = $sth->fetchrow_array) {
 917     my $value = pop @useropts;
 918     my $name  = pop @useropts;
 919
 920     pop @useropts;
 921
 922     $useropts{$name} = $value;
 923   } # while
 924
 925   $sth->finish;
 926
 927   return %useropts;
 928 } # GetUserOptions
 929
 930 sub GetRows ($) {
 931   my ($statement) = @_;
 932
 933   my $sth = $DB->prepare($statement)
 934     or DBError('Unable to prepare statement' , $statement);
 935
 936   $sth->execute
 937     or DBError('Unable to execute statement' , $statement);
 938
 939   my @array;
 940
 941   while (my @row = $sth->fetchrow_array) {
 942     for (@row) {
 943       push @array, $_;
 944     } # for
 945   } # while
 946
 947   return @array;
 948 } # GetRows
 949
 950 sub Login($$) {
 951   my ($userid, $password) = @_;
 952
 953   $password = Encrypt($password, $userid);
 954
 955   # Check if user exists
 956   my $dbpassword = UserExists($userid);
 957
 958   # Return -1 if user doesn't exist
 959   return -1 if !$dbpassword;
 960
 961   # Return -2 if password does not match
 962   if ($password eq $dbpassword) {
 963     SetContext($userid);
 964     return 0
 965   } else {
 966     return -2
 967   } # if
 968 } # Login
 969
 970 sub Nulllist($;$$) {
 971   # Nulllist will simply discard the message.
 972   my ($sender, $sequence, $hit_count) = @_;
 973
 974   RecordHit("null", $sequence, ++$hit_count) if $sequence;
 975
 976   # Discard Message
 977   Logmsg("nulllist", $sender, "Discarded message");
 978
 979   return;
 980 } # Nulllist
 981
 982 sub OnBlacklist($;$) {
 983   my ($sender, $update) = @_;
 984
 985   return CheckOnList('black', $sender, $update);
 986 } # OnBlacklist
 987
 988 sub OnNulllist($;$) {
 989   my ($sender, $update) = @_;
 990
 991   return CheckOnList("null", $sender, $update);
 992 } # CheckOnNulllist
 993
 994 sub OnWhitelist($;$$) {
 995   my ($sender, $userid, $update) = @_;
 996
 997   SetContext($userid) if $userid;
 998
 999   return CheckOnList("white", $sender, $update);
1000 } # OnWhitelist
1001
1002 sub OpenDB($$) {
1003   my ($username, $password) = @_;
1004
1005   my $dbname   = 'MAPS';
1006   my $dbdriver = 'mysql';
1007   my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
1008
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;
1013   } # if
1014
1015   return $DB;
1016 } # OpenDB
1017
1018 BEGIN {
1019   my $MAPS_username = "maps";
1020   my $MAPS_password = "spam";
1021
1022   OpenDB($MAPS_username, $MAPS_password);
1023 } # BEGIN
1024
1025 END {
1026   CloseDB;
1027 } # END
1028
1029
1030 sub OptimizeDB() {
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);
1034
1035   $sth->execute
1036     or DBError('OptimizeDB: Unable to execute statement', $statement);
1037
1038   $statement = 'check table email, list, log, user, useropts';
1039   $sth = $DB->prepare($statement)
1040       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1041
1042   $sth->execute
1043     or DBError('OptimizeDB: Unable to execute statement', $statement);
1044
1045   $statement = 'unlock tables';
1046   $sth = $DB->prepare($statement)
1047       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1048
1049   $sth->execute
1050     or DBError('OptimizeDB: Unable to execute statement', $statement);
1051
1052   $statement = 'optimize table email, list, log, user, useropts';
1053   $sth = $DB->prepare($statement)
1054       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1055
1056   $sth->execute
1057     or DBError('OptimizeDB: Unable to execute statement', $statement);
1058
1059   return;
1060 } # OptimizeDB
1061
1062 sub ReadMsg($) {
1063   # Reads an email message file from $input. Returns sender, subject,
1064   # date and data, which is a copy of the entire message.
1065   my ($input) = @_;
1066
1067   my $sender          = '';
1068   my $sender_long     = '';
1069   my $envelope_sender = '';
1070   my $reply_to        = '';
1071   my $subject         = '';
1072   my $data            = '';
1073   my @data;
1074
1075   # Find first message's "From " line indicating start of message
1076   while (<$input>) {
1077     chomp;
1078     last if /^From /;
1079   } # while
1080
1081   # If we hit eof here then the message was garbled. Return indication of this
1082   if (eof($input)) {
1083     $data = "Garbled message - unable to find From line";
1084     return $sender, $sender_long, $reply_to, $subject, $data;
1085   } # if
1086
1087   if (/From (\S*)/) {
1088     $envelope_sender = $1;
1089     $sender_long     = $envelope_sender;
1090   } # if
1091
1092   push @data, $_ if /^From /;
1093
1094   while (<$input>) {
1095     chomp;
1096     push @data, $_;
1097
1098     # Blank line indicates start of message body
1099     last if ($_ eq "" || $_ eq "\r");
1100
1101     # Extract sender's address
1102     if (/^from: .*/i) {
1103       $_ = substr ($_, 6);
1104
1105       $sender_long = $_;
1106
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");
1113       } # if
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");
1124       } # if
1125     } # if
1126   } # while
1127
1128   # Read message body
1129   while (<$input>) {
1130     chomp;
1131
1132     last if (/^From /);
1133     push @data, $_;
1134   } # while
1135
1136   # Set file pointer back by length of the line just read
1137   seek ($input, -length () - 1, 1) if !eof $input;
1138
1139   # Sanitize email addresses
1140   $envelope_sender =~ s/\<//g;
1141   $envelope_sender =~ s/\>//g;
1142   $envelope_sender =~ s/\"//g;
1143   $envelope_sender =~ s/\'//g;
1144   $sender          =~ s/\<//g;
1145   $sender          =~ s/\>//g;
1146   $sender          =~ s/\"//g;
1147   $sender          =~ s/\'//g;
1148   $reply_to        =~ s/\<//g;
1149   $reply_to        =~ s/\>//g;
1150   $reply_to        =~ s/\"//g;
1151   $reply_to        =~ s/\'//g;
1152
1153   # Determine best addresses
1154   $sender    = $envelope_sender if $sender eq "";
1155   $reply_to  = $sender          if $reply_to eq "";
1156
1157   return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
1158 } # ReadMsg
1159
1160 sub RecordHit($$$) {
1161   my ($listtype, $sequence, $hit_count) = @_;
1162
1163   my $current_date = UnixDatetime2SQLDatetime(scalar(localtime));
1164
1165   my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
1166
1167   $DB->do($statement)
1168     or DBError('RecordHit: Unable to do statement', $statement);
1169
1170   return;
1171 } # RecordHit
1172
1173 sub ResequenceList($$) {
1174   my ($userid, $type) = @_;
1175
1176   return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1177
1178   return 2 unless UserExists($userid);
1179
1180   my $statement = 'lock tables list write';
1181   my $sth = $DB->prepare($statement)
1182       or DBError('ResquenceList: Unable to prepare statement', $statement);
1183
1184   $sth->execute
1185     or DBError('ResequenceList: Unable to execute statement', $statement);
1186
1187   # Now get all of the list entries renumbering as we go
1188   $statement = <<"END";
1189 select
1190   pattern,
1191   domain,
1192   comment,
1193   sequence,
1194   hit_count,
1195   last_hit
1196 from
1197   list
1198 where
1199   userid = '$userid' and
1200   type   = '$type'
1201 order by
1202   hit_count desc
1203 END
1204
1205   $sth = $DB->prepare($statement)
1206     or DBError('ResequenceList: Unable to prepare statement', $statement);
1207
1208   $sth->execute
1209     or DBError('ResequenceList: Unable to execute statement', $statement);
1210
1211   my $sequence = 1;
1212   my @new_rows;
1213
1214   while (my @row = $sth->fetchrow_array) {
1215     last if !@row;
1216
1217     my %record = (
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) || '',
1225     );
1226
1227     push @new_rows, \%record;
1228   } # while
1229
1230   # Delete all of the list entries for this $userid and $type
1231   $statement = "delete from list where userid='$userid' and type='$type'";
1232
1233   $DB->do($statement)
1234     or DBError('ResequenceList: Unable to do statement', $statement);
1235
1236   # Re-add list with new sequence numbers
1237   for (@new_rows) {
1238     my %record = %$_;
1239     my $statement = <<"END";
1240 insert into
1241   list
1242 values (
1243   '$userid',
1244   '$type',
1245   $record{pattern},
1246   $record{domain},
1247   $record{comment},
1248   '$record{new_sequence}',
1249   '$record{hit_count}',
1250   '$record{last_hit}'
1251 )
1252 END
1253
1254   $DB->do($statement)
1255     or DBError('ResequenceList: Unable to do statement', $statement);
1256   } # for
1257
1258   $statement = 'unlock tables';
1259   $sth = $DB->prepare($statement)
1260       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1261
1262   $sth->execute
1263     or DBError('OptimizeDB: Unable to execute statement', $statement);
1264
1265   return 0;
1266 } # ResequenceList
1267
1268 sub ResequenceListold($$) {
1269   my ($userid, $type) = @_;
1270
1271   return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1272
1273   return 2 unless UserExists($userid);
1274
1275   my $statement = "select sequence from list where userid = '$userid' "
1276                 . " and type = '$type' order by sequence";
1277
1278   my $sth = $DB->prepare($statement)
1279     or DBError('ResequenceList: Unable to prepare statement', $statement);
1280
1281   $sth->execute
1282     or DBError('ResequenceList: Unable to execute statement', $statement);
1283
1284   my $sequence = 1;
1285
1286   while (my @row = $sth->fetchrow_array) {
1287     last if !@row;
1288
1289     my $old_sequence = pop @row;
1290
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";
1295
1296       $DB->do($update_statement)
1297         or DBError('ResequenceList: Unable to do statement', $statement);
1298     } # if
1299
1300     $sequence++;
1301   } # while
1302
1303   return 0;
1304 } # ResequenceList
1305
1306 sub ReturnEmails($$$;$$) {
1307   my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1308
1309   $start_at ||= 0;
1310
1311   my $statement;
1312
1313   if ($date) {
1314     my $sod = $date . ' 00:00:00';
1315     my $eod = $date . ' 23:59:59';
1316
1317     if ($type eq 'returned') {
1318       $statement = <<"END";
1319 select
1320   log.sender
1321 from
1322   log,
1323   email
1324 where
1325   log.sender    = email.sender and
1326   log.userid    = '$userid'    and
1327   log.timestamp > '$sod'       and
1328   log.timestamp < '$eod'       and
1329   log.type      = '$type'
1330 group by
1331   log.sender
1332 limit
1333   $start_at, $nbr_emails
1334 END
1335     } else {
1336       $statement = <<"END";
1337 select
1338   sender
1339 from
1340   log
1341 where
1342   userid    = '$userid'    and
1343   timestamp > '$sod'       and
1344   timestamp < '$eod'       and
1345   type      = '$type'
1346 group by
1347   sender
1348 limit
1349   $start_at, $nbr_emails
1350 END
1351     } # if
1352   } else {
1353     if ($type eq 'returned') {
1354       $statement = <<"END";
1355 select
1356   log.sender
1357 from
1358   log,
1359   email
1360 where
1361   log.sender   = email.sender and
1362   log.userid   = '$userid'    and
1363   log.type     = '$type'
1364 group by
1365   log.sender
1366 order by
1367   log.timestamp desc
1368 limit
1369   $start_at, $nbr_emails
1370 END
1371     } else {
1372       $statement = <<"END";
1373 select
1374   sender
1375 from
1376   log
1377 where
1378   userid   = '$userid'    and
1379   type     = '$type'
1380 group by
1381   sender
1382 order by
1383   timestamp desc
1384 limit
1385   $start_at, $nbr_emails
1386 END
1387     } # if
1388   } # if
1389
1390   my $sth = $DB->prepare($statement)
1391     or DBError('ReturnEmails: Unable to prepare statement', $statement);
1392
1393   $sth->execute
1394     or DBError('ReturnEmails: Unable to execute statement', $statement);
1395
1396   my @emails;
1397
1398   while (my $sender = $sth->fetchrow_array) {
1399     my $earliestDate;
1400
1401     # Get emails for this sender. Format an array of subjects and timestamps.
1402     my @messages;
1403
1404     $statement = "select timestamp, subject from email where userid = '$userid' " .
1405                  "and sender = '$sender'";
1406
1407     my $sth2 = $DB->prepare($statement)
1408       or DBError('ReturnEmails: Unable to prepare statement', $statement);
1409
1410     $sth2->execute
1411       or DBError('ReturnEmails: Unable to execute statement', $statement);
1412
1413     while (my @row = $sth2->fetchrow_array) {
1414       my $subject = pop @row;
1415       my $date    = pop @row;
1416
1417       if ($earliestDate) {
1418         my $earliestDateShort = substr $earliestDate, 0, 10;
1419         my $dateShort         = substr $date,         0, 10;
1420
1421         if ($earliestDateShort eq $dateShort and
1422             $earliestDate > $date) {
1423           $earliestDate = $date if $earliestDateShort eq $dateShort;
1424         } # if
1425       } else {
1426         $earliestDate = $date;
1427       } # if
1428
1429       push @messages, [$subject, $date];
1430     } # while
1431
1432     # Done with sth2
1433     $sth2->finish;
1434
1435     $earliestDate ||= '';
1436
1437     unless ($type eq 'returned') {
1438       push @emails, [$earliestDate, [$sender, @messages]];
1439     } else {
1440       push @emails, [$earliestDate, [$sender, @messages]]
1441         if @messages > 0;
1442     } # unless
1443   } # while
1444
1445   # Done with $sth
1446   $sth->finish;
1447
1448   return @emails;
1449 } # ReturnEmails
1450
1451 sub ReturnList($$$) {
1452   my ($type, $start_at, $lines) = @_;
1453
1454   $lines ||= 10;
1455
1456   my $statement;
1457
1458   if ($start_at) {
1459     $statement = "select * from list where userid = '$userid' " .
1460                  "and type = '$type' order by sequence "        .
1461                  "limit $start_at, $lines";
1462   } else {
1463     $statement = "select * from list where userid = '$userid' "        .
1464                  "and type = '$type' order by sequence";
1465   } # if
1466
1467   my $sth = $DB->prepare($statement)
1468     or DBError('ReturnList: Unable to prepare statement', $statement);
1469
1470   $sth->execute
1471     or DBError('ReturnList: Unable to execute statement', $statement);
1472
1473   my @list;
1474   my $i = 0;
1475
1476   while (my @row = $sth->fetchrow_array) {
1477     last if $i++ > $lines;
1478
1479     my %list;
1480
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;
1489     push @list, \%list;
1490   } # for
1491
1492   return @list;
1493 } # ReturnList
1494
1495 sub ReturnListEntry($$) {
1496   my ($type, $sequence) = @_;
1497
1498   my $statement = "select * from list where userid = '$userid' "        .
1499                  "and type = '$type' and sequence = '$sequence'";
1500
1501   my $sth = $DB->prepare($statement)
1502     or DBError('ReturnListEntry: Unable to prepare statement', $statement);
1503
1504   $sth->execute
1505     or DBError('ReturnListEntry: Unable to execute statement', $statement);
1506
1507   my %list;
1508   my @row = $sth->fetchrow_array;
1509
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;
1516
1517   return %list;
1518 } # ReturnListEntry
1519
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) = @_;
1528
1529   # Check to see if this sender has already emailed us.
1530   my $msg_count = CountMsg($sender);
1531
1532   if ($msg_count < 5) {
1533     # Return register message
1534     my @msg;
1535
1536     for (split /\n/,$data) {
1537       push @msg, "$_\n";
1538     } # for
1539
1540     SendMsg($reply_to,
1541             "Your email has been returned by MAPS",
1542             "$mapsbase/register.html",
1543             GetContext,
1544             @msg)
1545       if $msg_count == 0;
1546     Logmsg("returned", $sender, "Sent register reply");
1547     # Save message
1548     SaveMsg($sender, $subject, $data);
1549   } else {
1550     Add2Nulllist($sender, GetContext, "Auto Null List - Mail loop");
1551     Logmsg("mailloop", $sender, "Mail loop encountered");
1552   } # if
1553
1554   return;
1555 } # ReturnMsg
1556
1557 sub ReturnMessages($$) {
1558   my ($userid, $sender) = @_;
1559
1560   my $statement = <<"END";
1561 select
1562   subject,
1563   timestamp
1564 from
1565   email
1566 where
1567   userid = '$userid' and
1568   sender = '$sender'
1569 group by
1570   timestamp desc
1571 END
1572
1573   my $sth = $DB->prepare($statement)
1574     or DBError('ReturnMessages: Unable to prepare statement', $statement);
1575
1576   $sth->execute
1577     or DBError('ReturnMessages: Unable to execute statement', $statement);
1578
1579   my @messages;
1580
1581   while (my @row = $sth->fetchrow_array) {
1582     my $date    = pop @row;
1583     my $subject = pop @row;
1584
1585     push @messages, [$subject, $date];
1586   } # while
1587
1588   $sth->finish;
1589
1590   return @messages;
1591 } # ReturnMessages
1592
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) = @_;
1607
1608   $start_at ||= 0;
1609
1610   my $dateCond = '';
1611
1612   if ($date) {
1613     my $sod = $date . ' 00:00:00';
1614     my $eod = $date . ' 23:59:59';
1615
1616     $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
1617   } # if
1618
1619   my $statement = <<"END";
1620 select
1621   sender,
1622   timestamp
1623 from
1624   log
1625 where
1626   userid = '$userid' and
1627   type   = '$type'
1628   $dateCond
1629 order by
1630   timestamp desc
1631 END
1632
1633   my $sth = $DB->prepare($statement)
1634     or DBError('ReturnSenders: Unable to prepare statement', $statement);
1635
1636   $sth->execute
1637     or DBError('ReturnSenders: Unable to execute statement', $statement);
1638
1639   # Watch the distinction between senders (plural) and sender (singular)
1640   my (%senders, %sendersByTimestamp);
1641
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};
1650
1651     $senders{$sender{sender}} = $sender{timestamp}
1652       unless $senders{$sender{sender}};
1653   } # while
1654
1655   $sth->finish;
1656
1657   # Make a hash whose keys are the timestamp (so we can later sort on
1658   # them).
1659   while (my ($key, $value) = each %senders) {
1660     $sendersByTimestamp{$value} = $key;
1661   } # while
1662
1663   my @senders;
1664
1665   # Sort by timestamp desc and push on to the @senders array
1666   push @senders, $sendersByTimestamp{$_}
1667     for (sort { $b cmp $a } keys %sendersByTimestamp);
1668
1669   # Finally slice for the given range
1670   my $end_at = $start_at + $nbr_emails - 1;
1671
1672   $end_at = (@senders - 1)
1673     if $end_at > @senders;
1674
1675   return (@senders) [$start_at .. $end_at];
1676 } # ReturnSenders
1677
1678 sub SaveMsg($$$) {
1679   my ($sender, $subject, $data) = @_;
1680
1681   AddEmail($sender, $subject, $data);
1682
1683   return;
1684 } # SaveMsg
1685
1686 sub SearchEmails($$) {
1687   my ($userid, $searchfield) = @_;
1688
1689   my @emails;
1690
1691   my $statement =
1692     "select sender, subject, timestamp from email where userid = '$userid' and (
1693      sender like '%$searchfield%' or subject like '%$searchfield%')
1694      order by timestamp desc";
1695
1696   my $sth = $DB->prepare($statement)
1697     or DBError('SearchEmails: Unable to prepare statement', $statement);
1698
1699   $sth->execute
1700     or DBError('SearchEmails: Unable to execute statement', $statement);
1701
1702   while (my @row = $sth->fetchrow_array) {
1703     my $date    = pop @row;
1704     my $subject = pop @row;
1705     my $sender  = pop @row;
1706
1707     push @emails, [$sender, $subject, $date];
1708   } # while
1709
1710   $sth->finish;
1711
1712   return @emails;
1713 } # SearchEmails
1714
1715 sub SendMsg($$$$@) {
1716   # SendMsg will send the message contained in $msgfile.
1717   my ($sender, $subject, $msgfile, $userid, @spammsg) = @_;
1718
1719   my @lines;
1720
1721   # Open return message template file
1722   open my $return_msg_file, '<', $msgfile
1723     or die "Unable to open return msg file ($msgfile): $!\n";
1724
1725   # Read return message template file and print it to $msg_body
1726   while (<$return_msg_file>) {
1727     if (/\$userid/) {
1728       # Replace userid
1729       s/\$userid/$userid/;
1730     } # if
1731     if (/\$sender/) {
1732       # Replace sender
1733       s/\$sender/$sender/;
1734     } #if
1735
1736     push @lines, $_;
1737   } # while
1738
1739   close $return_msg_file;
1740
1741   # Create the message, and set up the mail headers:
1742   my $msg = MIME::Entity->build(
1743     From    => "MAPS\@DeFaria.com",
1744     To      => $sender,
1745     Subject => $subject,
1746     Type    => "text/html",
1747     Data    => \@lines
1748   );
1749
1750   # Need to obtain the spam message here...
1751   $msg->attach(
1752     Type        => "message",
1753     Disposition => "attachment",
1754     Data        => \@spammsg
1755   );
1756
1757   # Send it
1758   open my $mail, '|-', '/usr/lib/sendmail -t -oi -oem'
1759     or croak "SendMsg: Unable to open pipe to sendmail $!";
1760
1761   $msg->print(\*$mail);
1762
1763   close $mail;
1764
1765   return;
1766 } # SendMsg
1767
1768 sub SetContext($) {
1769   my ($to_user) = @_;
1770
1771   my $old_user = $userid;
1772
1773   if (UserExists($to_user)) {
1774     $userid = $to_user;
1775
1776     GetUserOptions($userid);
1777     return GetUserInfo $userid;
1778   } else {
1779     return 0;
1780   } # if
1781 } # SetContext
1782
1783 sub Space($) {
1784   my ($userid) = @_;
1785
1786   my $total_space = 0;
1787   my %msg_space;
1788
1789   my $statement = "select * from email where userid = '$userid'";
1790   my $sth = $DB->prepare($statement)
1791     or DBError('Unable to prepare statement', $statement);
1792
1793   $sth->execute
1794     or DBError('Unable to execute statement', $statement);
1795
1796   while (my @row = $sth->fetchrow_array) {
1797     last if !@row;
1798
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;
1804
1805     my $msg_space =
1806       length ($userid)    +
1807       length ($sender)    +
1808       length ($subject)   +
1809       length ($timestamp) +
1810       length ($data);
1811
1812     $total_space        += $msg_space;
1813     $msg_space{$sender} += $msg_space;
1814   } # while
1815
1816   $sth->finish;
1817
1818   return wantarray ? %msg_space : $total_space;
1819 } # Space
1820
1821 sub UpdateList($$$$$$$) {
1822   my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1823
1824   if (!$pattern || $pattern eq '') {
1825     $pattern = 'NULL';
1826   } else {
1827     $pattern = "'" . quotemeta ($pattern) . "'";
1828   } # if
1829
1830   if (!$domain || $domain eq '') {
1831     $domain = 'NULL';
1832   } else {
1833     $domain = "'" . quotemeta ($domain) . "'";
1834   } # if
1835
1836   if (!$comment || $comment eq '') {
1837     $comment = 'NULL';
1838   } else {
1839     $comment = "'" . quotemeta ($comment) . "'";
1840   } # if
1841
1842   if (!$hit_count || $hit_count eq '') {
1843     $hit_count = 0;
1844   #} else {
1845   # TODO: Check if numeric
1846   } # fi
1847
1848   my $statement =
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";
1852
1853   $DB->do($statement)
1854     or DBError('UpdateList: Unable to do statement', $statement);
1855
1856   return 0;
1857 } # UpdateList
1858
1859 sub UpdateUser($$$$) {
1860   my ($userid, $fullname, $email, $password) = @_;
1861
1862   return 1 if !UserExists($userid);
1863
1864   my $statement;
1865
1866   if (!defined $password || $password eq '') {
1867     $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1868   } else {
1869     $password = Encrypt $password, $userid;
1870     $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1871   } # if
1872
1873   $DB->do($statement)
1874     or DBError('UpdateUser: Unable to do statement', $statement);
1875
1876   return 0;
1877 } # UpdateUser
1878
1879 sub UpdateUserOptions ($@) {
1880   my ($userid, %options)  = @_;
1881
1882   return unless UserExists($userid);
1883
1884   for (keys(%options)) {
1885     my $statement = "update useropts set value='$options{$_}' where userid='$userid' and name='$_'";
1886
1887     $DB->do($statement)
1888       or DBError('UpdateUserOption: Unable to do statement', $statement);
1889   } # for
1890
1891   return;
1892 } # UpdateUserOptions
1893
1894 sub UserExists($) {
1895   my ($userid) = @_;
1896
1897   return 0 unless $userid;
1898
1899   my $statement = "select userid, password from user where userid = '$userid'";
1900
1901   my $sth = $DB->prepare($statement)
1902       or DBError('UserExists: Unable to prepare statement', $statement);
1903
1904   $sth->execute
1905     or DBError('UserExists: Unable to execute statement', $statement);
1906
1907   my @userdata = $sth->fetchrow_array;
1908
1909   $sth->finish;
1910
1911   return 0 if scalar(@userdata) == 0;
1912
1913   my $dbpassword = pop @userdata;
1914   my $dbuserid   = pop @userdata;
1915
1916   if ($dbuserid ne $userid) {
1917     return 0;
1918   } else {
1919     return $dbpassword;
1920   } # if
1921 } # UserExists
1922
1923 sub Whitelist ($$;$$) {
1924   # Whitelist will deliver the message.
1925   my ($sender, $data, $sequence, $hit_count) = @_;
1926
1927   my $userid = GetContext;
1928
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;
1932
1933   print $message $data;
1934
1935   close $message;
1936
1937   # Now call MAPSDeliver
1938   my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
1939
1940   unlink "/tmp/MAPSMessage.$$";
1941
1942   if ($status == 0) {
1943     Logmsg("whitelist", $sender, "Delivered message");
1944   } else {
1945     Error("Unable to deliver message - is MAPSDeliver setgid? - $!");
1946   } # if
1947
1948   RecordHit("white", $sequence, ++$hit_count) if $sequence;
1949
1950   return $status;
1951 } # Whitelist
1952
1953 sub count($$) {
1954   my ($table, $condition) = @_;
1955
1956   my $statement;
1957
1958   if ($condition) {
1959     $statement = "select count(*) from $table where $condition";
1960   } else {
1961     $statement = "select count(*) from $table";
1962   } # if
1963
1964   my $sth = $DB->prepare($statement)
1965     or DBError('count: Unable to prepare statement', $statement);
1966
1967   $sth->execute
1968     or DBError('count: Unable to execute statement', $statement);
1969
1970   # Get return value, which should be how many message there are
1971   my @row = $sth->fetchrow_array;
1972
1973   # Done with $sth
1974   $sth->finish;
1975
1976   my $count;
1977
1978   # Retrieve returned value
1979   unless ($row[0]) {
1980     $count = 0
1981   } else {
1982     $count = $row[0];
1983   } # unless
1984
1985   return $count
1986 } # count
1987
1988 sub count_distinct($$$) {
1989   my ($table, $column, $condition) = @_;
1990
1991   my $statement;
1992
1993   if ($condition) {
1994     $statement = "select count(distinct $column) from $table where $condition";
1995   } else {
1996     $statement = "select count(distinct $column) from $table";
1997   } # if
1998
1999   my $sth = $DB->prepare($statement)
2000     or DBError('count: Unable to prepare statement', $statement);
2001
2002   $sth->execute
2003     or DBError('count: Unable to execute statement', $statement);
2004
2005   # Get return value, which should be how many message there are
2006   my @row = $sth->fetchrow_array;
2007
2008   # Done with $sth
2009   $sth->finish;
2010
2011   # Retrieve returned value
2012   unless ($row[0]) {
2013     return 0;
2014   } else {
2015     return $row[0];
2016   } # unless
2017 } # count_distinct
2018
2019 sub countlog(;$) {
2020   my ($additional_condition) = @_;
2021
2022   my $condition = "userid=\'$userid\' ";
2023
2024   $condition .= "and $additional_condition" if $additional_condition;
2025
2026   return count_distinct('log', 'sender', $condition);
2027 } # countlog
2028
2029 1;