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