maps/bin/MAPSDB.pm

   1 #!/usr/bin/perl
   2 #################################################################################
   3 #
   4 # File:         $RCSfile: MAPSDB.pm,v $
   5 # Revision:        $Revision: 1.1 $
   6 # Description:  MAPS Database routines
   7 # Author:       Andrew@DeFaria.com
   8 # Created:      Fri Nov 29 14:17:21  2002
   9 # Modified:     $Date: 2013/06/12 14:05:47 $
  10 # Language:     perl
  11 #
  12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 package MAPSDB;
  16
  17 use strict;
  18 use vars qw (@ISA @EXPORT);
  19 use DBI;
  20
  21 use MAPSUtil;
  22
  23 @ISA = qw (Exporter);
  24
  25 # Globals
  26 my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER};
  27 my %useropts;
  28 my $DB;
  29
  30 @EXPORT = qw (
  31   AddLog
  32   CheckOnList
  33   CloseDB
  34   DBError
  35   OpenDB
  36   RecordHit
  37 );
  38
  39 # Forwards
  40 sub AddEmail;
  41 sub AddList;
  42 sub AddLog;
  43 sub AddUser;
  44 sub AddUserOption;
  45 sub CheckOnList;
  46 sub CleanEmail;
  47 sub CleanLog;
  48 sub CleanList;
  49 sub CloseDB;
  50 sub CountMsg;
  51 sub DBError;
  52 sub Decrypt;
  53 sub DeleteEmail;
  54 sub DeleteList;
  55 sub Encrypt;
  56 sub FindEmail;
  57 sub FindList;
  58 sub FindLog;
  59 sub FindUser;
  60 sub GetContext;
  61 sub GetEmail;
  62 sub GetList;
  63 sub GetLog;
  64 sub GetNextSequenceNo;
  65 sub GetUser;
  66 sub GetUserInfo;
  67 sub GetUserOptions;
  68 sub OpenDB;
  69 sub OptimizeDB;
  70 sub ResequenceList;
  71 sub ReturnEmails;
  72 sub ReturnList;
  73 sub ReturnListEntry;
  74 sub SetContext;
  75 sub Space;
  76 sub UpdateList;
  77 sub UpdateUser;
  78 sub UpdateUserOption;
  79 sub UserExists;
  80 sub count;
  81 sub countlog;
  82
  83 sub AddEmail ($$$) {
  84   my ($sender, $subject, $data) = @_;
  85
  86   # "Sanitize" some fields so that characters that are illegal to SQL are escaped
  87   $sender = 'Unknown'
  88     if (!defined $sender || $sender eq '');
  89   $sender  = $DB->quote ($sender);
  90   $subject = $DB->quote ($subject);
  91   $data    = $DB->quote ($data);
  92
  93   my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
  94   my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)";
  95
  96   $DB->do ($statement)
  97     or DBError 'AddEmail: Unable to do statement', $statement;
  98 } # AddEmail
  99
 100 sub AddList ($$$;$$) {
 101   my ($listtype, $pattern, $sequence, $comment, $hitcount) = @_;
 102
 103   $hitcount ||= 0;
 104
 105   my ($user, $domain)  = split /\@/, $pattern;
 106
 107   if (!$domain || $domain eq '') {
 108     $domain  = 'NULL';
 109     $pattern = $DB->quote ($user);
 110   } else {
 111     $domain  = "'$domain'";
 112     if ($user eq '') {
 113       $pattern = 'NULL';
 114     } else {
 115       $pattern = $DB->quote ($user);
 116     } # if
 117   } # if
 118
 119   if (!$comment || $comment eq '') {
 120     $comment = 'NULL';
 121   } else {
 122     $comment = $DB->quote ($comment);
 123   } # if
 124
 125   # Get next sequence #
 126   if ($sequence eq 0) {
 127     $sequence = GetNextSequenceNo $userid, $listtype;
 128   } # if
 129
 130   my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
 131
 132   my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hitcount, \"$timestamp\")";
 133
 134   $DB->do ($statement)
 135     or DBError 'AddList: Unable to do statement', $statement;
 136 } # AddList
 137
 138 sub AddLog ($$$) {
 139   my ($type, $sender, $msg) = @_;
 140
 141   my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
 142   my $statement;
 143
 144   # Use quote to protect ourselves
 145   $msg = $DB->quote ($msg);
 146
 147   if ($sender eq '') {
 148     $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)";
 149   } else {
 150     $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)";
 151   } # if
 152
 153   $DB->do ($statement)
 154     or DBError 'AddLog: Unable to do statement', $statement;
 155 } # AddLog
 156
 157 sub AddUser ($$$$) {
 158   my ($userid, $realname, $email, $password) = @_;
 159
 160   $password = Encrypt $password, $userid;
 161
 162   if (UserExists $userid) {
 163     return 1;
 164   } else {
 165     my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')";
 166
 167     $DB->do ($statement)
 168       or DBError 'AddUser: Unable to do statement', $statement;
 169   } # if
 170
 171   return 0;
 172 } # AddUser
 173
 174 sub AddUserOption ($$$) {
 175   my ($userid, $name, $value) = @_;
 176
 177   if (!UserExists $userid) {
 178     return 1;
 179   } # if
 180
 181   my $statement = "insert into useropts values ('$userid', '$name', '$value')";
 182
 183   $DB->do ($statement)
 184     or DBError 'AddUserOption: Unable to do statement', $statement;
 185
 186   return 0;
 187 } # AddUserOption
 188
 189 sub RecordHit ($$$) {
 190   my ($listtype, $sequence, $hit_count) = @_;
 191
 192   my $current_date = UnixDatetime2SQLDatetime (scalar (localtime));
 193
 194   my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
 195
 196   $DB->do ($statement)
 197     or DBError 'AddList: Unable to do statement', $statement;
 198 } # RecordHit
 199
 200 sub CheckOnList ($$) {
 201   # CheckOnList will check to see if the $sender is on the $listfile.
 202   # Return 1 if found 0 if not.
 203   my ($listtype, $sender) = @_;
 204
 205   my $status   = 0;
 206   my $rule;
 207
 208   my $statement = "select pattern, domain, comment, sequence, hit_count from list where userid = '$userid' and type = '$listtype'";
 209
 210   my $sth = $DB->prepare ($statement)
 211     or DBError 'CheckOnList: Unable to prepare statement', $statement;
 212
 213   $sth->execute
 214     or DBError 'CheckOnList: Unable to execute statement', $statement;
 215
 216   while (my @row = $sth->fetchrow_array) {
 217     last if !@row;
 218
 219     my $hit_count = pop (@row);
 220     my $sequence  = pop (@row);
 221     my $comment   = pop (@row);
 222     my $domain    = pop (@row);
 223     my $pattern   = pop (@row);
 224     my $email_on_file;
 225
 226     unless ($domain) {
 227       $email_on_file = $pattern;
 228     } else {
 229       unless ($pattern) {
 230         $email_on_file = '@' . $domain;
 231       } else {
 232         $email_on_file = $pattern . '@' . $domain;
 233       } # if
 234     } # unless
 235
 236     # Escape some special characters
 237     $email_on_file =~ s/\@/\\@/;
 238     $email_on_file =~ s/^\*/.\*/;
 239
 240     # We want to terminate the search string with a "$" iff there's an
 241     # "@" in there. This is because some "email_on_file" may have no
 242     # domain (e.g. "mailer-daemon" with no domain). In that case we
 243     # don't want to terminate the search string with a "$" rather we
 244     # wish to terminate it with an "@". But in the case of say
 245     # "@ti.com" if we don't terminate the search string with "$" then
 246     # "@ti.com" would also match "@tixcom.com"!
 247     my $search_for = $email_on_file =~ /\@/
 248                    ? "$email_on_file\$"
 249                    : !defined $domain
 250                    ? "$email_on_file\@"
 251                    : $email_on_file;
 252
 253     if ($sender =~ /$search_for/i) {
 254       $rule   = "Matching rule: ($listtype:$sequence) \"$email_on_file\"";
 255       $rule  .= " - $comment" if $comment and $comment ne '';
 256       $status = 1;
 257
 258       RecordHit $listtype, $sequence, ++$hit_count;
 259
 260       last;
 261     } # if
 262   } # while
 263
 264   $sth->finish;
 265
 266   return ($status, $rule);
 267 } # CheckOnList
 268
 269 sub CleanEmail ($) {
 270   my ($timestamp) = @_;
 271
 272   # First see if anything needs to be deleted
 273   my $count = 0;
 274
 275   my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'";
 276
 277   # Prepare statement
 278   my $sth = $DB->prepare ($statement)
 279     or DBError 'CleanEmail: Unable to prepare statement', $statement;
 280
 281   # Execute statement
 282   $sth->execute
 283     or DBError 'CleanEmail: Unable to execute statement', $statement;
 284
 285   # Get return value, which should be how many entries were deleted
 286   my @row = $sth->fetchrow_array;
 287
 288   # Done with $sth
 289   $sth->finish;
 290
 291   # Retrieve returned value
 292   unless ($row[0]) {
 293     $count = 0
 294   } else {
 295     $count = $row[0];
 296   } # unless
 297
 298   # Just return if there's nothing to delete
 299   return $count if ($count eq 0);
 300
 301   # Delete emails for userid whose older than $timestamp
 302   $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
 303
 304   # Prepare statement
 305   $sth = $DB->prepare ($statement)
 306     or DBError 'CleanEmail: Unable to prepare statement', $statement;
 307
 308   # Execute statement
 309   $sth->execute
 310     or DBError 'CleanEmail: Unable to execute statement', $statement;
 311
 312   return $count;
 313 } # CleanEmail
 314
 315 sub CleanLog  ($) {
 316   my ($timestamp) = @_;
 317
 318   # First see if anything needs to be deleted
 319   my $count = 0;
 320
 321   my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'";
 322
 323   # Prepare statement
 324   my $sth = $DB->prepare ($statement)
 325     or DBError $DB, 'CleanLog: Unable to prepare statement', $statement;
 326
 327   # Execute statement
 328   $sth->execute
 329     or DBError 'CleanLog: Unable to execute statement', $statement;
 330
 331   # Get return value, which should be how many entries were deleted
 332   my @row = $sth->fetchrow_array;
 333
 334   # Done with $sth
 335   $sth->finish;
 336
 337   # Retrieve returned value
 338   unless ($row[0]) {
 339     $count = 0
 340   } else {
 341     $count = $row[0];
 342   } # unless
 343
 344   # Just return if there's nothing to delete
 345   return $count if ($count eq 0);
 346
 347   # Delete log entries for userid whose older than $timestamp
 348   $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
 349
 350   # Prepare statement
 351   $sth = $DB->prepare ($statement)
 352     or DBError 'CleanLog: Unable to prepare statement', $statement;
 353
 354   # Execute statement
 355   $sth->execute
 356     or DBError 'CleanLog: Unable to execute statement', $statement;
 357
 358   return $count;
 359 } # CleanLog
 360
 361 sub CleanList ($;$) {
 362   my ($timestamp, $listtype) = @_;
 363
 364   $listtype = 'null' if !$listtype;
 365
 366   # First see if anything needs to be deleted
 367   my $count = 0;
 368
 369   my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
 370
 371   # Prepare statement
 372   my $sth = $DB->prepare ($statement)
 373     or DBError $DB, 'CleanList: Unable to prepare statement', $statement;
 374
 375   # Execute statement
 376   $sth->execute
 377     or DBError 'CleanList: Unable to execute statement', $statement;
 378
 379   # Get return value, which should be how many entries were deleted
 380   my @row = $sth->fetchrow_array;
 381
 382   # Done with $sth
 383   $sth->finish;
 384
 385   # Retrieve returned value
 386   $count = $row[0] ? $row[0] : 0;
 387
 388   # Just return if there's nothing to delete
 389   return $count if ($count eq 0);
 390
 391   # Get data for these entries
 392   $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
 393
 394   # Prepare statement
 395   $sth = $DB->prepare ($statement)
 396     or DBError 'CleanList: Unable to prepare statement', $statement;
 397
 398   # Execute statement
 399   $sth->execute
 400     or DBError 'CleanList: Unable to execute statement', $statement;
 401
 402   $count = 0;
 403
 404   while (my @row = $sth->fetchrow_array) {
 405     last if !@row;
 406
 407     my $hit_count = pop (@row);
 408     my $sequence  = pop (@row);
 409     my $listtype  = pop (@row);
 410
 411     if ($hit_count == 0) {
 412       $count++;
 413
 414       $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence";
 415       $DB->do ($statement)
 416         or DBError 'CleanList: Unable to execute statement', $statement;
 417     } else {
 418       # Age entry: Sometimes entries are initially very popular and
 419       # the $hit_count gets very high quickly. Then the domain is
 420       # abandoned and no activity happens. One case recently observed
 421       # was for phentermine.com. The $hit_count initially soared to
 422       # 1920 within a few weeks. Then it all stopped as of
 423       # 07/13/2007. Obvisously this domain was shutdown. With the
 424       # previous aging algorithm of simply subtracting 1 this
 425       # phentermine.com entry would hang around for over 5 years!
 426       #
 427       # So the tack here is to age the entry by dividing it's
 428       # $hit_count in half. Sucessive halfing then will quickly age
 429       # the entry down to size. However we don't want to age small
 430       # $hit_count's too quickly, therefore once their numbers drop to
 431       # < 30 we revert to the old method of subtracting 1.
 432       if ($hit_count < 30) {
 433         $hit_count--;
 434       } else {
 435         $hit_count = $hit_count / 2;
 436       } # if
 437
 438       $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;";
 439       $DB->do ($statement)
 440         or DBError 'CleanList: Unable to execute statement', $statement;
 441     } # if
 442   } # while
 443
 444   ResequenceList $userid, $listtype if $count > 0;
 445
 446   return $count;
 447 } # CleanList
 448
 449 sub CloseDB () {
 450   $DB->disconnect;
 451 } # CloseDB
 452
 453 sub CountMsg ($) {
 454   my ($sender) = @_;
 455
 456   return count ('email', "userid = '$userid' and sender like '%$sender%'");
 457 } # CountMsg
 458
 459 sub DBError ($$) {
 460   my ($msg, $statement) = @_;
 461
 462   print 'MAPSDB::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n";
 463
 464   if ($statement) {
 465     print "SQL Statement: $statement\n";
 466   } # if
 467
 468   exit $DB->err;
 469 } # DBError
 470
 471 sub Decrypt ($$) {
 472   my ($password, $userid) = @_;
 473
 474   my $statement = "select decode('$password','$userid')";
 475
 476   my $sth = $DB->prepare ($statement)
 477     or DBError 'Decrypt: Unable to prepare statement', $statement;
 478
 479   $sth->execute
 480     or DBError 'Decrypt: Unable to execute statement', $statement;
 481
 482   # Get return value, which should be the encoded password
 483   my @row = $sth->fetchrow_array;
 484
 485   # Done with $sth
 486   $sth->finish;
 487
 488   return $row[0]
 489 } # Decrypt
 490
 491 sub DeleteEmail ($) {
 492   my $sender = shift;
 493
 494   my ($username, $domain) = split /@/, $sender;
 495   my $condition;
 496
 497   if ($username eq '') {
 498     $condition = "userid = '$userid' and sender like '%\@$domain'";
 499   } else {
 500     $condition = "userid = '$userid' and sender = '$sender'";
 501   } # if
 502
 503   # First see if anything needs to be deleted
 504   my $count = count ('email', $condition);
 505
 506   # Just return if there's nothing to delete
 507   return $count if ($count eq 0);
 508
 509   my $statement = 'delete from email where ' . $condition;
 510
 511   $DB->do ($statement)
 512     or DBError 'DeleteEmail: Unable to execute statement', $statement;
 513
 514   return $count;
 515 } # DeleteEmail
 516
 517 sub DeleteList ($$) {
 518   my ($type, $sequence) = @_;
 519
 520   # First see if anything needs to be deleted
 521   my $count = count ('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
 522
 523   # Just return if there's nothing to delete
 524   return $count if ($count eq 0);
 525
 526   my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
 527
 528   $DB->do ($statement)
 529     or DBError 'DeleteList: Unable to execute statement', $statement;
 530
 531   return $count;
 532 } # DeleteList
 533
 534 sub DeleteLog ($) {
 535   my ($sender) = @_;
 536
 537   my ($username, $domain) = split /@/, $sender;
 538   my $condition;
 539
 540   if ($username eq '') {
 541     $condition = "userid = '$userid' and sender like '%\@$domain'";
 542   } else {
 543     $condition = "userid = '$userid' and sender = '$sender'";
 544   } # if
 545
 546   # First see if anything needs to be deleted
 547   my $count = count ('log', $condition);
 548
 549   # Just return if there's nothing to delete
 550   return $count if ($count eq 0);
 551
 552   my $statement = 'delete from log where ' . $condition;
 553
 554   $DB->do ($statement)
 555     or DBError 'DeleteLog: Unable to execute statement', $statement;
 556
 557   return $count;
 558 } # DeleteLog
 559
 560 sub Encrypt ($$) {
 561   my ($password, $userid) = @_;
 562
 563   my $statement = "select encode('$password','$userid')";
 564
 565   my $sth = $DB->prepare ($statement)
 566     or DBError 'Encrypt: Unable to prepare statement', $statement;
 567
 568   $sth->execute
 569     or DBError 'Encrypt: Unable to execute statement', $statement;
 570
 571   # Get return value, which should be the encoded password
 572   my @row = $sth->fetchrow_array;
 573
 574   # Done with $sth
 575   $sth->finish;
 576
 577   return $row[0]
 578 } # Encrypt
 579
 580 sub FindEmail (;$) {
 581   my ($sender) = @_;
 582
 583   my $statement;
 584
 585   if (!defined $sender || $sender eq '') {
 586     $statement = "select * from email where userid = '$userid'";
 587   } else {
 588     $statement = "select * from email where userid = '$userid' and sender = '$sender'";
 589   } # if
 590
 591   my $sth = $DB->prepare ($statement)
 592     or DBError 'FindEmail: Unable to prepare statement', $statement;
 593
 594   $sth->execute
 595     or DBError 'FindEmail: Unable to execute statement', $statement;
 596
 597   return $sth;
 598 } # FindEmail
 599
 600 sub FindList ($;$) {
 601   my ($type, $sender) = @_;
 602
 603   my $statement;
 604
 605   unless ($sender) {
 606     $statement = "select * from list where userid = '$userid' and type = '$type'";
 607   } else {
 608     my ($pattern, $domain) = split /\@/, $sender;
 609     $statement = "select * from list where userid = '$userid' and type = '$type' " .
 610                  "and pattern = '$pattern' and domain = '$domain'";
 611   } # unless
 612
 613   # Prepare statement
 614   my $sth = $DB->prepare ($statement)
 615     or DBError 'FindList: Unable to prepare statement', $statement;
 616
 617   # Execute statement
 618   $sth->execute
 619     or DBError 'FindList: Unable to execute statement', $statement;
 620
 621   # Get return value, which should be how many entries were deleted
 622   return $sth;
 623 } # FindList
 624
 625 sub FindLog ($$) {
 626   my ($start_at, $end_at) = @_;
 627
 628   my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
 629
 630   # Prepare statement
 631   my $sth = $DB->prepare ($statement)
 632     or DBError 'FindLog: Unable to prepare statement', $statement;
 633
 634   # Execute statement
 635   $sth->execute
 636     or DBError 'FindLog: Unable to execute statement', $statement;
 637
 638   # Get return value, which should be how many entries were deleted
 639   return $sth;
 640 } # FindLog
 641
 642 sub FindUser (;$) {
 643   my ($userid) = @_;
 644
 645   my $statement;
 646
 647   if (!defined $userid || $userid eq '') {
 648     $statement = 'select * from user';
 649   } else {
 650     $statement = "select * from user where userid = '$userid'";
 651   } # if
 652
 653   my $sth = $DB->prepare ($statement)
 654     or DBError 'FindUser: Unable to prepare statement', $statement;
 655
 656   $sth->execute
 657     or DBError 'FindUser: Unable to execute statement', $statement;
 658
 659   return $sth;
 660 } # FindUser
 661
 662 sub GetContext () {
 663   return $userid;
 664 } # GetContext
 665
 666 sub GetEmail ($) {
 667   my ($sth) = @_;
 668
 669   my @email;
 670
 671   if (@email = $sth->fetchrow_array) {
 672     my $message   = pop @email;
 673     my $timestamp = pop @email;
 674     my $subject   = pop @email;
 675     my $sender    = pop @email;
 676     my $userid    = pop @email;
 677     return $userid, $sender, $subject, $timestamp, $message;
 678   } else {
 679     return undef;
 680   } # if
 681 } # GetEmail
 682
 683 sub GetList ($) {
 684   my ($sth) = @_;
 685
 686   my @list;
 687
 688   if (@list = $sth->fetchrow_array) {
 689     my $last_hit  = pop @list;
 690     my $hit_count = pop @list;
 691     my $sequence  = pop @list;
 692     my $comment   = pop @list;
 693     my $domain    = pop @list;
 694     my $pattern   = pop @list;
 695     my $type      = pop @list;
 696     my $userid    = pop @list;
 697     return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
 698   } else {
 699     return undef;
 700   } # if
 701 } # GetList
 702
 703 sub GetLog ($) {
 704   my ($sth) = @_;
 705
 706   my @log;
 707
 708   if (@log = $sth->fetchrow_array) {
 709     my $message   = pop @log;
 710     my $type      = pop @log;
 711     my $sender    = pop @log;
 712     my $timestamp = pop @log;
 713     my $userid    = pop @log;
 714     return $userid, $timestamp, $sender, $type, $message;
 715   } else {
 716     return undef;
 717   } # if
 718 } # GetLog
 719
 720 sub GetNextSequenceNo ($$) {
 721   my ($userid, $listtype) = @_;
 722
 723   my $count = count ('list', "userid = '$userid' and type = '$listtype'");
 724
 725   return $count + 1;
 726 } # GetNextSequenceNo
 727
 728 sub GetUser ($) {
 729   my ($sth) = @_;
 730
 731   my @user;
 732
 733   if (@user = $sth->fetchrow_array) {
 734     my $password = pop @user;
 735     my $email    = pop @user;
 736     my $name     = pop @user;
 737     my $userid   = pop @user;
 738     return ($userid, $name, $email, $password);
 739   } else {
 740     return undef;
 741   } # if
 742 } # GetUser
 743
 744 sub GetUserInfo ($) {
 745   my ($userid) = @_;
 746
 747   my $statement = "select name, email from user where userid='$userid'";
 748
 749   my $sth = $DB->prepare ($statement)
 750     or DBError 'GetUserInfo: Unable to prepare statement', $statement;
 751
 752   $sth->execute
 753     or DBError 'GetUserInfo: Unable to execute statement', $statement;
 754
 755   my @userinfo   = $sth->fetchrow_array;
 756   my $user_email = lc (pop @userinfo);
 757   my $username   = lc (pop @userinfo);
 758
 759   $sth->finish;
 760
 761   return ($username, $user_email);
 762 } # GetUserInfo
 763
 764 sub GetUserOptions ($) {
 765   my ($userid) = @_;
 766
 767   my $statement = "select * from useropts where userid = '$userid'";
 768
 769   my $sth = $DB->prepare ($statement)
 770     or DBError 'GetUserOptions: Unable to prepare statement', $statement;
 771
 772   $sth->execute
 773     or DBError 'GetUserOptions: Unable to execute statement', $statement;
 774
 775   my @useropts;
 776
 777   # Empty hash
 778   %useropts = ();
 779
 780   while (@useropts = $sth->fetchrow_array) {
 781     my $value = pop @useropts;
 782     my $name  = pop @useropts;
 783     pop @useropts;
 784     $useropts{$name} = $value;
 785   } # while
 786
 787   $sth->finish;
 788
 789   return %useropts;
 790 } # GetUserOptions
 791
 792 sub GetRows ($) {
 793   my ($statement) = @_;
 794
 795   my $sth = $DB->prepare ($statement)
 796     or DBError 'Unable to prepare statement' , $statement;
 797
 798   $sth->execute
 799     or DBError 'Unable to execute statement' , $statement;
 800
 801   my @array;
 802
 803   while (my @row = $sth->fetchrow_array) {
 804     foreach (@row) {
 805       push @array, $_;
 806     } # foreach
 807   } # while
 808
 809   return @array;
 810 } # GetRows
 811
 812 sub OpenDB ($$) {
 813   my ($username, $password) = @_;
 814
 815   my $dbname   = 'MAPS';
 816   my $dbdriver = 'mysql';
 817   my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
 818
 819   if (!$DB || $DB eq '') {
 820     #$dbserver='localhost';
 821     $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
 822       or die "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
 823   } # if
 824
 825   return $DB;
 826 } # OpenDB
 827
 828 sub OptimizeDB () {
 829   my $statement = 'lock tables email read, list read, log read, user read, useropts read';
 830   my $sth = $DB->prepare ($statement)
 831       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 832
 833   $sth->execute
 834     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 835
 836   $statement = 'check table email, list, log, user, useropts';
 837   $sth = $DB->prepare ($statement)
 838       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 839
 840   $sth->execute
 841     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 842
 843   $statement = 'unlock tables';
 844   $sth = $DB->prepare ($statement)
 845       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 846
 847   $sth->execute
 848     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 849
 850   $statement = 'optimize table email, list, log, user, useropts';
 851   $sth = $DB->prepare ($statement)
 852       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 853
 854   $sth->execute
 855     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 856 } # OptimizeDB
 857
 858 sub ResequenceList ($$) {
 859   my ($userid, $type) = @_;
 860
 861   if ($type ne 'white' && $type ne 'black' && $type ne 'null') {
 862     return 1;
 863   } # if
 864
 865   if (!UserExists $userid) {
 866     return 2;
 867   } # if
 868
 869   my $statement = "select sequence from list where userid = '$userid' ".
 870                   " and type = '$type' order by sequence";
 871
 872   my $sth = $DB->prepare ($statement)
 873       or DBError 'ResequenceList: Unable to prepare statement', $statement;
 874
 875   $sth->execute
 876     or DBError 'ResequenceList: Unable to execute statement', $statement;
 877
 878   my $sequence = 1;
 879
 880   while (my @row = $sth->fetchrow_array) {
 881     last if !@row;
 882     my $old_sequence = pop (@row);
 883
 884     if ($old_sequence != $sequence) {
 885       my $update_statement = "update list set sequence = $sequence " .
 886                              "where userid = '$userid' and " .
 887                              "type = '$type' and sequence = $old_sequence";
 888       $DB->do ($update_statement)
 889         or DBError 'ResequenceList: Unable to do statement', $statement;
 890     } # if
 891
 892     $sequence++;
 893   } # while
 894
 895   return 0;
 896 } # ResequenceList
 897
 898 # This subroutine returns an array of senders in reverse chronological
 899 # order based on time timestamp from the log table of when we returned
 900 # their message. The complication here is that a single sender may
 901 # send multiple times in a single day. So if spammer@foo.com sends
 902 # spam @ 1 second after midnight and then again at 2 Pm there will be
 903 # at least two records in the log table saying that we returned his
 904 # email. Getting records sorted by timestamp desc will have
 905 # spammer@foo.com listed twice. But we want him listed only once, as
 906 # the first entry in the returned array. Plus we may be called
 907 # repeatedly with different $start_at's. Therefore we need to process
 908 # the whole list of returns for today, eliminate duplicate entries for
 909 # a single sender then slice the resulting array.
 910 sub ReturnSenders ($$$;$$) {
 911   my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
 912
 913   $start_at ||= 0;
 914
 915   my $dateCond = '';
 916
 917   if ($date) {
 918     my $sod = $date . ' 00:00:00';
 919     my $eod = $date . ' 23:59:59';
 920
 921     $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
 922   } # if
 923
 924   my $statement = <<END;
 925 select
 926   sender,
 927   timestamp
 928 from
 929   log
 930 where
 931   userid = '$userid' and
 932   type   = '$type'
 933   $dateCond
 934 order by
 935   timestamp desc
 936 END
 937
 938   my $sth = $DB->prepare ($statement)
 939     or DBError 'ReturnSenders: Unable to prepare statement', $statement;
 940
 941   $sth->execute
 942     or DBError 'ReturnSenders: Unable to execute statement', $statement;
 943
 944   # Watch the distinction between senders (plural) and sender (singular)
 945   my (%senders, %sendersByTimestamp);
 946
 947   # Run through the results and add to %senders by sender key. This
 948   # results in a hash that has the sender in it and the first
 949   # timestamp value. Since we already sorted timestamp desc by the
 950   # above select statement, and we've narrowed it down to only log
 951   # message that occurred for the given $date, we will have a hash
 952   # containing 1 sender and the latest timestamp for the day.
 953   while (my $senderRef = $sth->fetchrow_hashref) {
 954     my %sender = %{$senderRef};
 955
 956     $senders{$sender{sender}} = $sender{timestamp}
 957       unless $senders{$sender{sender}};
 958   } # while
 959
 960   $sth->finish;
 961
 962   # Make a hash whose keys are the timestamp (so we can later sort on
 963   # them).
 964   while (my ($key, $value) = each %senders) {
 965     $sendersByTimestamp{$value} = $key;
 966   } # while
 967
 968   my @senders;
 969
 970   # Sort by timestamp desc and push on to the @senders array
 971   push @senders, $sendersByTimestamp{$_}
 972     foreach (sort { $b cmp $a } keys %sendersByTimestamp);
 973
 974   # Finally slice for the given range
 975   my $end_at = $start_at + $nbr_emails - 1;
 976
 977   $end_at = (@senders - 1)
 978     if $end_at > @senders;
 979
 980   return (@senders) [$start_at .. $end_at];
 981 } # ReturnSenders
 982
 983 sub ReturnMessages ($$) {
 984   my ($userid, $sender) = @_;
 985
 986   # Note, the left(timestamp,16) chops off the seconds and the group
 987   # by effectively squashes two emails received in the same minute to
 988   # just one. We get a lot of double emails within the same minute. I
 989   # think it's a result of the mailer configuration and it attempting
 990   # to resend the message, not that it's the spammer sending just two
 991   # emails in under a minute then going away. This will mean we will
 992   # see fewer emails listed (essentially dups within one minute are
 993   # squashed) yet they still will count towards the number of hits
 994   # before we autonullist. We should squash these upon receipt, not
 995   # upon report. Maybe latter...
 996   my $statement = <<END;
 997 select
 998   subject,
 999   left(timestamp,16)
1000 from
1001   email
1002 where
1003   userid = '$userid' and
1004   sender = '$sender'
1005 group by
1006   left(timestamp,16) desc
1007 END
1008
1009   my $sth = $DB->prepare ($statement)
1010     or DBError 'ReturnMessages: Unable to prepare statement', $statement;
1011
1012   $sth->execute
1013     or DBError 'ReturnMessages: Unable to execute statement', $statement;
1014
1015   my @messages;
1016
1017   while (my @row = $sth->fetchrow_array) {
1018     my $date    = pop @row;
1019     my $subject = pop @row;
1020
1021     push @messages, [$subject, $date];
1022   } # while
1023
1024   $sth->finish;
1025
1026   return @messages;
1027 } # ReturnMessages
1028
1029 sub ReturnEmails ($$$;$$) {
1030   my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1031
1032   $start_at ||= 0;
1033
1034   my $statement;
1035
1036   if ($date) {
1037     my $sod = $date . ' 00:00:00';
1038     my $eod = $date . ' 23:59:59';
1039
1040     if ($type eq 'returned') {
1041       $statement = <<END;
1042 select
1043   log.sender
1044 from
1045   log,
1046   email
1047 where
1048   log.sender    = email.sender and
1049   log.userid    = '$userid'    and
1050   log.timestamp > '$sod'       and
1051   log.timestamp < '$eod'       and
1052   log.type      = '$type'
1053 group by
1054   log.sender
1055 limit
1056   $start_at, $nbr_emails
1057 END
1058     } else {
1059       $statement = <<END;
1060 select
1061   sender
1062 from
1063   log
1064 where
1065   userid    = '$userid'    and
1066   timestamp > '$sod'       and
1067   timestamp < '$eod'       and
1068   type      = '$type'
1069 group by
1070   sender
1071 limit
1072   $start_at, $nbr_emails
1073 END
1074     } # if
1075   } else {
1076     if ($type eq 'returned') {
1077       $statement = <<END;
1078 select
1079   log.sender
1080 from
1081   log,
1082   email
1083 where
1084   log.sender   = email.sender and
1085   log.userid   = '$userid'    and
1086   log.type     = '$type'
1087 group by
1088   log.sender
1089 order by
1090   log.timestamp desc
1091 limit
1092   $start_at, $nbr_emails
1093 END
1094     } else {
1095       $statement = <<END;
1096 select
1097   sender
1098 from
1099   log
1100 where
1101   userid   = '$userid'    and
1102   type     = '$type'
1103 group by
1104   sender
1105 order by
1106   timestamp desc
1107 limit
1108   $start_at, $nbr_emails
1109 END
1110     } # if
1111   } # if
1112
1113   my $sth = $DB->prepare ($statement)
1114     or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1115
1116   $sth->execute
1117     or DBError 'ReturnEmails: Unable to execute statement', $statement;
1118
1119   my @emails;
1120
1121   while (my $sender = $sth->fetchrow_array) {
1122     my $earliestDate;
1123
1124     # Get emails for this sender. Format an array of subjects and timestamps.
1125     my @messages;
1126
1127     $statement = "select timestamp, subject from email where userid = '$userid' " .
1128                  "and sender = '$sender'";
1129
1130     my $sth2 = $DB->prepare ($statement)
1131       or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1132
1133     $sth2->execute
1134       or DBError 'ReturnEmails: Unable to execute statement', $statement;
1135
1136     while (my @row = $sth2->fetchrow_array) {
1137       my $subject = pop @row;
1138       my $date    = pop @row;
1139
1140       if ($earliestDate) {
1141         my $earliestDateShort = substr $earliestDate, 0, 10;
1142         my $dateShort         = substr $date,         0, 10;
1143
1144         if ($earliestDateShort eq $dateShort and
1145             $earliestDate > $date) {
1146           $earliestDate = $date
1147             if $earliestDateShort eq $dateShort;
1148         } # if
1149       } else {
1150         $earliestDate = $date;
1151       } # if
1152
1153       push @messages, [$subject, $date];
1154     } # while
1155
1156     # Done with sth2
1157     $sth2->finish;
1158
1159     $earliestDate ||= '';
1160
1161     unless ($type eq 'returned') {
1162       push @emails, [$earliestDate, [$sender, @messages]];
1163     } else {
1164       push @emails, [$earliestDate, [$sender, @messages]]
1165         if @messages > 0;
1166     } # unless
1167   } # while
1168
1169   # Done with $sth
1170   $sth->finish;
1171
1172   return @emails;
1173 } # ReturnEmails
1174
1175 sub ReturnList ($$$) {
1176   my ($type, $start_at, $lines) = @_;
1177
1178   $lines ||= 10;
1179
1180   my $statement;
1181
1182   if ($start_at) {
1183     $statement = "select * from list where userid = '$userid' " .
1184                  "and type = '$type' order by sequence "        .
1185                  "limit $start_at, $lines";
1186   } else {
1187     $statement = "select * from list where userid = '$userid' "        .
1188                  "and type = '$type' order by sequence";
1189   } # if
1190
1191   my $sth = $DB->prepare ($statement)
1192     or DBError 'ReturnList: Unable to prepare statement', $statement;
1193
1194   $sth->execute
1195     or DBError 'ReturnList: Unable to execute statement', $statement;
1196
1197   my @list;
1198   my $i = 0;
1199
1200   while (my @row = $sth->fetchrow_array) {
1201     last if $i++ > $lines;
1202
1203     my %list;
1204
1205     $list {last_hit}  = pop @row;
1206     $list {hit_count} = pop @row;
1207     $list {sequence}  = pop @row;
1208     $list {comment}   = pop @row;
1209     $list {domain}    = pop @row;
1210     $list {pattern}   = pop @row;
1211     $list {type}      = pop @row;
1212     $list {userid}    = pop @row;
1213     push @list, \%list;
1214   } # for
1215
1216   return @list;
1217 } # ReturnList
1218
1219 sub ReturnListEntry ($$) {
1220   my ($type, $sequence) = @_;
1221
1222   my $statement = "select * from list where userid = '$userid' "        .
1223                  "and type = '$type' and sequence = '$sequence'";
1224
1225   my $sth = $DB->prepare ($statement)
1226     or DBError 'ReturnListEntry: Unable to prepare statement', $statement;
1227
1228   $sth->execute
1229     or DBError 'ReturnListEntry: Unable to execute statement', $statement;
1230
1231   my %list;
1232   my @row = $sth->fetchrow_array;
1233
1234   $list {sequence} = pop @row;
1235   $list {comment}  = pop @row;
1236   $list {domain}   = pop @row;
1237   $list {pattern}  = pop @row;
1238   $list {type}     = pop @row;
1239   $list {userid}   = pop @row;
1240
1241   return %list;
1242 } # ReturnListEntry
1243
1244 sub UpdateList ($$$$$$$) {
1245   my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1246
1247   if (!$pattern || $pattern eq '') {
1248     $pattern = 'NULL';
1249   } else {
1250     $pattern = "'" . quotemeta ($pattern) . "'";
1251   } # if
1252
1253   if (!$domain || $domain eq '') {
1254     $domain = 'NULL';
1255   } else {
1256     $domain = "'" . quotemeta ($domain) . "'";
1257   } # if
1258
1259   if (!$comment || $comment eq '') {
1260     $comment = 'NULL';
1261   } else {
1262     $comment = "'" . quotemeta ($comment) . "'";
1263   } # if
1264
1265   if (!$hit_count || $hit_count eq '') {
1266     $hit_count = 0;
1267   #} else {
1268   # TODO: Check if numeric
1269   } # fi
1270
1271   my $statement =
1272     'update list set ' .
1273     "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
1274     "where userid = '$userid' and type = '$type' and sequence = $sequence";
1275
1276   $DB->do ($statement)
1277     or DBError 'UpdateList: Unable to do statement', $statement;
1278
1279   return 0;
1280 } # UpdateList
1281
1282 sub SearchEmails ($$) {
1283   my ($userid, $searchfield) = @_;
1284
1285   my @emails;
1286
1287   my $statement =
1288     "select sender, subject, timestamp from email where userid = '$userid' and (
1289      sender like '%$searchfield%' or subject like '%$searchfield%')
1290      order by timestamp desc";
1291
1292   my $sth = $DB->prepare ($statement)
1293     or DBError 'SearchEmails: Unable to prepare statement', $statement;
1294
1295   $sth->execute
1296     or DBError 'SearchEmails: Unable to execute statement', $statement;
1297
1298   while (my @row = $sth->fetchrow_array) {
1299     my $date    = pop @row;
1300     my $subject = pop @row;
1301     my $sender  = pop @row;
1302
1303     push @emails, [$sender, $subject, $date];
1304   } # while
1305
1306   $sth->finish;
1307
1308   return @emails;
1309 } # SearchEmails
1310
1311 sub SetContext ($) {
1312   my ($to_user) = @_;
1313
1314   my $old_user = $userid;
1315
1316   if (UserExists $to_user) {
1317     $userid = $to_user;
1318     GetUserOptions $userid;
1319     return GetUserInfo $userid;
1320   } else {
1321     return 0;
1322   } # if
1323 } # SetContext
1324
1325 sub Space ($) {
1326   my ($userid) = @_;
1327
1328   my $total_space        = 0;
1329   my %msg_space;
1330
1331   my $statement = "select * from email where userid = '$userid'";
1332   my $sth = $DB->prepare ($statement)
1333     or DBError 'Unable to prepare statement', $statement;
1334
1335   $sth->execute
1336     or DBError 'Unable to execute statement', $statement;
1337
1338   while (my @row = $sth->fetchrow_array) {
1339     last if !@row;
1340     my $data            = pop @row;
1341     my $timestamp       = pop @row;
1342     my $subject         = pop @row;
1343     my $sender          = pop @row;
1344     my $user            = pop @row;
1345
1346     my $msg_space =
1347       length ($userid)          +
1348       length ($sender)          +
1349       length ($subject)         +
1350       length ($timestamp)       +
1351       length ($data);
1352
1353     $total_space        += $msg_space;
1354     $msg_space{$sender} += $msg_space;
1355   } # while
1356
1357   $sth->finish;
1358
1359   return wantarray ? %msg_space : $total_space;
1360 } # Space
1361
1362 sub UpdateUser ($$$$) {
1363   my ($userid, $fullname, $email, $password) = @_;
1364
1365   if (!UserExists $userid) {
1366     return 1;
1367   } # if
1368
1369   my $statement;
1370
1371   if (!defined $password || $password eq '') {
1372     $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1373   } else {
1374     $password = Encrypt $password, $userid;
1375     $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1376   } # if
1377
1378   $DB->do ($statement)
1379     or DBError 'UpdateUser: Unable to do statement', $statement;
1380
1381   return 0;
1382 } # UpdateUser
1383
1384 sub UpdateUserOption ($$$) {
1385   my ($userid, $name, $value) = @_;
1386
1387   if (!UserExists $userid) {
1388     return 1;
1389   } # if
1390
1391   my $statement = "update useropts set value='$value' where userid='$userid' and name='$name'";
1392
1393   $DB->do ($statement)
1394     or DBError 'UpdateUserOption: Unable to do statement', $statement;
1395
1396   return 0;
1397 } # UpdateUserOptions
1398
1399 sub UserExists ($) {
1400   my ($userid) = @_;
1401
1402   return 0
1403     unless $userid;
1404
1405   my $statement = "select userid, password from user where userid = '$userid'";
1406
1407   my $sth = $DB->prepare ($statement)
1408       or DBError 'UserExists: Unable to prepare statement', $statement;
1409
1410   $sth->execute
1411     or DBError 'UserExists: Unable to execute statement', $statement;
1412
1413   my @userdata = $sth->fetchrow_array;
1414
1415   $sth->finish;
1416
1417   return 0 if scalar (@userdata) == 0;
1418
1419   my $dbpassword = pop @userdata;
1420   my $dbuserid   = pop @userdata;
1421
1422   if ($dbuserid ne $userid) {
1423     return 0;
1424   } else {
1425     return $dbpassword;
1426   } # if
1427 } # UserExists
1428
1429 sub count ($$) {
1430   my ($table, $condition) = @_;
1431
1432   my $statement;
1433
1434   if ($condition) {
1435     $statement = "select count(*) from $table where $condition";
1436   } else {
1437     $statement = "select count(*) from $table";
1438   } # if
1439
1440   my $sth = $DB->prepare ($statement)
1441     or DBError 'count: Unable to prepare statement', $statement;
1442
1443   $sth->execute
1444     or DBError 'count: Unable to execute statement', $statement;
1445
1446   # Get return value, which should be how many message there are
1447   my @row = $sth->fetchrow_array;
1448
1449   # Done with $sth
1450   $sth->finish;
1451
1452   my $count;
1453
1454   # Retrieve returned value
1455   unless ($row[0]) {
1456     $count = 0
1457   } else {
1458     $count = $row[0];
1459   } # unless
1460
1461   return $count
1462 } # count
1463
1464 sub count_distinct ($$$) {
1465   my ($table, $column, $condition) = @_;
1466
1467   my $statement;
1468
1469   if ($condition) {
1470     $statement = "select count(distinct $column) from $table where $condition";
1471   } else {
1472     $statement = "select count(distinct $column) from $table";
1473   } # if
1474
1475   my $sth = $DB->prepare ($statement)
1476     or DBError 'count: Unable to prepare statement', $statement;
1477
1478   $sth->execute
1479     or DBError 'count: Unable to execute statement', $statement;
1480
1481   # Get return value, which should be how many message there are
1482   my @row = $sth->fetchrow_array;
1483
1484   # Done with $sth
1485   $sth->finish;
1486
1487   # Retrieve returned value
1488   unless ($row[0]) {
1489     return 0;
1490   } else {
1491     return $row[0];
1492   } # unless
1493 } # count_distinct
1494
1495 sub countlog (;$$) {
1496   my ($additional_condition, $type) = @_;
1497
1498   $type ||= '';
1499
1500   my $condition;
1501
1502   $condition  = "userid=\'$userid\' ";
1503
1504   $condition .= "and $additional_condition"
1505     if $additional_condition;
1506
1507   return count_distinct ('log', 'sender', $condition);
1508 } # countlog
1509
1510 1;