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