X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=maps%2Flib%2FMAPS.pm;h=96276123c0a69031cf71cc8ac9477f464cd4b9e2;hb=88c9cb9f6ed80dd31981b083593b1746695083b9;hp=72594c2bbb760b0c5806e23c24bd5ed90717564e;hpb=56890e6a4f7bd3681fdc4b6db0cdce1ef0ec5e47;p=clearscm.git diff --git a/maps/lib/MAPS.pm b/maps/lib/MAPS.pm index 72594c2..9627612 100644 --- a/maps/lib/MAPS.pm +++ b/maps/lib/MAPS.pm @@ -1,5 +1,4 @@ -#!/usr/bin/perl -################################################################################# +################################################################################ # # File: $RCSfile: MAPS.pm,v $ # Revision: $Revision: 1.1 $ @@ -20,22 +19,28 @@ use warnings; use DBI; use Carp; use FindBin; -use vars qw(@ISA @EXPORT); use Exporter; use MAPSLog; -use MAPSFile; -use MAPSUtil; use MIME::Entity; +use Display; +use MyDB; +use Utils; +use DateUtils; + +use base qw(Exporter); + +our $db; + +our $VERSION = '2.0'; + # Globals my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER}; my %useropts; -my $DB; - -@ISA = qw(Exporter); +my $mailLoopMax = 5; -@EXPORT = qw( +our @EXPORT = qw( Add2Blacklist Add2Nulllist Add2Whitelist @@ -45,19 +50,23 @@ my $DB; AddUser AddUserOptions Blacklist + CheckEmail CleanEmail CleanLog CleanList - CountMsg + CountEmail + CountList + CountLog + CountLogDistinct Decrypt DeleteEmail DeleteList - DeleteLog Encrypt FindEmail FindList FindLog FindUser + FindUsers ForwardMsg GetContext GetEmail @@ -78,7 +87,6 @@ my $DB; ReadMsg ResequenceList ReturnList - ReturnListEntry ReturnMsg ReturnMessages ReturnSenders @@ -91,272 +99,354 @@ my $DB; UpdateUserOptions UserExists Whitelist - count - countlog - count_distinct ); my $mapsbase = "$FindBin::Bin/.."; -sub Add2Blacklist($$$) { - # Add2Blacklist will add an entry to the blacklist - my ($sender, $userid, $comment) = @_; +# Insternal routines +sub _cleanTables($$;$) { + my ($table, $timestamp, $dryrun) = @_; + + my $condition = "userid = '$userid' and timestamp < '$timestamp'"; + + if ($dryrun) { + return $db->count($table, $condition); + } else { + my ($count, $msg) = $db->delete($table, $condition); + + return $count; + } # if +} # _cleanTables + +sub _retention2Days($) { + my ($retention) = @_; + + # Of the retnetion periods I'm thinking of where they are and then + # something like (days|weeks|months|years) none are tricky except for months + # because months, unlike (days|weeks|years) are ill-defined. Are there 28, 29 + # 30 or 31 days in a month? Days are simple days. Weeks are simple * 7 + # days. Years are simple - just change the year (a little oddity of 365 or + # 366) days this year? To keep things simple, we will ignore the oddities of + # leap years and just use 30 for number of days in month. We really don't need + # to be that accurate here... + # + # BTW we aren't checking for odd things like 34320 weeks or 5000 years... + if ($retention =~ /(\d+)\s+(day|days)/) { + return $1; + } elsif ($retention =~ /(\d+)\s+(week|weeks)/){ + return $1 * 7; + } elsif ($retention =~ /(\d+)\s+(month|months)/) { + return $1 * 30; + } elsif ($retention =~ /(\d+)\s+(year|years)/) { + return $1 * 365; + } # if +} # _retention2Days + +sub _getnext() { + return $db->getnext; +} # _getnext +sub OpenDB($$) { + my ($username, $password) = @_; + + my $dbname = 'MAPS'; + my $dbserver = $ENV{MAPS_SERVER} || 'localhost'; + + $db = MyDB->new($username, $password, $dbname, $dbserver); + + croak "Unable to instantiate MyDB ($username\@$dbserver:$dbname)" unless $db; + + return; +} # OpenDB + +BEGIN { + my $MAPS_username = "maps"; + my $MAPS_password = "spam"; + + OpenDB($MAPS_username, $MAPS_password); +} # BEGIN + +sub Add2Blacklist(%) { + my (%params) = @_; + + # Add2Blacklist will add an entry to the blacklist # First SetContext to the userid whose black list we are adding to - SetContext($userid); + SetContext($params{userid}); # Add to black list - AddList("black", $sender, 0, $comment); + $params{sequence} = 0; + my ($err, $msg) = AddList(%params); # Log that we black listed the sender - Info("Added $sender to " . ucfirst $userid . "'s black list"); + Info("Added $params{sender} to " . ucfirst $params{userid} . "'s black list"); # Delete old emails - my $count = DeleteEmail($sender); + my $count = DeleteEmail( + userid => $params{userid}, + sender => $params{sender}, + ); # Log out many emails we managed to remove - Info("Removed $count emails from $sender"); + Info("Removed $count emails from $params{sender}"); - return; + return $count; } # Add2Blacklist -sub Add2Nulllist($$;$$) { - # Add2Nulllist will add an entry to the nulllist - my ($sender, $userid, $comment, $hit_count) = @_; +sub Add2Nulllist(%) { + my (%params) = @_; # First SetContext to the userid whose null list we are adding to - SetContext($userid); + SetContext($params{userid}); # Add to null list - AddList("null", $sender, 0, $comment, $hit_count); + $params{sequence} = 0; + my ($err, $msg) = AddList(%params); # Log that we null listed the sender - Info("Added $sender to " . ucfirst $userid . "'s null list"); + Info("Added $params{sender} to " . ucfirst $params{userid }. "'s null list"); # Delete old emails - my $count = DeleteEmail($sender); + my $count = DeleteEmail( + userid => $params{userid}, + sender => $params{sender}, + ); # Log out many emails we managed to remove - Info("Removed $count emails from $sender"); + Info("Removed $count emails from $params{sender}"); return; } # Add2Nulllist -sub Add2Whitelist($$;$) { - # Add2Whitelist will add an entry to the whitelist - my ($sender, $userid, $comment) = @_; +sub Add2Whitelist(%) { + my (%params) = @_; + # Add2Whitelist will add an entry to the whitelist # First SetContext to the userid whose white list we are adding to - SetContext($userid); + SetContext($params{userid}); # Add to white list - AddList('white', $sender, 0, $comment); + $params{sequence} = 0; + + my ($err, $msg) = AddList(%params); + + return -$err, $msg if $err; # Log that we registered a user - Logmsg("registered", $sender, "Registered new sender"); + Logmsg( + userid => $params{userid}, + type => 'registered', + sender => $params{sender}, + message => 'Registered new sender', + ); # Check to see if there are any old messages to deliver - my $handle = FindEmail($sender); + ($err, $msg) = $db->find('email', "sender = '$params{sender}'", ['userid', 'sender', 'data']); - my ($dbsender, $subject, $timestamp, $message); + return ($err, $msg) if $err; # Deliver old emails - my $messages = 0; - my $return_status = 0; + my $messages = 0; + my $status = 0; - while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail($handle)) { - last unless $userid; + while (my $rec = $db->getnext) { + last unless $rec->{userid}; - $return_status = Whitelist($sender, $message); + $status = Whitelist($rec->{sender}, $rec->{data}); - last if $return_status; + last if $status; $messages++; } # while - # Done with $handle - $handle->finish; - # Return if we has a problem delivering email - return $return_status if $return_status; + return -1, 'Problem delivering some email' if $status; - # Remove delivered messages. - DeleteEmail($sender); + # Remove delivered messages + DeleteEmail( + userid => $params{userid}, + sender => $params{sender}, + ); - return $messages; + return $messages, 'Messages delivered'; } # Add2Whitelist -sub AddEmail($$$) { - my ($sender, $subject, $data) = @_; - - # "Sanitize" some fields so that characters that are illegal to SQL are escaped - $sender = 'Unknown' if (!defined $sender || $sender eq ''); - $sender = $DB->quote($sender); - $subject = $DB->quote($subject); - $data = $DB->quote($data); +sub AddEmail(%) { + my (%rec) = @_; - my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime)); - my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)"; + CheckParms(['userid', 'sender', 'subject', 'data'], \%rec); - $DB->do ($statement) - or DBError('AddEmail: Unable to do statement', $statement); + $rec{timestamp} = UnixDatetime2SQLDatetime(scalar(localtime)); - return; + return $db->add('email', %rec); } # AddEmail -sub AddList($$$;$$$) { - my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_; +sub AddList(%) { + my (%rec) = @_; - $hit_count //= CountMsg($pattern); + CheckParms(['userid', 'type', 'sender', 'sequence'], \%rec); - my ($user, $domain) = split /\@/, $pattern; + croak "Type $rec{type} not valid. Must be one of white, black or null" + unless $rec{type} =~ /(white|black|null)/; - if (!$domain || $domain eq '') { - $domain = 'NULL'; - $pattern = $DB->quote($user); - } else { - $domain = "'$domain'"; + croak "Sender must contain \@" unless $rec{sender} =~ /\@/; - if ($user eq '') { - $pattern = 'NULL'; - } else { - $pattern = $DB->quote($user); - } # if - } # if + $rec{retention} //= ''; + $rec{retention} = lc $rec{retention}; - if (!$comment || $comment eq '') { - $comment = 'NULL'; - } else { - $comment = $DB->quote($comment); - } # if - - # Get next sequence # - if ($sequence == 0) { - $sequence = GetNextSequenceNo($userid, $listtype); - } # if + $rec{hit_count} //= $db->count( + 'email', + "userid = '$rec{userid}' and sender like '%$rec{sender}%'" + ); - $last_hit //= UnixDatetime2SQLDatetime(scalar (localtime)); + ($rec{pattern}, $rec{domain}) = split /\@/, delete $rec{sender}; - my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hit_count, \"$last_hit\")"; + $rec{sequence} = GetNextSequenceNo(%rec); - $DB->do($statement) - or DBError('AddList: Unable to do statement', $statement); + $rec{last_hit} //= UnixDatetime2SQLDatetime(scalar (localtime)); - return; + return $db->add('list', %rec); } # AddList -sub AddLog ($$$) { - my ($type, $sender, $msg) = @_; +sub AddLog(%) { + my (%params) = @_; - my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime)); - my $statement; + # Some email senders are coming in mixed case. We don't want that + $params{sender} = $params{sender} ? lc $params{sender} : ''; - # Use quote to protect ourselves - $msg = $DB->quote($msg); + $params{timestamp} = UnixDatetime2SQLDatetime(scalar(localtime)); - if ($sender eq '') { - $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)"; - } else { - $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)"; - } # if + return $db->add('log', %params); +} # AddLog - $DB->do($statement) - or DBError('AddLog: Unable to do statement', $statement); +sub AddUser(%) { + my (%rec) = @_; - return; -} # AddLog + CheckParms(['userid', 'name', 'email', 'password'], \%rec); -sub AddUser($$$$) { - my ($userid, $realname, $email, $password) = @_; + return 1 if UserExists($rec{userid}); - $password = Encrypt($password, $userid); + return $db->add('user', %rec); +} # Adduser - if (UserExists($userid)) { - return 1; - } else { - my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')"; +sub AddUserOptions(%) { + my (%rec) = @_; - $DB->do($statement) - or DBError('AddUser: Unable to do statement', $statement); - } # if + croak('Userid is required') unless $rec{userid}; + croak('No options to add') unless $rec{options}; - return 0; -} # Adduser + return (1, "User doesn't exists") unless UserExist($rec{userid}); + + my %useropts = delete $rec{userid}; + my %opts = delete $rec{options}; -sub AddUserOptions($%) { - my ($userid, %options) = @_; + my ($err, $msg); - for (keys %options) { - return 1 if !UserExists($userid); + for my $key (%opts) { + $useropts{name} = $_; + $useropts{value} = $opts{$_}; - my $statement = "insert into useropts values ('$userid', '$_', '$options{$_}')"; + ($err, $msg) = $db->add('useropts', %useropts); - $DB->do($statement) - or DBError('AddUserOption: Unable to do statement', $statement); + last if $err; } # for - return 0; + return ($err, $msg) if $err; + return; } # AddUserOptions -sub Blacklist($%) { +sub Blacklist(%) { # Blacklist will send a message back to the $sender telling them that # they've been blacklisted. Currently we save a copy of the message. # In the future we should just disregard the message. - my ($sender, $sequence, $hit_count, @msg) = @_; + my (%rec) = @_; # Check to see if this sender has already emailed us. - my $msg_count = CountMsg($sender); + my $msg_count = $db->count('email', "userid='$rec{userid}' and sender like '%$rec{sender}%'"); - if ($msg_count < 5) { + if ($msg_count < $mailLoopMax) { # Bounce email - SendMsg($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg); - Logmsg("blacklist", $sender, "Sent blacklist reply"); + my @spammsg = split "\n", $rec{data}; + + SendMsg( + userid => $rec{userid}, + sender => $rec{sender}, + subject => 'Your email has been discarded by MAPS', + msgfile => "$mapsbase/blacklist.html", + data => $rec{data}, + ); + + Logmsg( + userid => $userid, + type => 'blacklist', + sender => $rec{sender}, + message => 'Sent blacklist reply', + ); } else { - Logmsg("mailloop", $sender, "Mail loop encountered"); + Logmsg( + userid => $userid, + type => 'mailloop', + sender => $rec{sender}, + message => 'Mail loop encountered', + ); } # if - RecordHit("black", $sequence, ++$hit_count) if $sequence; + $rec{hit_count}++ if $rec{sequence}; + + RecordHit( + userid => $userid, + type => 'black', + sequence => $rec{sequence}, + hit_count => $rec{hit_count}, + ); return; } # Blacklist -sub CheckOnList ($$;$) { - # CheckOnList will check to see if the $sender is on the $listfile. - # Return 1 if found 0 if not. - my ($listtype, $sender, $update) = @_; +sub CheckEmail(;$$) { + my ($username, $domain) = @_; - $update //= 1; + return lc "$username\@$domain" if $username and $domain; - my $status = 0; - my ($rule, $sequence, $hit_count); + # Check to see if a full email address in either $username or $domain + if ($username) { + if ($username =~ /(.*)\@(.*)/) { + return lc "$1\@$2"; + } else { + return lc "$username\@"; + } # if + } elsif ($domain) { + if ($domain =~ /(.*)\@(.*)/) { + return lc "$1\@$2"; + } else { + return "\@$domain"; + } # if + } # if +} # CheckEmail + +sub CheckOnList2 ($$;$) { + # CheckOnList will check to see if the $sender is on the list. Return 1 if + # found 0 if not. + my ($listtype, $sender, $update) = @_; - my $statement = 'select pattern, domain, comment, sequence, hit_count ' - . "from list where userid = '$userid' and type = '$listtype' " - . 'order by sequence'; + $update //= 1; - my $sth = $DB->prepare($statement) - or DBError('CheckOnList: Unable to prepare statement', $statement); + my ($status, $rule, $sequence); - $sth->execute - or DBError('CheckOnList: Unable to execute statement', $statement); + my $table = 'list'; + my $condition = "userid='$userid' and type='$listtype'"; - while (my @row = $sth->fetchrow_array) { - last if !@row; + my ($err, $errmsg) = $db->find($table, $condition, '*', 'order by sequence'); - $hit_count = pop (@row); - $sequence = pop (@row); - my $comment = pop (@row); - my $domain = pop (@row); - my $pattern = pop (@row); - my $email_on_file; + my ($email_on_file, $rec); - unless ($domain) { - $email_on_file = $pattern; + while ($rec = $db->getnext) { + unless ($rec->{domain}) { + $email_on_file = $rec->{pattern}; } else { - unless ($pattern) { - $email_on_file = '@' . $domain; + unless ($rec->{pattern}) { + $email_on_file = '@' . $rec->{domain}; } else { - $email_on_file = $pattern . '@' . $domain; + $email_on_file = $rec->{pattern} . '@' . $rec->{domain}; } # if } # unless @@ -373,580 +463,428 @@ sub CheckOnList ($$;$) { # "@ti.com" would also match "@tixcom.com"! my $search_for = $email_on_file =~ /\@/ ? "$email_on_file\$" - : !defined $domain + : !defined $rec->{domain} ? "$email_on_file\@" : $email_on_file; if ($sender and $sender =~ /$search_for/i) { - $rule = "Matching rule: ($listtype:$sequence) \"$email_on_file\""; - $rule .= " - $comment" if $comment and $comment ne ''; $status = 1; - RecordHit($listtype, $sequence, ++$hit_count) if $update; + $rec->{hit_count} //= 0; + + RecordHit( + userid => $userid, + type => $listtype, + sequence => $rec->{sequence}, + hit_count => $rec->{hit_count} + 1, + ) if $update; last; } # if } # while - $sth->finish; - - return ($status, $rule, $sequence, $hit_count); -} # CheckOnList - -sub CleanEmail($) { - my ($timestamp) = @_; - - # First see if anything needs to be deleted - my $count = 0; - - my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'"; - - # Prepare statement - my $sth = $DB->prepare($statement) - or DBError('CleanEmail: Unable to prepare statement', $statement); - - # Execute statement - $sth->execute - or DBError('CleanEmail: Unable to execute statement', $statement); + return ($status, $rec); +} # CheckOnList2 - # Get return value, which should be how many entries were deleted - my @row = $sth->fetchrow_array; - - # Done with $sth - $sth->finish; - - # Retrieve returned value - unless ($row[0]) { - $count = 0 - } else { - $count = $row[0]; - } # unless - - # Just return if there's nothing to delete - return $count if ($count == 0); +sub CheckOnList ($$;$) { + # CheckOnList will check to see if the $sender is on the list. Return 1 if + # found 0 if not. + my ($listtype, $sender, $update) = @_; - # Delete emails for userid whose older than $timestamp - $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'"; + $update //= 1; - # Prepare statement - $sth = $DB->prepare($statement) - or DBError('CleanEmail: Unable to prepare statement', $statement); + my $status = 0; + my ($rule, $sequence); - # Execute statement - $sth->execute - or DBError('CleanEmail: Unable to execute statement', $statement); + my $table = 'list'; + my $condition = "userid='$userid' and type='$listtype'"; - return $count; -} # ClearEmail + my ($err, $errmsg) = $db->find($table, $condition, '*', 'order by sequence'); -sub CleanLog($) { - my ($timestamp) = @_; + my ($email_on_file, $rec); - # First see if anything needs to be deleted - my $count = 0; + while ($rec = $db->getnext) { + unless ($rec->{domain}) { + $email_on_file = $rec->{pattern}; + } else { + unless ($rec->{pattern}) { + $email_on_file = '@' . $rec->{domain}; + } else { + $email_on_file = $rec->{pattern} . '@' . $rec->{domain}; + } # if + } # unless - my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'"; + # Escape some special characters + $email_on_file =~ s/\@/\\@/; + $email_on_file =~ s/^\*/.\*/; - # Prepare statement - my $sth = $DB->prepare($statement) - or DBError($DB, 'CleanLog: Unable to prepare statement', $statement); + # We want to terminate the search string with a "$" iff there's an + # "@" in there. This is because some "email_on_file" may have no + # domain (e.g. "mailer-daemon" with no domain). In that case we + # don't want to terminate the search string with a "$" rather we + # wish to terminate it with an "@". But in the case of say + # "@ti.com" if we don't terminate the search string with "$" then + # "@ti.com" would also match "@tixcom.com"! + my $search_for = $email_on_file =~ /\@/ + ? "$email_on_file\$" + : !defined $rec->{domain} + ? "$email_on_file\@" + : $email_on_file; + if ($sender and $sender =~ /$search_for/i) { + my $comment = $rec->{comment} ? " - $rec->{comment}" : ''; - # Execute statement - $sth->execute - or DBError('CleanLog: Unable to execute statement', $statement); + $rule = "Matching rule: ($listtype:$rec->{sequence}) \"$email_on_file$comment\""; + $rule .= " - $rec->{comment}" if $rec->{comment}; + $status = 1; - # Get return value, which should be how many entries were deleted - my @row = $sth->fetchrow_array; + $rec->{hit_count} //= 0; - # Done with $sth - $sth->finish; + RecordHit( + userid => $userid, + type => $listtype, + sequence => $rec->{sequence}, + hit_count => $rec->{hit_count} + 1, + ) if $update; - # Retrieve returned value - unless ($row[0]) { - $count = 0 - } else { - $count = $row[0]; - } # unless + last; + } # if + } # while - # Just return if there's nothing to delete - return $count if ($count == 0); + return ($status, $rule, $rec->{sequence}, $rec->{hit_count}); +} # CheckOnList - # Delete log entries for userid whose older than $timestamp - $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'"; +sub CleanEmail($;$) { + my ($timestamp, $dryrun) = @_; - # Prepare statement - $sth = $DB->prepare($statement) - or DBError('CleanLog: Unable to prepare statement', $statement); + return _cleanTables 'email', $timestamp, $dryrun; +} # ClearEmail - # Execute statement - $sth->execute - or DBError('CleanLog: Unable to execute statement', $statement); +sub CleanLog($;$) { + my ($timestamp, $dryrun) = @_; - return $count; + return _cleanTables('log', $timestamp, $dryrun); } # CleanLog -sub CleanList($;$) { - my ($timestamp, $listtype) = @_; +sub CleanList(%) { + my (%params) = @_; + + CheckParms(['userid', 'type'], \%params); + + my $dryrunstr = $params{dryrun} ? '(dryrun)' : ''; + + my $table = 'list'; + my $condition = "userid='$params{userid}' and type='$params{type}'"; + my $count = 0; + my $msg; + + # First let's go through the list to see if we have an domain level entry + # (e.g. @spammer.com) and also individual entries (baddude@spammer.com) then + # we don't really need any of the individual entries since the domain block + # covers them. + $db->find($table, $condition, ['domain'], ' and pattern is null'); + + while (my $domains = $db->getnext) { + for my $recs ($db->get($table, $condition, ['sequence', 'pattern', 'domain'], + " and domain='$domains->{domain}' and pattern is not null")) { + if (@$recs and not $params{dryrun}) { + for my $rec (@$recs) { + DeleteList( + userid => $params{userid}, + type => $params{type}, + sequence => $rec->{sequence}, + ); + + $params{log}->msg("Deleted $params{userid}:$params{type}:$rec->{sequence} " + . "$rec->{pattern}\@$rec->{domain} $dryrunstr") + if $params{log}; + + $count++; + } # for + } elsif (@$recs) { + if ($params{log}) { + $params{log}->msg("The domain $domains->{domain} has the following subrecords"); + + for my $rec (@$recs) { + $params{log}->msg("$rec->{pattern}\@$rec->{domain}"); + } # for + } # if + } # if + } # for + } # while - $listtype //= 'null'; + $condition = "userid='$params{userid}' and type='$params{type}' and retention is not null"; # First see if anything needs to be deleted - my $count = 0; - - my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'"; + ($count, $msg) = $db->count($table, $condition); - # Prepare statement - my $sth = $DB->prepare($statement) - or DBError($DB, 'CleanList: Unable to prepare statement', $statement); + return 0 unless $count; - # Execute statement - $sth->execute - or DBError('CleanList: Unable to execute statement', $statement); - - # Get return value, which should be how many entries were deleted - my @row = $sth->fetchrow_array; - - # Done with $sth - $sth->finish; + $count = 0; - # Retrieve returned value - $count = $row[0] ? $row[0] : 0; + my ($err, $errmsg) = $db->find($table, $condition); - # Just return if there's nothing to delete - return $count if ($count == 0); + croak "Unable to find $params{type} entries for $condition - $errmsg" if $err; - # Get data for these entries - $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'"; + my $todaysDate = Today2SQLDatetime; - # Prepare statement - $sth = $DB->prepare($statement) - or DBError('CleanList: Unable to prepare statement', $statement); + while (my $rec = $db->getnext) { + my $days = _retention2Days($rec->{retention}); - # Execute statement - $sth->execute - or DBError('CleanList: Unable to execute statement', $statement); + my $agedDate = SubtractDays($todaysDate, $days); - $count = 0; + # If last_hit < retentiondays then delete + if (Compare($rec->{last_hit}, $agedDate) == -1) { + unless ($params{dryrun}) { + DeleteList( + userid => $params{userid}, + type => $params{type}, + sequence => $rec->{sequence}, + ); - while (my @row = $sth->fetchrow_array) { - last if !@row; + if ($params{log}) { + $rec->{pattern} //= ''; + $rec->{domain} //= ''; - my $hit_count = pop(@row); - my $sequence = pop(@row); - my $listtype = pop(@row); + $params{log}->msg("Deleted $rec->{userid}:$params{type}:$rec->{sequence} " + . "$rec->{pattern}\@$rec->{domain} $dryrunstr"); + $params{log}->dbug("last hit = $rec->{last_hit} < agedDate = $agedDate"); + } # if + } # unless - if ($hit_count == 0) { $count++; - - $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence"; - $DB->do($statement) - or DBError('CleanList: Unable to execute statement', $statement); } else { - # Age entry: Sometimes entries are initially very popular and - # the $hit_count gets very high quickly. Then the domain is - # abandoned and no activity happens. One case recently observed - # was for phentermine.com. The $hit_count initially soared to - # 1920 within a few weeks. Then it all stopped as of - # 07/13/2007. Obvisously this domain was shutdown. With the - # previous aging algorithm of simply subtracting 1 this - # phentermine.com entry would hang around for over 5 years! - # - # So the tack here is to age the entry by 10% until the $hit_count - # is less than 30 then we revert to the old method of subtracting 1. - if ($hit_count < 30) { - $hit_count--; - } else { - $hit_count = int($hit_count / 1.1); - } # if - - $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;"; - $DB->do($statement) - or DBError('CleanList: Unable to execute statement', $statement); + $params{log}->dbug("$rec->{userid}:$params{type}:$rec->{sequence}: nodelete $dryrunstr " + . "last hit = $rec->{last_hit} >= agedDate = $agedDate") + if $params{log}; } # if } # while - ResequenceList($userid, $listtype); + ResequenceList( + userid => $params{userid}, + type => $params{type}, + ) if $count && !$params{dryrun}; return $count; } # CleanList -sub CloseDB() { - $DB->disconnect; +sub CountEmail(%) { + my (%params) = @_; - return; -} # CloseDB + CheckParms(['userid'], \%params); -sub CountMsg($) { - my ($sender) = @_; + my $table = 'email'; + my $condition = "userid='$params{userid}'"; + $condition .= " and $params{additional}" if $params{additional}; - return count('email', "userid = '$userid' and sender like '%$sender%'"); -} # CountMsg + return $db->count($table, $condition); +} # CountEmail -sub DBError($$) { - my ($msg, $statement) = @_; +sub CountList(%) { + my (%params) = @_; - print 'MAPS::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n"; + CheckParms(['userid', 'type'], \%params); - if ($statement) { - print "SQL Statement: $statement\n"; - } # if + my $table = 'list'; + my $condition = "userid='$params{userid}' and type='$params{type}'"; - exit $DB->err; -} # DBError + return $db->count($table, $condition); +} # CountList -sub Decrypt ($$) { - my ($password, $userid) = @_; +sub CountLog(%) { + my (%params) = @_; - my $statement = "select decode('$password','$userid')"; + CheckParms(['userid'], \%params); - my $sth = $DB->prepare($statement) - or DBError('Decrypt: Unable to prepare statement', $statement); + my ($additional_condition) = delete $params{additional} || ''; - $sth->execute - or DBError('Decrypt: Unable to execute statement', $statement); + my $condition = "userid='$userid'"; + $condition .= " and $additional_condition" if $additional_condition; - # Get return value, which should be the encoded password - my @row = $sth->fetchrow_array; + return $db->count('log', $condition); +} # CountLog - # Done with $sth - $sth->finish; +sub CountLogDistinct(%) { + my (%params) = @_; - return $row[0] -} # Decrypt + CheckParms(['userid', 'column'], \%params); -sub DeleteEmail($) { - my $sender = shift; + my ($additional_condition) = delete $params{additional} || ''; - my ($username, $domain) = split /@/, $sender; - my $condition; + my $condition = "userid='$userid'"; + $condition .= " and $additional_condition" if $additional_condition; - if ($username eq '') { - $condition = "userid = '$userid' and sender like '%\@$domain'"; - } else { - $condition = "userid = '$userid' and sender = '$sender'"; - } # if - - # First see if anything needs to be deleted - my $count = count('email', $condition); - - # Just return if there's nothing to delete - return $count if ($count == 0); + return $db->count_distinct('log', $params{column}, $condition); +} # CountLog - my $statement = 'delete from email where ' . $condition; - - $DB->do($statement) - or DBError('DeleteEmail: Unable to execute statement', $statement); - - return $count; -} # DeleteEmail - -sub DeleteList($$) { - my ($type, $sequence) = @_; - - # First see if anything needs to be deleted - my $count = count('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'"); - - # Just return if there's nothing to delete - return $count if ($count == 0); +sub Decrypt ($$) { + my ($password, $userid) = @_; - my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'"; + return $db->decode($password, $userid); +} # Decrypt - $DB->do($statement) - or DBError('DeleteList: Unable to execute statement', $statement); +sub DeleteEmail(%) { + my (%rec) = @_; - return $count; -} # DeleteList + my $table = 'email'; -sub DeleteLog($) { - my ($sender) = @_; + CheckParms(['userid', 'sender'], \%rec); - my ($username, $domain) = split /@/, $sender; + my ($username, $domain) = split /@/, $rec{sender}; my $condition; - if ($username eq '') { - $condition = "userid = '$userid' and sender like '%\@$domain'"; + if ($username) { + $condition = "userid = '$rec{userid}' and sender = '$rec{sender}'"; } else { - $condition = "userid = '$userid' and sender = '$sender'"; + $condition = "userid = '$rec{userid}' and sender like '%\@$domain'"; } # if - # First see if anything needs to be deleted - my $count = count('log', $condition); + return $db->delete($table, $condition); +} # DeleteEmail - # Just return if there's nothing to delete - return $count if ($count == 0); +sub DeleteList(%) { + my (%rec) = @_; - my $statement = 'delete from log where ' . $condition; + CheckParms(['userid', 'type', 'sequence'], \%rec); - $DB->do($statement) - or DBError('DeleteLog: Unable to execute statement', $statement); + my $condition = "userid = '$rec{userid}' and " + . "type = '$rec{type}' and " + . "sequence = $rec{sequence}"; - return $count; -} # DeleteLog + return $db->delete('list', $condition); +} # DeleteList sub Encrypt($$) { my ($password, $userid) = @_; - my $statement = "select encode('$password','$userid')"; - - my $sth = $DB->prepare($statement) - or DBError('Encrypt: Unable to prepare statement', $statement); - - $sth->execute - or DBError('Encrypt: Unable to execute statement', $statement); - - # Get return value, which should be the encoded password - my @row = $sth->fetchrow_array; - - # Done with $sth - $sth->finish; - - return $row[0]; + return $db->encode($password, $userid); } # Encrypt -sub FindEmail(;$$) { - my ($sender, $date) = @_; +sub FindEmail(%) { + my (%params) = @_; - my $statement; + CheckParms(['userid'], \%params); - $sender //= ''; - $date //= ''; + my $table = 'email'; + my $condition = "userid='$params{userid}'"; + $condition .= " and sender='$params{sender}'" if $params{sender}; + $condition .= " and timestamp='$params{timestamp}'" if $params{timestamp}; - $statement = "select * from email where userid = '$userid'"; - - # Add conditions if present - $statement .= " and sender = '$sender'" if $sender; - $statement .= " and timestamp = '$date'" if $date; - - my $sth = $DB->prepare($statement) - or DBError('FindEmail: Unable to prepare statement', $statement); - - $sth->execute - or DBError('FindEmail: Unable to execute statement', $statement); - - return $sth; + return $db->find($table, $condition); } # FindEmail -sub FindList($;$) { +sub FindList(%) { + my (%params) = @_; + my ($type, $sender) = @_; - my $statement; + CheckParms(['userid', 'type'], \%params); - unless ($sender) { - $statement = "select * from list where userid = '$userid' and type = '$type'"; - } else { - my ($pattern, $domain) = split /\@/, $sender; - $statement = "select * from list where userid = '$userid' and type = '$type' " . - "and pattern = '$pattern' and domain = '$domain'"; - } # unless + my $table = 'list'; + my $condition = "userid='$params{userid}' and type='$params{type}'"; - # Prepare statement - my $sth = $DB->prepare($statement) - or DBError('FindList: Unable to prepare statement', $statement); + if ($params{sender}) { + my ($username, $domain) = split /\@/, $params{sender}; - # Execute statement - $sth->execute - or DBError('FindList: Unable to execute statement', $statement); + # Split will return '' if either username or domain is missing. This messes + # up SQL's find as '' ~= NULL. Therefore we only specify username or domain + # if it is present. + $condition .= " and pattern='$username'" if $username; + $condition .= " and domain='$domain'" if $domain; + } # if - # Get return value, which should be how many entries were deleted - return $sth; + return $db->find($table, $condition); } # FindList sub FindLog($) { my ($how_many) = @_; my $start_at = 0; - my $end_at = countlog(); + my $end_at = CountLog( + userid => $userid, + ); if ($how_many < 0) { $start_at = $end_at - abs ($how_many); $start_at = 0 if ($start_at < 0); } # if - my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at"; - - # Prepare statement - my $sth = $DB->prepare($statement) - or DBError('FindLog: Unable to prepare statement', $statement); - - # Execute statement - $sth->execute - or DBError('FindLog: Unable to execute statement', $statement); + my $table = 'log'; + my $condition = "userid='$userid'"; + my $additional = "order by timestamp limit $start_at, $end_at"; - # Get return value, which should be how many entries were deleted - return $sth; + return $db->find($table, $condition, '*', $additional); } # FindLog -sub FindUser(;$) { - my ($userid) = @_; +sub FindUser(%) { + my (%params) = @_; - my $statement; + my $table = 'user'; + my $condition = ''; - if (!defined $userid || $userid eq '') { - $statement = 'select * from user'; - } else { - $statement = "select * from user where userid = '$userid'"; - } # if + $condition = "userid='$userid'" if $params{userid}; - my $sth = $DB->prepare($statement) - or DBError('FindUser: Unable to prepare statement', $statement); + return $db->find($table, $condition, $params{fields}); +} # FindUser - $sth->execute - or DBError('FindUser: Unable to execute statement', $statement); +sub FindUsers() { + return $db->find('user', '', ['userid']); +} # FindUsers - return $sth; -} # FindUser +sub GetEmail() { + goto &_getnext; +} # GetEmail sub GetContext() { return $userid; } # GetContext -sub GetEmail($) { - my ($sth) = @_; - - my @email; - - if (@email = $sth->fetchrow_array) { - my $message = pop @email; - my $timestamp = pop @email; - my $subject = pop @email; - my $sender = pop @email; - my $userid = pop @email; - return $userid, $sender, $subject, $timestamp, $message; - } else { - return; - } # if -} # GetEmail - -sub GetList($) { - my ($sth) = @_; - - my @list; - - if (@list = $sth->fetchrow_array) { - my $last_hit = pop @list; - my $hit_count = pop @list; - my $sequence = pop @list; - my $comment = pop @list; - my $domain = pop @list; - my $pattern = pop @list; - my $type = pop @list; - my $userid = pop @list; - return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit; - } else { - return; - } # if +sub GetList() { + goto &_getnext; } # GetList -sub GetLog($) { - my ($sth) = @_; +sub GetLog() { + goto &_getnext; +} # GetLog - my @log; +sub GetNextSequenceNo(%) { + my (%rec) = @_; - if (@log = $sth->fetchrow_array) { - my $message = pop @log; - my $type = pop @log; - my $sender = pop @log; - my $timestamp = pop @log; - my $userid = pop @log; - return $userid, $timestamp, $sender, $type, $message; - } else { - return; - } # if -} # GetLog + CheckParms(['userid', 'type'], \%rec); -sub GetNextSequenceNo($$) { - my ($userid, $listtype) = @_; + my $table = 'list'; + my $condition = "userid='$rec{userid}' and type='$rec{type}'"; - my $count = count ('list', "userid = '$userid' and type = '$listtype'"); + my $count = $db->count('list', $condition); return $count + 1; } # GetNextSequenceNo -sub GetUser($) { - my ($sth) = @_; - - my @user; - - if (@user = $sth->fetchrow_array) { - my $password = pop @user; - my $email = pop @user; - my $name = pop @user; - my $userid = pop @user; - return ($userid, $name, $email, $password); - } else { - return; - } # if +sub GetUser() { + goto &_getnext; } # GetUser sub GetUserInfo($) { my ($userid) = @_; - my $statement = "select name, email from user where userid='$userid'"; - - my $sth = $DB->prepare($statement) - or DBError('GetUserInfo: Unable to prepare statement', $statement); - - $sth->execute - or DBError('GetUserInfo: Unable to execute statement', $statement); - - my @userinfo = $sth->fetchrow_array; - my $user_email = lc (pop @userinfo); - my $username = lc (pop @userinfo); - - $sth->finish; - - return ($username, $user_email); + return %{$db->getone('user', "userid='$userid'", ['name', 'email'])}; } # GetUserInfo sub GetUserOptions($) { my ($userid) = @_; - my $statement = "select * from useropts where userid = '$userid'"; - - my $sth = $DB->prepare($statement) - or DBError('GetUserOptions: Unable to prepare statement', $statement); - - $sth->execute - or DBError('GetUserOptions: Unable to execute statement', $statement); - - my @useropts; + my $table = 'useropts'; + my $condition = "userid='$userid'"; - # Empty hash - %useropts = (); + $db->find($table, $condition); - while (@useropts = $sth->fetchrow_array) { - my $value = pop @useropts; - my $name = pop @useropts; + my %useropts; - pop @useropts; - - $useropts{$name} = $value; + while (my $rec = $db->getnext) { + $useropts{$rec->{name}} = $rec->{value}; } # while - $sth->finish; - return %useropts; } # GetUserOptions -sub GetRows ($) { - my ($statement) = @_; - - my $sth = $DB->prepare($statement) - or DBError('Unable to prepare statement' , $statement); - - $sth->execute - or DBError('Unable to execute statement' , $statement); - - my @array; - - while (my @row = $sth->fetchrow_array) { - for (@row) { - push @array, $_; - } # for - } # while - - return @array; -} # GetRows - sub Login($$) { my ($userid, $password) = @_; @@ -956,7 +894,7 @@ sub Login($$) { my $dbpassword = UserExists($userid); # Return -1 if user doesn't exist - return -1 if !$dbpassword; + return -1 unless $dbpassword; # Return -2 if password does not match if ($password eq $dbpassword) { @@ -971,10 +909,20 @@ sub Nulllist($;$$) { # Nulllist will simply discard the message. my ($sender, $sequence, $hit_count) = @_; - RecordHit("null", $sequence, ++$hit_count) if $sequence; + RecordHit( + userid => $userid, + type => 'null', + sequence => $sequence, + hit_count => ++$hit_count, + ) if $sequence; # Discard Message - Logmsg("nulllist", $sender, "Discarded message"); + Logmsg( + userid => $userid, + type => 'nulllist', + sender => $sender, + message => 'Discarded message' + ); return; } # Nulllist @@ -982,13 +930,13 @@ sub Nulllist($;$$) { sub OnBlacklist($;$) { my ($sender, $update) = @_; - return CheckOnList('black', $sender, $update); + return CheckOnList2('black', $sender, $update); } # OnBlacklist sub OnNulllist($;$) { my ($sender, $update) = @_; - return CheckOnList("null", $sender, $update); + return CheckOnList2('null', $sender, $update); } # CheckOnNulllist sub OnWhitelist($;$$) { @@ -996,131 +944,89 @@ sub OnWhitelist($;$$) { SetContext($userid) if $userid; - return CheckOnList("white", $sender, $update); + return CheckOnList2('white', $sender, $update); } # OnWhitelist -sub OpenDB($$) { - my ($username, $password) = @_; - - my $dbname = 'MAPS'; - my $dbdriver = 'mysql'; - my $dbserver = $ENV{MAPS_SERVER} || 'localhost'; - - if (!$DB || $DB eq '') { - #$dbserver='localhost'; - $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0}) - or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr; - } # if - - return $DB; -} # OpenDB - -BEGIN { - my $MAPS_username = "maps"; - my $MAPS_password = "spam"; - - OpenDB($MAPS_username, $MAPS_password); -} # BEGIN - -END { - CloseDB; -} # END - - sub OptimizeDB() { - my $statement = 'lock tables email read, list read, log read, user read, useropts read'; - my $sth = $DB->prepare($statement) - or DBError('OptimizeDB: Unable to prepare statement', $statement); + my @tables = qw(email list log user useropts); - $sth->execute - or DBError('OptimizeDB: Unable to execute statement', $statement); + my ($err, $msg) = $db->lock('read', \@tables); - $statement = 'check table email, list, log, user, useropts'; - $sth = $DB->prepare($statement) - or DBError('OptimizeDB: Unable to prepare statement', $statement); + croak "Unable to lock table - $msg" if $err; - $sth->execute - or DBError('OptimizeDB: Unable to execute statement', $statement); + ($err, $msg) = $db->check(\@tables); - $statement = 'unlock tables'; - $sth = $DB->prepare($statement) - or DBError('OptimizeDB: Unable to prepare statement', $statement); + croak 'Unable to check tables ' . $msg if $err; - $sth->execute - or DBError('OptimizeDB: Unable to execute statement', $statement); + ($err, $msg) = $db->optimize(\@tables); - $statement = 'optimize table email, list, log, user, useropts'; - $sth = $DB->prepare($statement) - or DBError('OptimizeDB: Unable to prepare statement', $statement); + croak 'Unable to optimize tables ' . $msg if $err; - $sth->execute - or DBError('OptimizeDB: Unable to execute statement', $statement); - - return; + return $db->unlock(); } # OptimizeDB sub ReadMsg($) { - # Reads an email message file from $input. Returns sender, subject, - # date and data, which is a copy of the entire message. my ($input) = @_; - my $sender = ''; - my $sender_long = ''; - my $envelope_sender = ''; - my $reply_to = ''; - my $subject = ''; - my $data = ''; - my @data; + my (%msgInfo, @data, $envelope_sender); - # Find first message's "From " line indicating start of message + # Reads an email message file from $input. Returns sender, subject, date and + # data, which is a copy of the entire message. Find first message's "From " + # line indicating start of message. while (<$input>) { chomp; last if /^From /; } # while # If we hit eof here then the message was garbled. Return indication of this - if (eof($input)) { - $data = "Garbled message - unable to find From line"; - return $sender, $sender_long, $reply_to, $subject, $data; - } # if + return if eof($input); if (/From (\S*)/) { - $envelope_sender = $1; - $sender_long = $envelope_sender; + $msgInfo{sender_long} = $envelope_sender = $1; } # if push @data, $_ if /^From /; while (<$input>) { - chomp; + chomp; chop if /\r$/; + push @data, $_; # Blank line indicates start of message body - last if ($_ eq "" || $_ eq "\r"); + last if ($_ eq '' || $_ eq "\r"); # Extract sender's address - if (/^from: .*/i) { - $_ = substr ($_, 6); - - $sender_long = $_; - - if (/<(\S*)@(\S*)>/) { - $sender = lc ("$1\@$2"); - } elsif (/(\S*)@(\S*)\ /) { - $sender = lc ("$1\@$2"); - } elsif (/(\S*)@(\S*)/) { - $sender = lc ("$1\@$2"); + if (/^from: (.*)/i) { + $msgInfo{sender_long} = $msgInfo{sender} = $1; + + if ($msgInfo{sender} =~ /<(\S*)@(\S*)>/) { + $msgInfo{sender} = lc ("$1\@$2"); + } elsif ($msgInfo{sender} =~ /(\S*)@(\S*)\ /) { + $msgInfo{sender} = lc ("$1\@$2"); + } elsif ($msgInfo{sender} =~ /(\S*)@(\S*)/) { + $msgInfo{sender} = lc ("$1\@$2"); + } # if + } elsif (/^subject: (.*)/i) { + $msgInfo{subject} = $1; + } elsif (/^reply-to: (.*)/i) { + $msgInfo{reply_to} = $1; + + if ($msgInfo{reply_to} =~ /<(\S*)@(\S*)>/) { + $msgInfo{reply_to} = lc ("$1\@$2"); + } elsif ($msgInfo{reply_to} =~ /(\S*)@(\S*)\ /) { + $msgInfo{reply_to} = lc ("$1\@$2"); + } elsif ($msgInfo{reply_to} =~ /(\S*)@(\S*)/) { + $msgInfo{reply_to} = lc ("$1\@$2"); } # if - } elsif (/^subject: .*/i) { - $subject = substr ($_, 9); - } elsif (/^reply-to: .*/i) { - $_ = substr ($_, 10); - if (/<(\S*)@(\S*)>/) { - $reply_to = lc ("$1\@$2"); - } elsif (/(\S*)@(\S*)\ /) { - $reply_to = lc ("$1\@$2"); - } elsif (/(\S*)@(\S*)/) { - $reply_to = lc ("$1\@$2"); + } elsif (/^to: (.*)/i) { + $msgInfo{to} = $1; + + if ($msgInfo{to} =~ /<(\S*)@(\S*)>/) { + $msgInfo{to} = lc ("$1\@$2"); + } elsif ($msgInfo{to} =~ /(\S*)@(\S*)\ /) { + $msgInfo{to} = lc ("$1\@$2"); + } elsif ($msgInfo{to} =~ /(\S*)@(\S*)/) { + $msgInfo{to} = lc ("$1\@$2"); } # if } # if } # while @@ -1130,514 +1036,206 @@ sub ReadMsg($) { chomp; last if (/^From /); + push @data, $_; } # while # Set file pointer back by length of the line just read - seek ($input, -length () - 1, 1) if !eof $input; + seek ($input, -length() - 1, 1) if !eof $input; # Sanitize email addresses - $envelope_sender =~ s/\//g; - $envelope_sender =~ s/\"//g; - $envelope_sender =~ s/\'//g; - $sender =~ s/\//g; - $sender =~ s/\"//g; - $sender =~ s/\'//g; - $reply_to =~ s/\//g; - $reply_to =~ s/\"//g; - $reply_to =~ s/\'//g; + $envelope_sender =~ s/\//g; + $envelope_sender =~ s/\"//g; + $envelope_sender =~ s/\'//g; + + $msgInfo{sender} =~ s/\//g; + $msgInfo{sender} =~ s/\"//g; + $msgInfo{sender} =~ s/\'//g; + + if ($msgInfo{reply_to}) { + $msgInfo{reply_to} =~ s/\//g; + $msgInfo{reply_to} =~ s/\"//g; + $msgInfo{reply_to} =~ s/\'//g; + } # if # Determine best addresses - $sender = $envelope_sender if $sender eq ""; - $reply_to = $sender if $reply_to eq ""; - - return $sender, $sender_long, $reply_to, $subject, join "\n", @data; -} # ReadMsg - -sub RecordHit($$$) { - my ($listtype, $sequence, $hit_count) = @_; + $msgInfo{sender} = $envelope_sender unless $msgInfo{sender}; + $msgInfo{reply_to} = $msgInfo{sender} unless $msgInfo{reply_to}; - my $current_date = UnixDatetime2SQLDatetime(scalar(localtime)); + $msgInfo{data} = join "\n", @data; - my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence"; + return %msgInfo; +} # ReadMsg - $DB->do($statement) - or DBError('RecordHit: Unable to do statement', $statement); +sub RecordHit(%) { + my (%rec) = @_; - return; -} # RecordHit + CheckParms(['userid', 'type', 'sequence'], \%rec); -sub ResequenceList($$) { - my ($userid, $type) = @_; + my $table = 'list'; + my $condition = "userid='$rec{userid}' and type='$rec{type}' and sequence='$rec{sequence}'"; - return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null'; + # We don't need these fields in %rec as we are not updating them + delete $rec{sequence}; + delete $rec{type}; + delete $rec{userid}; - return 2 unless UserExists($userid); + # We are, however, updating last_hit + $rec{last_hit} = UnixDatetime2SQLDatetime(scalar(localtime)); - my $statement = 'lock tables list write'; - my $sth = $DB->prepare($statement) - or DBError('ResquenceList: Unable to prepare statement', $statement); + return $db->modify($table, $condition, %rec); +} # RecordHit - $sth->execute - or DBError('ResequenceList: Unable to execute statement', $statement); +sub ResequenceList(%) { + my (%params) = @_; - # Now get all of the list entries renumbering as we go - $statement = <<"END"; -select - pattern, - domain, - comment, - sequence, - hit_count, - last_hit -from - list -where - userid = '$userid' and - type = '$type' -order by - hit_count desc -END + CheckParms(['userid', 'type'], \%params); - $sth = $DB->prepare($statement) - or DBError('ResequenceList: Unable to prepare statement', $statement); + # Data checks + return 1 unless $params{type} =~ /(white|black|null)/; + return 2 unless UserExists($params{userid}); - $sth->execute - or DBError('ResequenceList: Unable to execute statement', $statement); + my $table = 'list'; + my $condition = "userid='$params{userid}' and type ='$params{type}'"; - my $sequence = 1; - my @new_rows; - - while (my @row = $sth->fetchrow_array) { - last if !@row; - - my %record = ( - last_hit => pop @row, - hit_count => pop @row, - new_sequence => $sequence++, - old_sequence => pop @row, - comment => $DB->quote(pop @row) || '', - domain => $DB->quote(pop @row) || '', - pattern => $DB->quote(pop @row) || '', - ); + # Lock the table + $db->lock('write', $table); - push @new_rows, \%record; - } # while + # Get all records for $userid and $type + my $listrecs = $db->get($table, $condition,'*', 'order by hit_count desc'); # Delete all of the list entries for this $userid and $type - $statement = "delete from list where userid='$userid' and type='$type'"; - - $DB->do($statement) - or DBError('ResequenceList: Unable to do statement', $statement); - - # Re-add list with new sequence numbers - for (@new_rows) { - my %record = %$_; - my $statement = <<"END"; -insert into - list -values ( - '$userid', - '$type', - $record{pattern}, - $record{domain}, - $record{comment}, - '$record{new_sequence}', - '$record{hit_count}', - '$record{last_hit}' -) -END - - $DB->do($statement) - or DBError('ResequenceList: Unable to do statement', $statement); - } # for - - $statement = 'unlock tables'; - $sth = $DB->prepare($statement) - or DBError('OptimizeDB: Unable to prepare statement', $statement); - - $sth->execute - or DBError('OptimizeDB: Unable to execute statement', $statement); - - return 0; -} # ResequenceList - -sub ResequenceListold($$) { - my ($userid, $type) = @_; - - return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null'; - - return 2 unless UserExists($userid); - - my $statement = "select sequence from list where userid = '$userid' " - . " and type = '$type' order by sequence"; - - my $sth = $DB->prepare($statement) - or DBError('ResequenceList: Unable to prepare statement', $statement); - - $sth->execute - or DBError('ResequenceList: Unable to execute statement', $statement); + my ($count, $msg) = $db->delete($table, $condition); + # Now re-add list entries renumbering them my $sequence = 1; - while (my @row = $sth->fetchrow_array) { - last if !@row; + for (@$listrecs) { + $_->{sequence} = $sequence++; - my $old_sequence = pop @row; + my ($err, $msg) = $db->add($table, %$_); - if ($old_sequence != $sequence) { - my $update_statement = "update list set sequence = $sequence " . - "where userid = '$userid' and " . - "type = '$type' and sequence = $old_sequence"; - - $DB->do($update_statement) - or DBError('ResequenceList: Unable to do statement', $statement); - } # if + croak $msg if $err; + } # for - $sequence++; - } # while + $db->unlock; return 0; } # ResequenceList -sub ReturnEmails($$$;$$) { - my ($userid, $type, $start_at, $nbr_emails, $date) = @_; - - $start_at ||= 0; - - my $statement; - - if ($date) { - my $sod = $date . ' 00:00:00'; - my $eod = $date . ' 23:59:59'; - - if ($type eq 'returned') { - $statement = <<"END"; -select - log.sender -from - log, - email -where - log.sender = email.sender and - log.userid = '$userid' and - log.timestamp > '$sod' and - log.timestamp < '$eod' and - log.type = '$type' -group by - log.sender -limit - $start_at, $nbr_emails -END - } else { - $statement = <<"END"; -select - sender -from - log -where - userid = '$userid' and - timestamp > '$sod' and - timestamp < '$eod' and - type = '$type' -group by - sender -limit - $start_at, $nbr_emails -END - } # if - } else { - if ($type eq 'returned') { - $statement = <<"END"; -select - log.sender -from - log, - email -where - log.sender = email.sender and - log.userid = '$userid' and - log.type = '$type' -group by - log.sender -order by - log.timestamp desc -limit - $start_at, $nbr_emails -END - } else { - $statement = <<"END"; -select - sender -from - log -where - userid = '$userid' and - type = '$type' -group by - sender -order by - timestamp desc -limit - $start_at, $nbr_emails -END - } # if - } # if - - my $sth = $DB->prepare($statement) - or DBError('ReturnEmails: Unable to prepare statement', $statement); - - $sth->execute - or DBError('ReturnEmails: Unable to execute statement', $statement); - - my @emails; - - while (my $sender = $sth->fetchrow_array) { - my $earliestDate; - - # Get emails for this sender. Format an array of subjects and timestamps. - my @messages; - - $statement = "select timestamp, subject from email where userid = '$userid' " . - "and sender = '$sender'"; - - my $sth2 = $DB->prepare($statement) - or DBError('ReturnEmails: Unable to prepare statement', $statement); - - $sth2->execute - or DBError('ReturnEmails: Unable to execute statement', $statement); - - while (my @row = $sth2->fetchrow_array) { - my $subject = pop @row; - my $date = pop @row; - - if ($earliestDate) { - my $earliestDateShort = substr $earliestDate, 0, 10; - my $dateShort = substr $date, 0, 10; - - if ($earliestDateShort eq $dateShort and - $earliestDate > $date) { - $earliestDate = $date if $earliestDateShort eq $dateShort; - } # if - } else { - $earliestDate = $date; - } # if - - push @messages, [$subject, $date]; - } # while - - # Done with sth2 - $sth2->finish; - - $earliestDate ||= ''; - - unless ($type eq 'returned') { - push @emails, [$earliestDate, [$sender, @messages]]; - } else { - push @emails, [$earliestDate, [$sender, @messages]] - if @messages > 0; - } # unless - } # while - - # Done with $sth - $sth->finish; - - return @emails; -} # ReturnEmails - -sub ReturnList($$$) { - my ($type, $start_at, $lines) = @_; - - $lines ||= 10; - - my $statement; - - if ($start_at) { - $statement = "select * from list where userid = '$userid' " . - "and type = '$type' order by sequence " . - "limit $start_at, $lines"; - } else { - $statement = "select * from list where userid = '$userid' " . - "and type = '$type' order by sequence"; - } # if - - my $sth = $DB->prepare($statement) - or DBError('ReturnList: Unable to prepare statement', $statement); - - $sth->execute - or DBError('ReturnList: Unable to execute statement', $statement); +sub ReturnList(%) { + my (%params) = @_; - my @list; - my $i = 0; + CheckParms(['userid', 'type'], \%params); - while (my @row = $sth->fetchrow_array) { - last if $i++ > $lines; + my $start_at = delete $params{start_at} || 0; + my $lines = delete $params{lines} || 10; - my %list; + my $table = 'list'; + my $condition = "userid='$params{userid}' and type='$params{type}'"; + my $additional = "order by sequence limit $start_at, $lines"; - $list{last_hit} = pop @row; - $list{hit_count} = pop @row; - $list{sequence} = pop @row; - $list{comment} = pop @row; - $list{domain} = pop @row; - $list{pattern} = pop @row; - $list{type} = pop @row; - $list{userid} = pop @row; - push @list, \%list; - } # for - - return @list; + return $db->get($table, $condition, '*', $additional); } # ReturnList -sub ReturnListEntry($$) { - my ($type, $sequence) = @_; - - my $statement = "select * from list where userid = '$userid' " . - "and type = '$type' and sequence = '$sequence'"; - - my $sth = $DB->prepare($statement) - or DBError('ReturnListEntry: Unable to prepare statement', $statement); - - $sth->execute - or DBError('ReturnListEntry: Unable to execute statement', $statement); - - my %list; - my @row = $sth->fetchrow_array; - - $list{sequence} = pop @row; - $list{comment} = pop @row; - $list{domain} = pop @row; - $list{pattern} = pop @row; - $list{type} = pop @row; - $list{userid} = pop @row; +sub ReturnMsg(%) { + my (%params) = @_; - return %list; -} # ReturnListEntry - -# Added reply_to. Previously we passed reply_to into here as sender. This -# caused a problem in that we were filtering as per sender but logging it -# as reply_to. We only need reply_to for SendMsg so as to honor reply_to -# so we now pass in both sender and reply_to -sub ReturnMsg($$$$) { # ReturnMsg will send back to the $sender the register message. # Messages are saved to be delivered when the $sender registers. - my ($sender, $reply_to, $subject, $data) = @_; + # + # Added reply_to. Previously we passed reply_to into here as sender. This + # caused a problem in that we were filtering as per sender but logging it + # as reply_to. We only need reply_to for SendMsg so as to honor reply_to + # so we now pass in both sender and reply_to + + CheckParms(['userid', 'sender', 'reply_to', 'subject', 'data'], \%params); + + #my ($sender, $reply_to, $subject, $data) = @_; # Check to see if this sender has already emailed us. - my $msg_count = CountMsg($sender); + my $msg_count = $db->count('email', "userid='$userid' and sender like '%$params{sender}%'"); - if ($msg_count < 5) { + if ($msg_count < $mailLoopMax) { # Return register message - my @msg; - - for (split /\n/,$data) { - push @msg, "$_\n"; - } # for + SendMsg( + userid => $params{userid}, + sender => $params{reply_to}, + subject => 'Your email has been returned by MAPS', + msgfile => "$mapsbase/register.html", + data => $params{data}, + ) if $msg_count == 0; + + Logmsg( + userid => $params{userid}, + type => 'returned', + sender => $params{sender}, + message => 'Sent register reply', + ); - SendMsg($reply_to, - "Your email has been returned by MAPS", - "$mapsbase/register.html", - GetContext, - @msg) - if $msg_count == 0; - Logmsg("returned", $sender, "Sent register reply"); # Save message - SaveMsg($sender, $subject, $data); + SaveMsg($params{sender}, $params{subject}, $params{data}); } else { - Add2Nulllist($sender, GetContext, "Auto Null List - Mail loop"); - Logmsg("mailloop", $sender, "Mail loop encountered"); + Add2Nulllist($params{sender}, GetContext, "Auto Null List - Mail loop"); + + Logmsg( + userid => $params{userid}, + type => 'mailloop', + sender => $params{sender}, + message => 'Mail loop encountered', + ); } # if return; } # ReturnMsg -sub ReturnMessages($$) { - my ($userid, $sender) = @_; - - my $statement = <<"END"; -select - subject, - timestamp -from - email -where - userid = '$userid' and - sender = '$sender' -group by - timestamp desc -END - - my $sth = $DB->prepare($statement) - or DBError('ReturnMessages: Unable to prepare statement', $statement); +sub ReturnMessages(%) { + my (%params) = @_; - $sth->execute - or DBError('ReturnMessages: Unable to execute statement', $statement); + CheckParms(['userid', 'sender'], \%params); - my @messages; - - while (my @row = $sth->fetchrow_array) { - my $date = pop @row; - my $subject = pop @row; - - push @messages, [$subject, $date]; - } # while + my $table = 'email'; + my $condition = "userid='$params{userid}' and sender='$params{sender}'"; + my $fields = ['subject', 'timestamp']; + my $additional = 'group by timestamp desc'; - $sth->finish; - - return @messages; + return $db->get($table, $condition, $fields, $additional); } # ReturnMessages -# This subroutine returns an array of senders in reverse chronological -# order based on time timestamp from the log table of when we returned -# their message. The complication here is that a single sender may -# send multiple times in a single day. So if spammer@foo.com sends -# spam @ 1 second after midnight and then again at 2 Pm there will be -# at least two records in the log table saying that we returned his -# email. Getting records sorted by timestamp desc will have -# spammer@foo.com listed twice. But we want him listed only once, as -# the first entry in the returned array. Plus we may be called -# repeatedly with different $start_at's. Therefore we need to process -# the whole list of returns for today, eliminate duplicate entries for -# a single sender then slice the resulting array. -sub ReturnSenders($$$;$$) { - my ($userid, $type, $start_at, $nbr_emails, $date) = @_; - - $start_at ||= 0; - - my $dateCond = ''; - - if ($date) { - my $sod = $date . ' 00:00:00'; - my $eod = $date . ' 23:59:59'; - - $dateCond = "and timestamp > '$sod' and timestamp < '$eod'"; +sub ReturnSenders(%) { + my (%params) = @_; + # This subroutine returns an array of senders in reverse chronological + # order based on time timestamp from the log table of when we returned + # their message. The complication here is that a single sender may + # send multiple times in a single day. So if spammer@foo.com sends + # spam @ 1 second after midnight and then again at 2 Pm there will be + # at least two records in the log table saying that we returned his + # email. Getting records sorted by timestamp desc will have + # spammer@foo.com listed twice. But we want him listed only once, as + # the first entry in the returned array. Plus we may be called + # repeatedly with different $start_at's. Therefore we need to process + # the whole list of returns for today, eliminate duplicate entries for + # a single sender then slice the resulting array. + CheckParms(['userid', 'type', 'lines'], \%params); + + my $table = 'log'; + my $condition = "userid='$params{userid}' and type='$params{type}'"; + my $additional = 'order by timestamp desc'; + + $params{start_at} ||= 0; + + if ($params{date}) { + $condition .= "and timestamp > '$params{date} 00:00:00' and " + . "timestamp < '$params{date} 23:59:59'"; } # if - my $statement = <<"END"; -select - sender, - timestamp -from - log -where - userid = '$userid' and - type = '$type' - $dateCond -order by - timestamp desc -END - - my $sth = $DB->prepare($statement) - or DBError('ReturnSenders: Unable to prepare statement', $statement); - - $sth->execute - or DBError('ReturnSenders: Unable to execute statement', $statement); + $db->find($table, $condition, '*', $additional); # Watch the distinction between senders (plural) and sender (singular) - my (%senders, %sendersByTimestamp); + my %senders; # Run through the results and add to %senders by sender key. This # results in a hash that has the sender in it and the first @@ -1645,82 +1243,82 @@ END # above select statement, and we've narrowed it down to only log # message that occurred for the given $date, we will have a hash # containing 1 sender and the latest timestamp for the day. - while (my $senderRef = $sth->fetchrow_hashref) { - my %sender = %{$senderRef}; - - $senders{$sender{sender}} = $sender{timestamp} - unless $senders{$sender{sender}}; + while (my $rec = $db->getnext) { + $senders{$rec->{sender}} = $rec->{timestamp} + unless $senders{$rec->{sender}}; } # while - $sth->finish; + my (@unsorted, @senders); - # Make a hash whose keys are the timestamp (so we can later sort on - # them). + # Here we have a hash in %senders that has email address and timestamp. In the + # past we would merely create a reverse hash by timestamp and sort that. The + # The problem is that it is possible for two emails to come in with the same + # timestamp. By reversing the hash we clobber any row that has a dumplicte + # timestamp. But we want to sort on timestamp. So first we convers this hash + # to an array of hashes and then we can sort by timestamp later. while (my ($key, $value) = each %senders) { - $sendersByTimestamp{$value} = $key; + push @unsorted, { + sender => $key, + timestamp => $value, + }; } # while - my @senders; - - # Sort by timestamp desc and push on to the @senders array - push @senders, $sendersByTimestamp{$_} - for (sort { $b cmp $a } keys %sendersByTimestamp); + push @senders, $_->{sender} for sort { $b->{timestamp} cmp $a->{timestamp}} @unsorted; # Finally slice for the given range - my $end_at = $start_at + $nbr_emails - 1; + my $end_at = $params{start_at} + ($params{lines} - 1); - $end_at = (@senders - 1) - if $end_at > @senders; + $end_at = (@senders) - 1 if $end_at >= @senders; - return (@senders) [$start_at .. $end_at]; + return (@senders) [$params{start_at} .. $end_at]; } # ReturnSenders sub SaveMsg($$$) { my ($sender, $subject, $data) = @_; - AddEmail($sender, $subject, $data); + AddEmail( + userid => $userid, + sender => $sender, + subject => $subject, + data => $data, + ); return; } # SaveMsg -sub SearchEmails($$) { - my ($userid, $searchfield) = @_; - - my @emails; +sub SearchEmails(%) { + my (%params) = @_; - my $statement = - "select sender, subject, timestamp from email where userid = '$userid' and ( - sender like '%$searchfield%' or subject like '%$searchfield%') - order by timestamp desc"; + CheckParms(['userid', 'search'], \%params); - my $sth = $DB->prepare($statement) - or DBError('SearchEmails: Unable to prepare statement', $statement); + my $table = 'email'; + my $fields = ['sender', 'subject', 'timestamp']; + my $condition = "userid='$params{userid}' and (sender like '\%$params{search}\%' " + . "or subject like '\%$params{search}\%')"; + my $additional = 'order by timestamp desc'; - $sth->execute - or DBError('SearchEmails: Unable to execute statement', $statement); + my ($err, $msg) = $db->find($table, $condition, $fields, $additional); - while (my @row = $sth->fetchrow_array) { - my $date = pop @row; - my $subject = pop @row; - my $sender = pop @row; + my @emails; - push @emails, [$sender, $subject, $date]; + while (my $rec = $db->getnext) { + push @emails, $rec; } # while - $sth->finish; - return @emails; } # SearchEmails -sub SendMsg($$$$@) { +sub SendMsg(%) { # SendMsg will send the message contained in $msgfile. - my ($sender, $subject, $msgfile, $userid, @spammsg) = @_; + my (%params) = @_; + + #my ($sender, $subject, $msgfile, $userid, @spammsg) = @_; my @lines; # Open return message template file - open my $return_msg_file, '<', $msgfile - or die "Unable to open return msg file ($msgfile): $!\n"; + open my $return_msg_file, '<', $params{msgfile} + or die "Unable to open return msg file ($params{msgfile}): $!\n"; # Read return message template file and print it to $msg_body while (<$return_msg_file>) { @@ -1730,7 +1328,7 @@ sub SendMsg($$$$@) { } # if if (/\$sender/) { # Replace sender - s/\$sender/$sender/; + s/\$sender/$params{sender}/; } #if push @lines, $_; @@ -1741,13 +1339,15 @@ sub SendMsg($$$$@) { # Create the message, and set up the mail headers: my $msg = MIME::Entity->build( From => "MAPS\@DeFaria.com", - To => $sender, - Subject => $subject, + To => $params{sender}, + Subject => $params{subject}, Type => "text/html", Data => \@lines ); # Need to obtain the spam message here... + my @spammsg = split "\n", $params{data}; + $msg->attach( Type => "message", Disposition => "attachment", @@ -1768,13 +1368,10 @@ sub SendMsg($$$$@) { sub SetContext($) { my ($to_user) = @_; - my $old_user = $userid; - if (UserExists($to_user)) { $userid = $to_user; - GetUserOptions($userid); - return GetUserInfo $userid; + return GetUserOptions $userid; } else { return 0; } # if @@ -1784,96 +1381,61 @@ sub Space($) { my ($userid) = @_; my $total_space = 0; - my %msg_space; - - my $statement = "select * from email where userid = '$userid'"; - my $sth = $DB->prepare($statement) - or DBError('Unable to prepare statement', $statement); - - $sth->execute - or DBError('Unable to execute statement', $statement); - - while (my @row = $sth->fetchrow_array) { - last if !@row; - - my $data = pop @row; - my $timestamp = pop @row; - my $subject = pop @row; - my $sender = pop @row; - my $user = pop @row; - - my $msg_space = - length ($userid) + - length ($sender) + - length ($subject) + - length ($timestamp) + - length ($data); - - $total_space += $msg_space; - $msg_space{$sender} += $msg_space; + my $table = 'email'; + my $condition = "userid='$userid'"; + + $db->find($table, $condition); + + while (my $rec = $db->getnext) { + $total_space += + length($rec->{userid}) + + length($rec->{sender}) + + length($rec->{subject}) + + length($rec->{timestamp}) + + length($rec->{data}); } # while - $sth->finish; - - return wantarray ? %msg_space : $total_space; + return $total_space; } # Space -sub UpdateList($$$$$$$) { - my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_; +sub UpdateList(%) { + my (%rec) = @_; - if (!$pattern || $pattern eq '') { - $pattern = 'NULL'; - } else { - $pattern = "'" . quotemeta ($pattern) . "'"; - } # if + CheckParms(['userid', 'type', 'sequence'], \%rec); - if (!$domain || $domain eq '') { - $domain = 'NULL'; - } else { - $domain = "'" . quotemeta ($domain) . "'"; - } # if + my $table = 'list'; + my $condition = "userid = '$rec{userid}' and type = '$rec{type}' and sequence = $rec{sequence}"; - if (!$comment || $comment eq '') { - $comment = 'NULL'; - } else { - $comment = "'" . quotemeta ($comment) . "'"; + if ($rec{pattern} =~ /\@/ && !$rec{domain}) { + ($rec{pattern}, $rec{domain}) = split /\@/, $rec{pattern}; + } elsif (!$rec{pattern} && $rec{domain} =~ /\@/) { + ($rec{pattern}, $rec{domain}) = split /\@/, $rec{domain}; + } elsif (!$rec{pattern} && !$rec{domain}) { + return "Must specify either Username or Domain"; } # if - if (!$hit_count || $hit_count eq '') { - $hit_count = 0; - #} else { - # TODO: Check if numeric - } # fi + $rec{pattern} //= 'null'; + $rec{domain} //= 'null'; + $rec{comment} //= 'null'; - my $statement = - 'update list set ' . - "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " . - "where userid = '$userid' and type = '$type' and sequence = $sequence"; - - $DB->do($statement) - or DBError('UpdateList: Unable to do statement', $statement); + if ($rec{retention}) { + $rec{retention} = lc $rec{retention}; + } # if - return 0; + return $db->update($table, $condition, %rec); } # UpdateList -sub UpdateUser($$$$) { - my ($userid, $fullname, $email, $password) = @_; +sub UpdateUser(%) { + my (%rec) = @_; - return 1 if !UserExists($userid); + CheckParms(['userid', 'name', 'email'], \%rec); - my $statement; + return 1 unless UserExists($rec{userid}); - if (!defined $password || $password eq '') { - $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'"; - } else { - $password = Encrypt $password, $userid; - $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'"; - } # if - - $DB->do($statement) - or DBError('UpdateUser: Unable to do statement', $statement); + my $table = 'user'; + my $condition = "userid='$rec{userid}'"; - return 0; + return $db->update($table, $condition, %rec); } # UpdateUser sub UpdateUserOptions ($@) { @@ -1881,12 +1443,10 @@ sub UpdateUserOptions ($@) { return unless UserExists($userid); - for (keys(%options)) { - my $statement = "update useropts set value='$options{$_}' where userid='$userid' and name='$_'"; + my $table = 'useropts'; + my $condition = "userid='$userid' and name="; - $DB->do($statement) - or DBError('UpdateUserOption: Unable to do statement', $statement); - } # for + $db->update($table, "$condition'$_'", (name=>$_, value=>$options{$_})) for (keys %options); return; } # UpdateUserOptions @@ -1896,28 +1456,14 @@ sub UserExists($) { return 0 unless $userid; - my $statement = "select userid, password from user where userid = '$userid'"; - - my $sth = $DB->prepare($statement) - or DBError('UserExists: Unable to prepare statement', $statement); + my $table = 'user'; + my $condition = "userid='$userid'"; - $sth->execute - or DBError('UserExists: Unable to execute statement', $statement); + my $rec = $db->get($table, $condition); - my @userdata = $sth->fetchrow_array; + return 0 if scalar(@$rec) == 0; - $sth->finish; - - return 0 if scalar(@userdata) == 0; - - my $dbpassword = pop @userdata; - my $dbuserid = pop @userdata; - - if ($dbuserid ne $userid) { - return 0; - } else { - return $dbpassword; - } # if + return $rec->[0]{password}; } # UserExists sub Whitelist ($$;$$) { @@ -1928,102 +1474,53 @@ sub Whitelist ($$;$$) { # Dump message into a file open my $message, '>', "/tmp/MAPSMessage.$$" - or Error("Unable to open message file (/tmp/MAPSMessage.$$): $!\n"), return -1; + or error("Unable to open message file (/tmp/MAPSMessage.$$): $!\n"), return -1; print $message $data; close $message; # Now call MAPSDeliver - my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$"; - - if ($status == 0) { - Logmsg("whitelist", $sender, "Delivered message"); - - unlink "/tmp/MAPSMessage.$$"; - } else { - Error("Unable to deliver message - is MAPSDeliver setgid? - $!"); - } # if - - RecordHit("white", $sequence, ++$hit_count) if $sequence; - - return $status; -} # Whitelist - -sub count($$) { - my ($table, $condition) = @_; - - my $statement; + my ($status, @output) = Execute "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$"; + #my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$"; + + if ($status != 0) { + my $msg = "Unable to deliver message (message left at /tmp/MAPSMessage.%%\n\n"; + $msg .= join "\n", @output; + + Logmsg( + userid => $userid, + type => 'whitelist', + sender => $sender, + message => $msg, + ); - if ($condition) { - $statement = "select count(*) from $table where $condition"; - } else { - $statement = "select count(*) from $table"; + Error ($msg, 1); } # if - my $sth = $DB->prepare($statement) - or DBError('count: Unable to prepare statement', $statement); - - $sth->execute - or DBError('count: Unable to execute statement', $statement); - - # Get return value, which should be how many message there are - my @row = $sth->fetchrow_array; - - # Done with $sth - $sth->finish; - - my $count; - - # Retrieve returned value - unless ($row[0]) { - $count = 0 - } else { - $count = $row[0]; - } # unless - - return $count -} # count - -sub count_distinct($$$) { - my ($table, $column, $condition) = @_; - - my $statement; + unlink "/tmp/MAPSMessage.$$"; - if ($condition) { - $statement = "select count(distinct $column) from $table where $condition"; + if ($status == 0) { + Logmsg( + userid => $userid, + type => 'whitelist', + sender => $sender, + message => 'Delivered message', + ); } else { - $statement = "select count(distinct $column) from $table"; + error("Unable to deliver message - is MAPSDeliver setgid? - $!", $status); } # if - my $sth = $DB->prepare($statement) - or DBError('count: Unable to prepare statement', $statement); - - $sth->execute - or DBError('count: Unable to execute statement', $statement); - - # Get return value, which should be how many message there are - my @row = $sth->fetchrow_array; + $hit_count++ if $sequence; - # Done with $sth - $sth->finish; - - # Retrieve returned value - unless ($row[0]) { - return 0; - } else { - return $row[0]; - } # unless -} # count_distinct - -sub countlog(;$) { - my ($additional_condition) = @_; - - my $condition = "userid=\'$userid\' "; - - $condition .= "and $additional_condition" if $additional_condition; + RecordHit( + userid => $userid, + type => 'white', + sequence => $sequence, + hit_count => $hit_count, + ); - return count_distinct('log', 'sender', $condition); -} # countlog + return $status; +} # Whitelist 1;