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) = @_;
 707
 708   my $statement;
 709
 710   if (!defined $sender || $sender eq '') {
 711     $statement = "select * from email where userid = '$userid'";
 712   } else {
 713     $statement = "select * from email where userid = '$userid' and sender = '$sender'";
 714   } # if
 715
 716   my $sth = $DB->prepare($statement)
 717     or DBError('FindEmail: Unable to prepare statement', $statement);
 718
 719   $sth->execute
 720     or DBError('FindEmail: Unable to execute statement', $statement);
 721
 722   return $sth;
 723 } # FindEmail
 724
 725 sub FindList($;$) {
 726   my ($type, $sender) = @_;
 727
 728   my $statement;
 729
 730   unless ($sender) {
 731     $statement = "select * from list where userid = '$userid' and type = '$type'";
 732   } else {
 733     my ($pattern, $domain) = split /\@/, $sender;
 734     $statement = "select * from list where userid = '$userid' and type = '$type' " .
 735                  "and pattern = '$pattern' and domain = '$domain'";
 736   } # unless
 737
 738   # Prepare statement
 739   my $sth = $DB->prepare($statement)
 740     or DBError('FindList: Unable to prepare statement', $statement);
 741
 742   # Execute statement
 743   $sth->execute
 744     or DBError('FindList: Unable to execute statement', $statement);
 745
 746   # Get return value, which should be how many entries were deleted
 747   return $sth;
 748 } # FindList
 749
 750 sub FindLog($) {
 751   my ($how_many) = @_;
 752
 753   my $start_at = 0;
 754   my $end_at   = countlog();
 755
 756   if ($how_many < 0) {
 757     $start_at = $end_at - abs ($how_many);
 758     $start_at = 0 if ($start_at < 0);
 759   } # if
 760
 761   my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
 762
 763   # Prepare statement
 764   my $sth = $DB->prepare($statement)
 765     or DBError('FindLog: Unable to prepare statement', $statement);
 766
 767   # Execute statement
 768   $sth->execute
 769     or DBError('FindLog: Unable to execute statement', $statement);
 770
 771   # Get return value, which should be how many entries were deleted
 772   return $sth;
 773 } # FindLog
 774
 775 sub FindUser(;$) {
 776   my ($userid) = @_;
 777
 778   my $statement;
 779
 780   if (!defined $userid || $userid eq '') {
 781     $statement = 'select * from user';
 782   } else {
 783     $statement = "select * from user where userid = '$userid'";
 784   } # if
 785
 786   my $sth = $DB->prepare($statement)
 787     or DBError('FindUser: Unable to prepare statement', $statement);
 788
 789   $sth->execute
 790     or DBError('FindUser: Unable to execute statement', $statement);
 791
 792   return $sth;
 793 } # FindUser
 794
 795 sub GetContext() {
 796   return $userid;
 797 } # GetContext
 798
 799 sub GetEmail($) {
 800   my ($sth) = @_;
 801
 802   my @email;
 803
 804   if (@email = $sth->fetchrow_array) {
 805     my $message   = pop @email;
 806     my $timestamp = pop @email;
 807     my $subject   = pop @email;
 808     my $sender    = pop @email;
 809     my $userid    = pop @email;
 810     return $userid, $sender, $subject, $timestamp, $message;
 811   } else {
 812     return;
 813   } # if
 814 } # GetEmail
 815
 816 sub GetList($) {
 817   my ($sth) = @_;
 818
 819   my @list;
 820
 821   if (@list = $sth->fetchrow_array) {
 822     my $last_hit  = pop @list;
 823     my $hit_count = pop @list;
 824     my $sequence  = pop @list;
 825     my $comment   = pop @list;
 826     my $domain    = pop @list;
 827     my $pattern   = pop @list;
 828     my $type      = pop @list;
 829     my $userid    = pop @list;
 830     return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
 831   } else {
 832     return;
 833   } # if
 834 } # GetList
 835
 836 sub GetLog($) {
 837   my ($sth) = @_;
 838
 839   my @log;
 840
 841   if (@log = $sth->fetchrow_array) {
 842     my $message   = pop @log;
 843     my $type      = pop @log;
 844     my $sender    = pop @log;
 845     my $timestamp = pop @log;
 846     my $userid    = pop @log;
 847     return $userid, $timestamp, $sender, $type, $message;
 848   } else {
 849     return;
 850   } # if
 851 } # GetLog
 852
 853 sub GetNextSequenceNo($$) {
 854   my ($userid, $listtype) = @_;
 855
 856   my $count = count ('list', "userid = '$userid' and type = '$listtype'");
 857
 858   return $count + 1;
 859 } # GetNextSequenceNo
 860
 861 sub GetUser($) {
 862   my ($sth) = @_;
 863
 864   my @user;
 865
 866   if (@user = $sth->fetchrow_array) {
 867     my $password = pop @user;
 868     my $email    = pop @user;
 869     my $name     = pop @user;
 870     my $userid   = pop @user;
 871     return ($userid, $name, $email, $password);
 872   } else {
 873     return;
 874   } # if
 875 } # GetUser
 876
 877 sub GetUserInfo($) {
 878   my ($userid) = @_;
 879
 880   my $statement = "select name, email from user where userid='$userid'";
 881
 882   my $sth = $DB->prepare($statement)
 883     or DBError('GetUserInfo: Unable to prepare statement', $statement);
 884
 885   $sth->execute
 886     or DBError('GetUserInfo: Unable to execute statement', $statement);
 887
 888   my @userinfo   = $sth->fetchrow_array;
 889   my $user_email = lc (pop @userinfo);
 890   my $username   = lc (pop @userinfo);
 891
 892   $sth->finish;
 893
 894   return ($username, $user_email);
 895 } # GetUserInfo
 896
 897 sub GetUserOptions($) {
 898   my ($userid) = @_;
 899
 900   my $statement = "select * from useropts where userid = '$userid'";
 901
 902   my $sth = $DB->prepare($statement)
 903     or DBError('GetUserOptions: Unable to prepare statement', $statement);
 904
 905   $sth->execute
 906     or DBError('GetUserOptions: Unable to execute statement', $statement);
 907
 908   my @useropts;
 909
 910   # Empty hash
 911   %useropts = ();
 912
 913   while (@useropts = $sth->fetchrow_array) {
 914     my $value = pop @useropts;
 915     my $name  = pop @useropts;
 916
 917     pop @useropts;
 918
 919     $useropts{$name} = $value;
 920   } # while
 921
 922   $sth->finish;
 923
 924   return %useropts;
 925 } # GetUserOptions
 926
 927 sub GetRows ($) {
 928   my ($statement) = @_;
 929
 930   my $sth = $DB->prepare($statement)
 931     or DBError('Unable to prepare statement' , $statement);
 932
 933   $sth->execute
 934     or DBError('Unable to execute statement' , $statement);
 935
 936   my @array;
 937
 938   while (my @row = $sth->fetchrow_array) {
 939     for (@row) {
 940       push @array, $_;
 941     } # for
 942   } # while
 943
 944   return @array;
 945 } # GetRows
 946
 947 sub Login($$) {
 948   my ($userid, $password) = @_;
 949
 950   $password = Encrypt($password, $userid);
 951
 952   # Check if user exists
 953   my $dbpassword = UserExists($userid);
 954
 955   # Return -1 if user doesn't exist
 956   return -1 if !$dbpassword;
 957
 958   # Return -2 if password does not match
 959   if ($password eq $dbpassword) {
 960     SetContext($userid);
 961     return 0
 962   } else {
 963     return -2
 964   } # if
 965 } # Login
 966
 967 sub Nulllist($;$$) {
 968   # Nulllist will simply discard the message.
 969   my ($sender, $sequence, $hit_count) = @_;
 970
 971   RecordHit("null", $sequence, ++$hit_count) if $sequence;
 972
 973   # Discard Message
 974   Logmsg("nulllist", $sender, "Discarded message");
 975
 976   return;
 977 } # Nulllist
 978
 979 sub OnBlacklist($;$) {
 980   my ($sender, $update) = @_;
 981
 982   return CheckOnList('black', $sender, $update);
 983 } # OnBlacklist
 984
 985 sub OnNulllist($;$) {
 986   my ($sender, $update) = @_;
 987
 988   return CheckOnList("null", $sender, $update);
 989 } # CheckOnNulllist
 990
 991 sub OnWhitelist($;$$) {
 992   my ($sender, $userid, $update) = @_;
 993
 994   SetContext($userid) if $userid;
 995
 996   return CheckOnList("white", $sender, $update);
 997 } # OnWhitelist
 998
 999 sub OpenDB($$) {
1000   my ($username, $password) = @_;
1001
1002   my $dbname   = 'MAPS';
1003   my $dbdriver = 'mysql';
1004   my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
1005
1006   if (!$DB || $DB eq '') {
1007     #$dbserver='localhost';
1008     $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
1009       or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
1010   } # if
1011
1012   return $DB;
1013 } # OpenDB
1014
1015 BEGIN {
1016   my $MAPS_username = "maps";
1017   my $MAPS_password = "spam";
1018
1019   OpenDB($MAPS_username, $MAPS_password);
1020 } # BEGIN
1021
1022 END {
1023   CloseDB;
1024 } # END
1025
1026
1027 sub OptimizeDB() {
1028   my $statement = 'lock tables email read, list read, log read, user read, useropts read';
1029   my $sth = $DB->prepare($statement)
1030       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1031
1032   $sth->execute
1033     or DBError('OptimizeDB: Unable to execute statement', $statement);
1034
1035   $statement = 'check table email, list, log, user, useropts';
1036   $sth = $DB->prepare($statement)
1037       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1038
1039   $sth->execute
1040     or DBError('OptimizeDB: Unable to execute statement', $statement);
1041
1042   $statement = 'unlock tables';
1043   $sth = $DB->prepare($statement)
1044       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1045
1046   $sth->execute
1047     or DBError('OptimizeDB: Unable to execute statement', $statement);
1048
1049   $statement = 'optimize table email, list, log, user, useropts';
1050   $sth = $DB->prepare($statement)
1051       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1052
1053   $sth->execute
1054     or DBError('OptimizeDB: Unable to execute statement', $statement);
1055
1056   return;
1057 } # OptimizeDB
1058
1059 sub ReadMsg($) {
1060   # Reads an email message file from $input. Returns sender, subject,
1061   # date and data, which is a copy of the entire message.
1062   my ($input) = @_;
1063
1064   my $sender          = '';
1065   my $sender_long     = '';
1066   my $envelope_sender = '';
1067   my $reply_to        = '';
1068   my $subject         = '';
1069   my $data            = '';
1070   my @data;
1071
1072   # Find first message's "From " line indicating start of message
1073   while (<$input>) {
1074     chomp;
1075     last if /^From /;
1076   } # while
1077
1078   # If we hit eof here then the message was garbled. Return indication of this
1079   if (eof($input)) {
1080     $data = "Garbled message - unable to find From line";
1081     return $sender, $sender_long, $reply_to, $subject, $data;
1082   } # if
1083
1084   if (/From (\S*)/) {
1085     $envelope_sender = $1;
1086     $sender_long     = $envelope_sender;
1087   } # if
1088
1089   push @data, $_ if /^From /;
1090
1091   while (<$input>) {
1092     chomp;
1093     push @data, $_;
1094
1095     # Blank line indicates start of message body
1096     last if ($_ eq "" || $_ eq "\r");
1097
1098     # Extract sender's address
1099     if (/^from: .*/i) {
1100       $_ = substr ($_, 6);
1101
1102       $sender_long = $_;
1103
1104       if (/<(\S*)@(\S*)>/) {
1105         $sender = lc ("$1\@$2");
1106       } elsif (/(\S*)@(\S*)\ /) {
1107         $sender = lc ("$1\@$2");
1108       } elsif (/(\S*)@(\S*)/) {
1109         $sender = lc ("$1\@$2");
1110       } # if
1111     } elsif (/^subject: .*/i) {
1112       $subject = substr ($_, 9);
1113     } elsif (/^reply-to: .*/i) {
1114       $_ = substr ($_, 10);
1115       if (/<(\S*)@(\S*)>/) {
1116         $reply_to = lc ("$1\@$2");
1117       } elsif (/(\S*)@(\S*)\ /) {
1118         $reply_to = lc ("$1\@$2");
1119       } elsif (/(\S*)@(\S*)/) {
1120         $reply_to = lc ("$1\@$2");
1121       } # if
1122     } # if
1123   } # while
1124
1125   # Read message body
1126   while (<$input>) {
1127     chomp;
1128
1129     last if (/^From /);
1130     push @data, $_;
1131   } # while
1132
1133   # Set file pointer back by length of the line just read
1134   seek ($input, -length () - 1, 1) if !eof $input;
1135
1136   # Sanitize email addresses
1137   $envelope_sender =~ s/\<//g;
1138   $envelope_sender =~ s/\>//g;
1139   $envelope_sender =~ s/\"//g;
1140   $envelope_sender =~ s/\'//g;
1141   $sender          =~ s/\<//g;
1142   $sender          =~ s/\>//g;
1143   $sender          =~ s/\"//g;
1144   $sender          =~ s/\'//g;
1145   $reply_to        =~ s/\<//g;
1146   $reply_to        =~ s/\>//g;
1147   $reply_to        =~ s/\"//g;
1148   $reply_to        =~ s/\'//g;
1149
1150   # Determine best addresses
1151   $sender    = $envelope_sender if $sender eq "";
1152   $reply_to  = $sender          if $reply_to eq "";
1153
1154   return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
1155 } # ReadMsg
1156
1157 sub RecordHit($$$) {
1158   my ($listtype, $sequence, $hit_count) = @_;
1159
1160   my $current_date = UnixDatetime2SQLDatetime(scalar(localtime));
1161
1162   my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
1163
1164   $DB->do($statement)
1165     or DBError('RecordHit: Unable to do statement', $statement);
1166
1167   return;
1168 } # RecordHit
1169
1170 sub ResequenceList($$) {
1171   my ($userid, $type) = @_;
1172
1173   return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1174
1175   return 2 unless UserExists($userid);
1176
1177   my $statement = 'lock tables list write';
1178   my $sth = $DB->prepare($statement)
1179       or DBError('ResquenceList: Unable to prepare statement', $statement);
1180
1181   $sth->execute
1182     or DBError('ResequenceList: Unable to execute statement', $statement);
1183
1184   # Now get all of the list entries renumbering as we go
1185   $statement = <<"END";
1186 select
1187   pattern,
1188   domain,
1189   comment,
1190   sequence,
1191   hit_count,
1192   last_hit
1193 from
1194   list
1195 where
1196   userid = '$userid' and
1197   type   = '$type'
1198 order by
1199   hit_count desc
1200 END
1201
1202   $sth = $DB->prepare($statement)
1203     or DBError('ResequenceList: Unable to prepare statement', $statement);
1204
1205   $sth->execute
1206     or DBError('ResequenceList: Unable to execute statement', $statement);
1207
1208   my $sequence = 1;
1209   my @new_rows;
1210
1211   while (my @row = $sth->fetchrow_array) {
1212     last if !@row;
1213
1214     my %record = (
1215       last_hit     => pop @row,
1216       hit_count    => pop @row,
1217       new_sequence => $sequence++,
1218       old_sequence => pop @row,
1219       comment      => $DB->quote(pop @row) || '',
1220       domain       => $DB->quote(pop @row) || '',
1221       pattern      => $DB->quote(pop @row) || '',
1222     );
1223
1224     push @new_rows, \%record;
1225   } # while
1226
1227   # Delete all of the list entries for this $userid and $type
1228   $statement = "delete from list where userid='$userid' and type='$type'";
1229
1230   $DB->do($statement)
1231     or DBError('ResequenceList: Unable to do statement', $statement);
1232
1233   # Re-add list with new sequence numbers
1234   for (@new_rows) {
1235     my %record = %$_;
1236     my $statement = <<"END";
1237 insert into
1238   list
1239 values (
1240   '$userid',
1241   '$type',
1242   $record{pattern},
1243   $record{domain},
1244   $record{comment},
1245   '$record{new_sequence}',
1246   '$record{hit_count}',
1247   '$record{last_hit}'
1248 )
1249 END
1250
1251   $DB->do($statement)
1252     or DBError('ResequenceList: Unable to do statement', $statement);
1253   } # for
1254
1255   $statement = 'unlock tables';
1256   $sth = $DB->prepare($statement)
1257       or DBError('OptimizeDB: Unable to prepare statement', $statement);
1258
1259   $sth->execute
1260     or DBError('OptimizeDB: Unable to execute statement', $statement);
1261
1262   return 0;
1263 } # ResequenceList
1264
1265 sub ResequenceListold($$) {
1266   my ($userid, $type) = @_;
1267
1268   return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null';
1269
1270   return 2 unless UserExists($userid);
1271
1272   my $statement = "select sequence from list where userid = '$userid' "
1273                 . " and type = '$type' order by sequence";
1274
1275   my $sth = $DB->prepare($statement)
1276     or DBError('ResequenceList: Unable to prepare statement', $statement);
1277
1278   $sth->execute
1279     or DBError('ResequenceList: Unable to execute statement', $statement);
1280
1281   my $sequence = 1;
1282
1283   while (my @row = $sth->fetchrow_array) {
1284     last if !@row;
1285
1286     my $old_sequence = pop @row;
1287
1288     if ($old_sequence != $sequence) {
1289       my $update_statement = "update list set sequence = $sequence " .
1290                              "where userid = '$userid' and " .
1291                              "type = '$type' and sequence = $old_sequence";
1292
1293       $DB->do($update_statement)
1294         or DBError('ResequenceList: Unable to do statement', $statement);
1295     } # if
1296
1297     $sequence++;
1298   } # while
1299
1300   return 0;
1301 } # ResequenceList
1302
1303 sub ReturnEmails($$$;$$) {
1304   my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1305
1306   $start_at ||= 0;
1307
1308   my $statement;
1309
1310   if ($date) {
1311     my $sod = $date . ' 00:00:00';
1312     my $eod = $date . ' 23:59:59';
1313
1314     if ($type eq 'returned') {
1315       $statement = <<"END";
1316 select
1317   log.sender
1318 from
1319   log,
1320   email
1321 where
1322   log.sender    = email.sender and
1323   log.userid    = '$userid'    and
1324   log.timestamp > '$sod'       and
1325   log.timestamp < '$eod'       and
1326   log.type      = '$type'
1327 group by
1328   log.sender
1329 limit
1330   $start_at, $nbr_emails
1331 END
1332     } else {
1333       $statement = <<"END";
1334 select
1335   sender
1336 from
1337   log
1338 where
1339   userid    = '$userid'    and
1340   timestamp > '$sod'       and
1341   timestamp < '$eod'       and
1342   type      = '$type'
1343 group by
1344   sender
1345 limit
1346   $start_at, $nbr_emails
1347 END
1348     } # if
1349   } else {
1350     if ($type eq 'returned') {
1351       $statement = <<"END";
1352 select
1353   log.sender
1354 from
1355   log,
1356   email
1357 where
1358   log.sender   = email.sender and
1359   log.userid   = '$userid'    and
1360   log.type     = '$type'
1361 group by
1362   log.sender
1363 order by
1364   log.timestamp desc
1365 limit
1366   $start_at, $nbr_emails
1367 END
1368     } else {
1369       $statement = <<"END";
1370 select
1371   sender
1372 from
1373   log
1374 where
1375   userid   = '$userid'    and
1376   type     = '$type'
1377 group by
1378   sender
1379 order by
1380   timestamp desc
1381 limit
1382   $start_at, $nbr_emails
1383 END
1384     } # if
1385   } # if
1386
1387   my $sth = $DB->prepare($statement)
1388     or DBError('ReturnEmails: Unable to prepare statement', $statement);
1389
1390   $sth->execute
1391     or DBError('ReturnEmails: Unable to execute statement', $statement);
1392
1393   my @emails;
1394
1395   while (my $sender = $sth->fetchrow_array) {
1396     my $earliestDate;
1397
1398     # Get emails for this sender. Format an array of subjects and timestamps.
1399     my @messages;
1400
1401     $statement = "select timestamp, subject from email where userid = '$userid' " .
1402                  "and sender = '$sender'";
1403
1404     my $sth2 = $DB->prepare($statement)
1405       or DBError('ReturnEmails: Unable to prepare statement', $statement);
1406
1407     $sth2->execute
1408       or DBError('ReturnEmails: Unable to execute statement', $statement);
1409
1410     while (my @row = $sth2->fetchrow_array) {
1411       my $subject = pop @row;
1412       my $date    = pop @row;
1413
1414       if ($earliestDate) {
1415         my $earliestDateShort = substr $earliestDate, 0, 10;
1416         my $dateShort         = substr $date,         0, 10;
1417
1418         if ($earliestDateShort eq $dateShort and
1419             $earliestDate > $date) {
1420           $earliestDate = $date if $earliestDateShort eq $dateShort;
1421         } # if
1422       } else {
1423         $earliestDate = $date;
1424       } # if
1425
1426       push @messages, [$subject, $date];
1427     } # while
1428
1429     # Done with sth2
1430     $sth2->finish;
1431
1432     $earliestDate ||= '';
1433
1434     unless ($type eq 'returned') {
1435       push @emails, [$earliestDate, [$sender, @messages]];
1436     } else {
1437       push @emails, [$earliestDate, [$sender, @messages]]
1438         if @messages > 0;
1439     } # unless
1440   } # while
1441
1442   # Done with $sth
1443   $sth->finish;
1444
1445   return @emails;
1446 } # ReturnEmails
1447
1448 sub ReturnList($$$) {
1449   my ($type, $start_at, $lines) = @_;
1450
1451   $lines ||= 10;
1452
1453   my $statement;
1454
1455   if ($start_at) {
1456     $statement = "select * from list where userid = '$userid' " .
1457                  "and type = '$type' order by sequence "        .
1458                  "limit $start_at, $lines";
1459   } else {
1460     $statement = "select * from list where userid = '$userid' "        .
1461                  "and type = '$type' order by sequence";
1462   } # if
1463
1464   my $sth = $DB->prepare($statement)
1465     or DBError('ReturnList: Unable to prepare statement', $statement);
1466
1467   $sth->execute
1468     or DBError('ReturnList: Unable to execute statement', $statement);
1469
1470   my @list;
1471   my $i = 0;
1472
1473   while (my @row = $sth->fetchrow_array) {
1474     last if $i++ > $lines;
1475
1476     my %list;
1477
1478     $list{last_hit}  = pop @row;
1479     $list{hit_count} = pop @row;
1480     $list{sequence}  = pop @row;
1481     $list{comment}   = pop @row;
1482     $list{domain}    = pop @row;
1483     $list{pattern}   = pop @row;
1484     $list{type}      = pop @row;
1485     $list{userid}    = pop @row;
1486     push @list, \%list;
1487   } # for
1488
1489   return @list;
1490 } # ReturnList
1491
1492 sub ReturnListEntry($$) {
1493   my ($type, $sequence) = @_;
1494
1495   my $statement = "select * from list where userid = '$userid' "        .
1496                  "and type = '$type' and sequence = '$sequence'";
1497
1498   my $sth = $DB->prepare($statement)
1499     or DBError('ReturnListEntry: Unable to prepare statement', $statement);
1500
1501   $sth->execute
1502     or DBError('ReturnListEntry: Unable to execute statement', $statement);
1503
1504   my %list;
1505   my @row = $sth->fetchrow_array;
1506
1507   $list{sequence} = pop @row;
1508   $list{comment}  = pop @row;
1509   $list{domain}   = pop @row;
1510   $list{pattern}  = pop @row;
1511   $list{type}     = pop @row;
1512   $list{userid}   = pop @row;
1513
1514   return %list;
1515 } # ReturnListEntry
1516
1517 # Added reply_to. Previously we passed reply_to into here as sender. This
1518 # caused a problem in that we were filtering as per sender but logging it
1519 # as reply_to. We only need reply_to for SendMsg so as to honor reply_to
1520 # so we now pass in both sender and reply_to
1521 sub ReturnMsg($$$$) {
1522   # ReturnMsg will send back to the $sender the register message.
1523   # Messages are saved to be delivered when the $sender registers.
1524   my ($sender, $reply_to, $subject, $data) = @_;
1525
1526   # Check to see if this sender has already emailed us.
1527   my $msg_count = CountMsg($sender);
1528
1529   if ($msg_count < 5) {
1530     # Return register message
1531     my @msg;
1532
1533     for (split /\n/,$data) {
1534       push @msg, "$_\n";
1535     } # for
1536
1537     SendMsg($reply_to,
1538             "Your email has been returned by MAPS",
1539             "$mapsbase/register.html",
1540             GetContext,
1541             @msg)
1542       if $msg_count == 0;
1543     Logmsg("returned", $sender, "Sent register reply");
1544     # Save message
1545     SaveMsg($sender, $subject, $data);
1546   } else {
1547     Add2Nulllist($sender, GetContext, "Auto Null List - Mail loop");
1548     Logmsg("mailloop", $sender, "Mail loop encountered");
1549   } # if
1550
1551   return;
1552 } # ReturnMsg
1553
1554 sub ReturnMessages($$) {
1555   my ($userid, $sender) = @_;
1556
1557   my $statement = <<"END";
1558 select
1559   subject,
1560   timestamp
1561 from
1562   email
1563 where
1564   userid = '$userid' and
1565   sender = '$sender'
1566 group by
1567   timestamp desc
1568 END
1569
1570   my $sth = $DB->prepare($statement)
1571     or DBError('ReturnMessages: Unable to prepare statement', $statement);
1572
1573   $sth->execute
1574     or DBError('ReturnMessages: Unable to execute statement', $statement);
1575
1576   my @messages;
1577
1578   while (my @row = $sth->fetchrow_array) {
1579     my $date    = pop @row;
1580     my $subject = pop @row;
1581
1582     push @messages, [$subject, $date];
1583   } # while
1584
1585   $sth->finish;
1586
1587   return @messages;
1588 } # ReturnMessages
1589
1590 # This subroutine returns an array of senders in reverse chronological
1591 # order based on time timestamp from the log table of when we returned
1592 # their message. The complication here is that a single sender may
1593 # send multiple times in a single day. So if spammer@foo.com sends
1594 # spam @ 1 second after midnight and then again at 2 Pm there will be
1595 # at least two records in the log table saying that we returned his
1596 # email. Getting records sorted by timestamp desc will have
1597 # spammer@foo.com listed twice. But we want him listed only once, as
1598 # the first entry in the returned array. Plus we may be called
1599 # repeatedly with different $start_at's. Therefore we need to process
1600 # the whole list of returns for today, eliminate duplicate entries for
1601 # a single sender then slice the resulting array.
1602 sub ReturnSenders($$$;$$) {
1603   my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1604
1605   $start_at ||= 0;
1606
1607   my $dateCond = '';
1608
1609   if ($date) {
1610     my $sod = $date . ' 00:00:00';
1611     my $eod = $date . ' 23:59:59';
1612
1613     $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
1614   } # if
1615
1616   my $statement = <<"END";
1617 select
1618   sender,
1619   timestamp
1620 from
1621   log
1622 where
1623   userid = '$userid' and
1624   type   = '$type'
1625   $dateCond
1626 order by
1627   timestamp desc
1628 END
1629
1630   my $sth = $DB->prepare($statement)
1631     or DBError('ReturnSenders: Unable to prepare statement', $statement);
1632
1633   $sth->execute
1634     or DBError('ReturnSenders: Unable to execute statement', $statement);
1635
1636   # Watch the distinction between senders (plural) and sender (singular)
1637   my (%senders, %sendersByTimestamp);
1638
1639   # Run through the results and add to %senders by sender key. This
1640   # results in a hash that has the sender in it and the first
1641   # timestamp value. Since we already sorted timestamp desc by the
1642   # above select statement, and we've narrowed it down to only log
1643   # message that occurred for the given $date, we will have a hash
1644   # containing 1 sender and the latest timestamp for the day.
1645   while (my $senderRef = $sth->fetchrow_hashref) {
1646     my %sender = %{$senderRef};
1647
1648     $senders{$sender{sender}} = $sender{timestamp}
1649       unless $senders{$sender{sender}};
1650   } # while
1651
1652   $sth->finish;
1653
1654   # Make a hash whose keys are the timestamp (so we can later sort on
1655   # them).
1656   while (my ($key, $value) = each %senders) {
1657     $sendersByTimestamp{$value} = $key;
1658   } # while
1659
1660   my @senders;
1661
1662   # Sort by timestamp desc and push on to the @senders array
1663   push @senders, $sendersByTimestamp{$_}
1664     for (sort { $b cmp $a } keys %sendersByTimestamp);
1665
1666   # Finally slice for the given range
1667   my $end_at = $start_at + $nbr_emails - 1;
1668
1669   $end_at = (@senders - 1)
1670     if $end_at > @senders;
1671
1672   return (@senders) [$start_at .. $end_at];
1673 } # ReturnSenders
1674
1675 sub SaveMsg($$$) {
1676   my ($sender, $subject, $data) = @_;
1677
1678   AddEmail($sender, $subject, $data);
1679
1680   return;
1681 } # SaveMsg
1682
1683 sub SearchEmails($$) {
1684   my ($userid, $searchfield) = @_;
1685
1686   my @emails;
1687
1688   my $statement =
1689     "select sender, subject, timestamp from email where userid = '$userid' and (
1690      sender like '%$searchfield%' or subject like '%$searchfield%')
1691      order by timestamp desc";
1692
1693   my $sth = $DB->prepare($statement)
1694     or DBError('SearchEmails: Unable to prepare statement', $statement);
1695
1696   $sth->execute
1697     or DBError('SearchEmails: Unable to execute statement', $statement);
1698
1699   while (my @row = $sth->fetchrow_array) {
1700     my $date    = pop @row;
1701     my $subject = pop @row;
1702     my $sender  = pop @row;
1703
1704     push @emails, [$sender, $subject, $date];
1705   } # while
1706
1707   $sth->finish;
1708
1709   return @emails;
1710 } # SearchEmails
1711
1712 sub SendMsg($$$$@) {
1713   # SendMsg will send the message contained in $msgfile.
1714   my ($sender, $subject, $msgfile, $userid, @spammsg) = @_;
1715
1716   my @lines;
1717
1718   # Open return message template file
1719   open my $return_msg_file, '<', $msgfile
1720     or die "Unable to open return msg file ($msgfile): $!\n";
1721
1722   # Read return message template file and print it to $msg_body
1723   while (<$return_msg_file>) {
1724     if (/\$userid/) {
1725       # Replace userid
1726       s/\$userid/$userid/;
1727     } # if
1728     if (/\$sender/) {
1729       # Replace sender
1730       s/\$sender/$sender/;
1731     } #if
1732
1733     push @lines, $_;
1734   } # while
1735
1736   close $return_msg_file;
1737
1738   # Create the message, and set up the mail headers:
1739   my $msg = MIME::Entity->build(
1740     From    => "MAPS\@DeFaria.com",
1741     To      => $sender,
1742     Subject => $subject,
1743     Type    => "text/html",
1744     Data    => \@lines
1745   );
1746
1747   # Need to obtain the spam message here...
1748   $msg->attach(
1749     Type        => "message",
1750     Disposition => "attachment",
1751     Data        => \@spammsg
1752   );
1753
1754   # Send it
1755   open my $mail, '|-', '/usr/lib/sendmail -t -oi -oem'
1756     or croak "SendMsg: Unable to open pipe to sendmail $!";
1757
1758   $msg->print(\*$mail);
1759
1760   close $mail;
1761
1762   return;
1763 } # SendMsg
1764
1765 sub SetContext($) {
1766   my ($to_user) = @_;
1767
1768   my $old_user = $userid;
1769
1770   if (UserExists($to_user)) {
1771     $userid = $to_user;
1772
1773     GetUserOptions($userid);
1774     return GetUserInfo $userid;
1775   } else {
1776     return 0;
1777   } # if
1778 } # SetContext
1779
1780 sub Space($) {
1781   my ($userid) = @_;
1782
1783   my $total_space = 0;
1784   my %msg_space;
1785
1786   my $statement = "select * from email where userid = '$userid'";
1787   my $sth = $DB->prepare($statement)
1788     or DBError('Unable to prepare statement', $statement);
1789
1790   $sth->execute
1791     or DBError('Unable to execute statement', $statement);
1792
1793   while (my @row = $sth->fetchrow_array) {
1794     last if !@row;
1795
1796     my $data      = pop @row;
1797     my $timestamp = pop @row;
1798     my $subject   = pop @row;
1799     my $sender    = pop @row;
1800     my $user      = pop @row;
1801
1802     my $msg_space =
1803       length ($userid)    +
1804       length ($sender)    +
1805       length ($subject)   +
1806       length ($timestamp) +
1807       length ($data);
1808
1809     $total_space        += $msg_space;
1810     $msg_space{$sender} += $msg_space;
1811   } # while
1812
1813   $sth->finish;
1814
1815   return wantarray ? %msg_space : $total_space;
1816 } # Space
1817
1818 sub UpdateList($$$$$$$) {
1819   my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1820
1821   if (!$pattern || $pattern eq '') {
1822     $pattern = 'NULL';
1823   } else {
1824     $pattern = "'" . quotemeta ($pattern) . "'";
1825   } # if
1826
1827   if (!$domain || $domain eq '') {
1828     $domain = 'NULL';
1829   } else {
1830     $domain = "'" . quotemeta ($domain) . "'";
1831   } # if
1832
1833   if (!$comment || $comment eq '') {
1834     $comment = 'NULL';
1835   } else {
1836     $comment = "'" . quotemeta ($comment) . "'";
1837   } # if
1838
1839   if (!$hit_count || $hit_count eq '') {
1840     $hit_count = 0;
1841   #} else {
1842   # TODO: Check if numeric
1843   } # fi
1844
1845   my $statement =
1846     'update list set ' .
1847     "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
1848     "where userid = '$userid' and type = '$type' and sequence = $sequence";
1849
1850   $DB->do($statement)
1851     or DBError('UpdateList: Unable to do statement', $statement);
1852
1853   return 0;
1854 } # UpdateList
1855
1856 sub UpdateUser($$$$) {
1857   my ($userid, $fullname, $email, $password) = @_;
1858
1859   return 1 if !UserExists($userid);
1860
1861   my $statement;
1862
1863   if (!defined $password || $password eq '') {
1864     $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1865   } else {
1866     $password = Encrypt $password, $userid;
1867     $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1868   } # if
1869
1870   $DB->do($statement)
1871     or DBError('UpdateUser: Unable to do statement', $statement);
1872
1873   return 0;
1874 } # UpdateUser
1875
1876 sub UpdateUserOptions ($@) {
1877   my ($userid, %options)  = @_;
1878
1879   return unless UserExists($userid);
1880
1881   for (keys(%options)) {
1882     my $statement = "update useropts set value='$options{$_}' where userid='$userid' and name='$_'";
1883
1884     $DB->do($statement)
1885       or DBError('UpdateUserOption: Unable to do statement', $statement);
1886   } # for
1887
1888   return;
1889 } # UpdateUserOptions
1890
1891 sub UserExists($) {
1892   my ($userid) = @_;
1893
1894   return 0 unless $userid;
1895
1896   my $statement = "select userid, password from user where userid = '$userid'";
1897
1898   my $sth = $DB->prepare($statement)
1899       or DBError('UserExists: Unable to prepare statement', $statement);
1900
1901   $sth->execute
1902     or DBError('UserExists: Unable to execute statement', $statement);
1903
1904   my @userdata = $sth->fetchrow_array;
1905
1906   $sth->finish;
1907
1908   return 0 if scalar(@userdata) == 0;
1909
1910   my $dbpassword = pop @userdata;
1911   my $dbuserid   = pop @userdata;
1912
1913   if ($dbuserid ne $userid) {
1914     return 0;
1915   } else {
1916     return $dbpassword;
1917   } # if
1918 } # UserExists
1919
1920 sub Whitelist ($$;$$) {
1921   # Whitelist will deliver the message.
1922   my ($sender, $data, $sequence, $hit_count) = @_;
1923
1924   my $userid = GetContext;
1925
1926   # Dump message into a file
1927   open my $message, '>', "/tmp/MAPSMessage.$$"
1928     or Error("Unable to open message file (/tmp/MAPSMessage.$$): $!\n"), return -1;
1929
1930   print $message $data;
1931
1932   close $message;
1933
1934   # Now call MAPSDeliver
1935   my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
1936
1937   unlink "/tmp/MAPSMessage.$$";
1938
1939   if ($status == 0) {
1940     Logmsg("whitelist", $sender, "Delivered message");
1941   } else {
1942     Error("Unable to deliver message - is MAPSDeliver setgid? - $!");
1943   } # if
1944
1945   RecordHit("white", $sequence, ++$hit_count) if $sequence;
1946
1947   return $status;
1948 } # Whitelist
1949
1950 sub count($$) {
1951   my ($table, $condition) = @_;
1952
1953   my $statement;
1954
1955   if ($condition) {
1956     $statement = "select count(*) from $table where $condition";
1957   } else {
1958     $statement = "select count(*) from $table";
1959   } # if
1960
1961   my $sth = $DB->prepare($statement)
1962     or DBError('count: Unable to prepare statement', $statement);
1963
1964   $sth->execute
1965     or DBError('count: Unable to execute statement', $statement);
1966
1967   # Get return value, which should be how many message there are
1968   my @row = $sth->fetchrow_array;
1969
1970   # Done with $sth
1971   $sth->finish;
1972
1973   my $count;
1974
1975   # Retrieve returned value
1976   unless ($row[0]) {
1977     $count = 0
1978   } else {
1979     $count = $row[0];
1980   } # unless
1981
1982   return $count
1983 } # count
1984
1985 sub count_distinct($$$) {
1986   my ($table, $column, $condition) = @_;
1987
1988   my $statement;
1989
1990   if ($condition) {
1991     $statement = "select count(distinct $column) from $table where $condition";
1992   } else {
1993     $statement = "select count(distinct $column) from $table";
1994   } # if
1995
1996   my $sth = $DB->prepare($statement)
1997     or DBError('count: Unable to prepare statement', $statement);
1998
1999   $sth->execute
2000     or DBError('count: Unable to execute statement', $statement);
2001
2002   # Get return value, which should be how many message there are
2003   my @row = $sth->fetchrow_array;
2004
2005   # Done with $sth
2006   $sth->finish;
2007
2008   # Retrieve returned value
2009   unless ($row[0]) {
2010     return 0;
2011   } else {
2012     return $row[0];
2013   } # unless
2014 } # count_distinct
2015
2016 sub countlog(;$) {
2017   my ($additional_condition) = @_;
2018
2019   my $condition = "userid=\'$userid\' ";
2020
2021   $condition .= "and $additional_condition" if $additional_condition;
2022
2023   return count_distinct('log', 'sender', $condition);
2024 } # countlog
2025
2026 1;