From 16babf81ce331af378de565ba73e927ff5491f65 Mon Sep 17 00:00:00 2001 From: Andrew DeFaria Date: Thu, 22 Feb 2018 12:21:24 -0800 Subject: [PATCH] Large MAPS update Removed need for MAPSDB. It wasn't the best way to do stuff and just made everything a bit more complicated. Moved libraries under lib. Also fixed a few bugs and eliminated some scripts we had re-written in PHP or otherwise didn't use. Changed algorithms a little bit like ResequenceList now orders the resequencing by hit_count so that useful patterns are used before less useful patterns. Also changed the aging of hit_count a bit. --- maps/bin/MAPS.pm | 789 --------------- maps/bin/MAPSDeliver | 21 +- maps/bin/add2blacklist.cgi | 52 +- maps/bin/add2nulllist.cgi | 46 +- maps/bin/add2nulllist.pl | 41 +- maps/bin/add2whitelist.cgi | 28 +- maps/bin/checkaddress | 14 +- maps/bin/checkaddress.cgi | 32 +- maps/bin/detail.cgi | 70 +- maps/bin/display.cgi | 36 +- maps/bin/{domains => domains.pl} | 34 +- maps/bin/editprofile.cgi | 235 ++--- maps/bin/exportlist.cgi | 24 +- maps/bin/importlist.cgi | 27 +- maps/bin/list.cgi | 191 ---- maps/bin/main.cgi | 109 --- maps/bin/maps | 2 +- maps/bin/mapsscrub | 74 +- maps/bin/{mapsutil => mapsutil.pl} | 299 +++--- maps/bin/modifyentries.cgi | 27 +- maps/bin/processaction.cgi | 113 +-- maps/bin/register.cgi | 55 +- maps/bin/registerform.cgi | 110 +-- maps/bin/search.cgi | 92 +- maps/bin/signup.cgi | 70 +- maps/bin/stats.cgi | 118 +-- maps/bin/updateprofile.cgi | 69 +- maps/{bin/MAPSDB.pm => lib/MAPS.pm} | 1395 ++++++++++++++++++--------- maps/{bin => lib}/MAPSFile.pm | 16 +- maps/{bin => lib}/MAPSLog.pm | 62 +- maps/{bin => lib}/MAPSUtil.pm | 12 +- maps/{bin => lib}/MAPSWeb.pm | 33 +- maps/php/list.php | 2 +- 33 files changed, 1874 insertions(+), 2424 deletions(-) delete mode 100644 maps/bin/MAPS.pm rename maps/bin/{domains => domains.pl} (67%) delete mode 100755 maps/bin/list.cgi delete mode 100755 maps/bin/main.cgi rename maps/bin/{mapsutil => mapsutil.pl} (65%) rename maps/{bin/MAPSDB.pm => lib/MAPS.pm} (50%) rename maps/{bin => lib}/MAPSFile.pm (83%) rename maps/{bin => lib}/MAPSLog.pm (64%) rename maps/{bin => lib}/MAPSUtil.pm (96%) rename maps/{bin => lib}/MAPSWeb.pm (96%) diff --git a/maps/bin/MAPS.pm b/maps/bin/MAPS.pm deleted file mode 100644 index babf46b..0000000 --- a/maps/bin/MAPS.pm +++ /dev/null @@ -1,789 +0,0 @@ -#!/usr/bin/perl -################################################################################# -# -# File: $RCSfile: MAPS.pm,v $ -# Revision: $Revision: 1.1 $ -# Description: Main module for Mail Authentication and Permission System (MAPS) -# Author: Andrew@DeFaria.com -# Created: Fri Nov 29 14:17:21 2002 -# Modified: $Date: 2013/06/12 14:05:47 $ -# Language: perl -# -# (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved. -# -################################################################################ -package MAPS; - -use strict; - -use FindBin; - -use MAPSDB; -use MAPSLog; -use MAPSFile; -use MAPSUtil; -use MIME::Entity; - -use vars qw (@ISA @EXPORT); -use Exporter; - -@ISA = qw (Exporter); - -@EXPORT = qw ( - Add2Blacklist - Add2Nulllist - Add2Whitelist - AddEmail - AddList - AddUser - AddUserOptions - Blacklist - CleanEmail - CleanLog - CleanList - CountMsg - Decrypt - DeleteEmail - DeleteList - DeleteLog - Encrypt - FindEmail - FindList - FindLog - FindUser - ForwardMsg - GetContext - GetEmail - GetList - GetLog - GetUser - GetUserOptions - ListLog - ListUsers - Login - Nulllist - OnBlacklist - OnNulllist - OnWhitelist - OptimizeDB - ReadMsg - ResequenceList - ReturnList - ReturnListEntry - ReturnMsg - ReturnMessages - ReturnSenders - SaveMsg - SearchEmails - SetContext - Space - UpdateList - UpdateUser - UpdateUserOptions - UserExists - Whitelist -); - -my $mapsbase = "$FindBin::Bin/.."; - -# Forwards -sub Add2Blacklist; -sub Add2Nulllist; -sub Add2Whitelist; -sub AddEmail; -sub AddList; -sub AddUser; -sub AddUserOptions; -sub Blacklist; -sub CleanEmail; -sub CleanLog; -sub CountMsg; -sub Decrypt; -sub DeleteEmail; -sub DeleteList; -sub DeleteLog; -sub Encrypt; -sub FindEmail; -sub FindList; -sub FindLog; -sub FindUser; -sub ForwardMsg; -sub GetContext; -sub GetEmail; -sub GetList; -sub GetLog; -sub GetUser; -sub GetUserOptions; -sub Login; -sub Nulllist; -sub OnBlacklist; -sub OnNulllist; -sub OnWhitelist; -sub OptimizeDB; -sub ReadMsg; -sub ResequenceList; -sub ReturnList; -sub ReturnListEntry; -sub ReturnMsg; -sub ReturnMessages; -sub ReturnSenders; -sub SaveMsg; -sub SearchEmails; -sub SendMsg; -sub SetContext; -sub Space; -sub UpdateList; -sub UpdateUser; -sub UpdateUserOptions; -sub UserExists; -sub Whitelist; - -BEGIN { - my $MAPS_username = "maps"; - my $MAPS_password = "spam"; - - OpenDB $MAPS_username, $MAPS_password; -} # BEGIN - -END { - CloseDB; -} # END - -sub Add2Blacklist { - # Add2Blacklist will add an entry to the blacklist - my ($sender, $userid, $comment) = @_; - - # First SetContext to the userid whose black list we are adding to - MAPSDB::SetContext $userid; - - # Add to black list - AddList "black", $sender, 0, $comment; - - # Log that we black listed the sender - Info "Added $sender to " . ucfirst $userid . "'s black list"; - - # Delete old emails - my $count = DeleteEmail $sender; - - # Log out many emails we managed to remove - Info "Removed $count emails from $sender" -} # Add2Blacklist - -sub Add2Nulllist ($$;$$) { - # Add2Nulllist will add an entry to the nulllist - my ($sender, $userid, $comment, $hit_count) = @_; - - # First SetContext to the userid whose null list we are adding to - MAPSDB::SetContext $userid; - - # Add to null list - AddList "null", $sender, 0, $comment, $hit_count; - - # Log that we null listed the sender - Info "Added $sender to " . ucfirst $userid . "'s null list"; - - # Delete old emails - my $count = DeleteEmail $sender; - - # Log out many emails we managed to remove - Info "Removed $count emails from $sender" -} # Add2Nulllist - -sub Add2Whitelist ($$;$) { - # Add2Whitelist will add an entry to the whitelist - my ($sender, $userid, $comment) = @_; - - # First SetContext to the userid whose white list we are adding to - MAPSDB::SetContext $userid; - - # Add to white list - AddList 'white', $sender, 0, $comment; - - # Log that we registered a user - Logmsg "registered", $sender, "Registered new sender"; - - # Check to see if there are any old messages to deliver - my $handle = FindEmail $sender; - - my ($dbsender, $subject, $timestamp, $message); - - # Deliver old emails - my $messages = 0; - my $return_status = 0; - - while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail $handle) { - last - unless $userid; - - $return_status = Whitelist $sender, $message; - - last - if $return_status; - - $messages++; - } # while - - # Done with $handle - $handle->finish; - - # Return if we has a problem delivering email - return $return_status - if $return_status; - - # Remove delivered messages. - DeleteEmail $sender; - - return $messages; -} # Add2Whitelist - -sub AddEmail ($$$) { - my ($sender, $subject, $data) = @_; - - MAPSDB::AddEmail $sender, $subject, $data; -} # AddEmail - -sub AddList ($$$;$$$) { - my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_; - - $hit_count //= CountMsg $pattern; - - MAPSDB::AddList $listtype, $pattern, $sequence, $comment, $hit_count, $last_hit; -} # AddList - -sub AddUser ($$$$) { - my ($userid, $realname, $email, $password) = @_; - - return MAPSDB::AddUser $userid, $realname, $email, $password; -} # AddUser - -sub AddUserOptions ($%) { - my ($userid, %options) = @_; - - my $status; - - foreach (keys (%options)) { - $status = MAPSDB::AddUserOption $userid, $_, $options{$_}; - last if $status ne 0; - } # foreach - - return $status; -} # AddUserOptions - -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) = @_; - - # Check to see if this sender has already emailed us. - my $msg_count = CountMsg $sender; - - if ($msg_count lt 5) { - # Bounce email - SendMsg ($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg); - Logmsg "blacklist", $sender, "Sent blacklist reply"; - } else { - Logmsg "mailloop", $sender, "Mail loop encountered"; - } # if - - RecordHit "black", $sequence, ++$hit_count if $sequence; -} # Blacklist - -sub CleanEmail ($) { - my ($timestamp) = @_; - - MAPSDB::CleanEmail $timestamp; -} # CleanEmail - -sub CleanLog ($) { - my ($timestamp) = @_; - - MAPSDB::CleanLog $timestamp; -} # CleanLog - -sub CleanList ($;$) { - my ($timestamp, $listtype) = @_; - - MAPSDB::CleanList $timestamp, $listtype; -} # CleanList - -sub CountMsg ($) { - my ($sender) = @_; - - return MAPSDB::CountMsg $sender; -} # CountMsg - -sub Decrypt ($$) { - my ($password, $userid) = @_; - - return MAPSDB::Decrypt $password, shift; -} # Decrypt - -sub DeleteEmail ($) { - my ($sender) = @_; - - return MAPSDB::DeleteEmail $sender; -} # DeleteEmail - -sub DeleteList ($$) { - my ($type, $sequence) = @_; - - return MAPSDB::DeleteList $type, $sequence; -} # DeleteList - -sub DeleteLog ($) { - my ($sender) = @_; - - return MAPSDB::DeleteLog $sender; -} # DeleteLog - -sub Encrypt ($$) { - my ($password, $userid) = @_; - - return MAPSDB::Encrypt $password, $userid; -} # Encrypt - -sub FindEmail (;$) { - my ($sender) = @_; - - return MAPSDB::FindEmail $sender; -} # FindEmail - -sub FindList ($;$) { - my ($type, $sender) = @_; - - return MAPSDB::FindList $type, $sender; -} # FindList - -sub FindLog ($) { - my ($how_many) = @_; - - my $start_at = 0; - my $end_at = MAPSDB::countlog (); - - if ($how_many < 0) { - $start_at = $end_at - abs ($how_many); - $start_at = 0 if ($start_at < 0); - } # if - - return MAPSDB::FindLog $start_at, $end_at; -} # FindLog - -sub FindUser (;$) { - my ($userid) = @_; - - return MAPSDB::FindUser $userid -} # FindUser - -sub GetContext () { - return MAPSDB::GetContext (); -} # GetContext - -sub GetEmail ($) { - my ($handle) = @_; - - return MAPSDB::GetEmail $handle; -} # GetEmail - -sub GetList ($) { - my ($handle) = @_; - - return MAPSDB::GetList $handle; -} # GetList - -sub GetLog ($) { - my ($handle) = @_; - - return MAPSDB::GetLog $handle; -} # GetLog - -sub GetUser ($) { - my ($handle) = @_; - - return MAPSDB::GetUser $handle; -} # GetUser - -sub GetUserOptions ($) { - my ($userid) = @_; - - return MAPSDB::GetUserOptions $userid; -} # GetUserOptions - -sub Login ($$) { - my ($userid, $password) = @_; - - $password = Encrypt $password, $userid; - - # Check if user exists - my $dbpassword = UserExists $userid; - - # Return -1 if user doesn't exist - return -1 if !$dbpassword; - - # Return -2 if password does not match - if ($password eq $dbpassword) { - MAPSDB::SetContext $userid; - return 0 - } else { - return -2 - } # if -} # Login - -sub Nulllist ($;$$) { - # Nulllist will simply discard the message. - my ($sender, $sequence, $hit_count) = @_; - - RecordHit "null", $sequence, ++$hit_count if $sequence; - - # Discard Message - Logmsg "nulllist", $sender, "Discarded message"; -} # Nulllist - -sub OnBlacklist ($;$) { - my ($sender, $update) = @_; - - return CheckOnList "black", $sender, $update; -} # CheckOnBlacklist - -sub OnNulllist ($;$) { - my ($sender, $update) = @_; - - return CheckOnList "null", $sender, $update; -} # CheckOnNulllist - -sub OnWhitelist ($;$$) { - my ($sender, $userid, $update) = @_; - - if (defined $userid) { - MAPSDB::SetContext $userid; - } # if - - return CheckOnList "white", $sender, $update; -} # OnWhitelist - -sub OptimizeDB () { - return MAPSDB::OptimizeDB (); -} # 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; - - # 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 - - if (/From (\S*)/) { - $envelope_sender = $1; - $sender_long = $envelope_sender; - } # if - - push @data, $_ if /^From /; - - while (<$input>) { - chomp; - push @data, $_; - - # Blank line indicates start of message body - 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 - } 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"); - } # if - } # if - } # while - - # Read message body - while (<$input>) { - 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; - - # 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; - - # 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 ResequenceList ($$) { - my ($userid, $type) = @_; - - return MAPSDB::ResequenceList $userid, $type; -} # ResequenceList - -sub ReturnMessages ($$) { - my ($userid, $sender) = @_; - - return MAPSDB::ReturnMessages $userid, $sender; -} # ReturnMessages - -sub ReturnSenders ($$$;$$) { - my ($userid, $type, $next, $lines, $date) = @_; - - return MAPSDB::ReturnSenders $userid, $type, $next, $lines, $date; -} # ReturnSenders - -sub ReturnList ($$$) { - my ($type, $start_at, $lines) = @_; - - return MAPSDB::ReturnList $type, $start_at, $lines; -} # ReturnList - -sub ReturnListEntry ($$) { - my ($type, $sequence) = @_; - - return MAPSDB::ReturnListEntry $type, $sequence; -} # ReturnList - -# 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) = @_; - - # Check to see if this sender has already emailed us. - my $msg_count = CountMsg $sender; - - if ($msg_count < 5) { - # Return register message - my @msg; - foreach (split /\n/,$data) { - push @msg, "$_\n"; - } # foreach - SendMsg $reply_to, - "Your email has been returned by MAPS", - "$mapsbase/register.html", - GetContext, - @msg - if $msg_count eq 0; - Logmsg "returned", $sender, "Sent register reply"; - # Save message - SaveMsg $sender, $subject, $data; - } else { - Add2Nulllist $sender, GetContext, "Auto Null List - Mail loop"; - Logmsg "mailloop", $sender, "Mail loop encountered"; - } # if -} # ReturnMsg - -sub SaveMsg ($$$) { - my ($sender, $subject, $data) = @_; - - AddEmail $sender, $subject, $data; -} # SaveMsg - -sub SearchEmails ($$) { - my ($userid, $searchfield) = @_; - - return MAPSDB::SearchEmails $userid, $searchfield; -} # SearchEmails - -sub ForwardMsg ($$$) { - my ($sender, $subject, $data) = @_; - - my @lines = split /\n/, $data; - - while ($_ = shift @lines) { - last if ($_ eq "" || $_ eq "\r"); - } # while - - my $to = "renn.leech\@compassbank.com"; - - my $msg = MIME::Entity->build ( - From => $sender, - To => $to, - Subject => $subject, - Type => "text/html", - Data => \@lines, - ); - - # Send it - open MAIL, "| /usr/lib/sendmail -t -oi -oem" - or die "ForwardMsg: Unable to open pipe to sendmail $!"; - $msg->print(\*MAIL); - close MAIL; -} # ForwardMsg - -sub SendMsg ($$$$@) { - # SendMsg will send the message contained in $msgfile. - my ($sender, $subject, $msgfile, $userid, @spammsg) = @_; - - my @lines; - - # Open return message template file - open RETURN_MSG_FILE, "$msgfile" - or die "Unable to open return msg file ($msgfile): $!\n"; - - # Read return message template file and print it to $msg_body - while () { - if (/\$userid/) { - # Replace userid - s/\$userid/$userid/; - } # if - if (/\$sender/) { - # Replace sender - s/\$sender/$sender/; - } #if - push @lines, $_; - } # while - - # Close RETURN_MSG_FILE - close RETURN_MSG_FILE; - - # Create the message, and set up the mail headers: - my $msg = MIME::Entity->build ( - From => "MAPS\@DeFaria.com", - To => $sender, - Subject => $subject, - Type => "text/html", - Data => \@lines - ); - - # Need to obtain the spam message here... - $msg->attach ( - Type => "message", - Disposition => "attachment", - Data => \@spammsg - ); - - # Send it - open MAIL, "| /usr/lib/sendmail -t -oi -oem" - or die "SendMsg: Unable to open pipe to sendmail $!"; - $msg->print(\*MAIL); - close MAIL; -} # SendMsg - -sub SetContext ($) { - my ($new_user) = @_; - - return MAPSDB::SetContext $new_user; -} # SetContext - -sub Space ($) { - my ($userid) = @_; - - return MAPSDB::Space $userid; -} # Space - -sub UpdateList ($$$$$$$) { - my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_; - - return MAPSDB::UpdateList $userid, $type, $pattern, $domain, $comment, $hit_count, $sequence; -} # UpdateList - -sub UpdateUser ($$$$) { - my ($userid, $fullname, $email, $password) = @_; - - return MAPSDB::UpdateUser $userid, $fullname, $email, $password; -} # UpdateUser - -sub UpdateUserOptions ($@) { - my ($userid, %options) = @_; - - my $status; - - foreach (keys (%options)) { - $status = MAPSDB::UpdateUserOption $userid, $_, $options{$_}; - last if $status ne 0; - } - - return $status; -} # UpdateUserOptions - -sub UserExists ($) { - my ($userid) = @_; - - return MAPSDB::UserExists $userid -} # UserExists - -sub Whitelist ($$;$$) { - # Whitelist will deliver the message. - my ($sender, $data, $sequence, $hit_count) = @_; - - my $userid = GetContext; - - # Dump message into a file - open MESSAGE, ">/tmp/MAPSMessage.$$" - 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.$$"; - - unlink "/tmp/MAPSMessage.$$"; - - if ($status eq 0) { - Logmsg "whitelist", $sender, "Delivered message"; - } else { - Error "Unable to deliver message - is MAPSDeliver setgid? - $!"; - } # if - - RecordHit "white", $sequence, ++$hit_count if $sequence; - - return $status; -} # Whitelist - -1; diff --git a/maps/bin/MAPSDeliver b/maps/bin/MAPSDeliver index 3921535..ab6a2ff 100755 --- a/maps/bin/MAPSDeliver +++ b/maps/bin/MAPSDeliver @@ -20,13 +20,13 @@ use warnings; use FindBin; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPSFile; -use MAPSDB; +use MAPS; use MAPSLog; -sub DeliverMail ($$) { +sub DeliverMail($$) { my ($userid, $msgfileName) = @_; # Open maildrop file @@ -42,8 +42,7 @@ sub DeliverMail ($$) { # Write msgfile -> $maildrop print $maildrop "\n\n"; - print $maildrop $_ - while (<$msgfile>); + print $maildrop $_ while (<$msgfile>); # Unlock the file Unlock $maildrop; @@ -61,14 +60,16 @@ my ($userid, $msgfile) = @ARGV; die 'User id not specified' unless $userid; die 'Msgfile not specified' unless $msgfile; -my $err = DeliverMail $userid, $msgfile; +my $err = DeliverMail($userid, $msgfile); if ($err) { - OpenDB 'maps', 'spam'; + OpenDB('maps', 'spam'); - MAPSDB::SetContext $userid; + SetContext($userid); - Error $err; + Error($err); + + exit 1; } # if -exit $err ? 1 : 0; +exit 0; diff --git a/maps/bin/add2blacklist.cgi b/maps/bin/add2blacklist.cgi index 6b5d14f..f7c29d5 100755 --- a/maps/bin/add2blacklist.cgi +++ b/maps/bin/add2blacklist.cgi @@ -2,7 +2,7 @@ ################################################################################ # # File: $RCSfile: add2blacklist.cgi,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: Add an email address to the blacklist # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; @@ -31,9 +31,9 @@ my $userid; my $Userid; my $type = 'black'; -sub Add2List { - my $sender = ''; - my $nextseq = MAPSDB::GetNextSequenceNo $userid, $type; +sub Add2List() { + my $sender = ''; + my $nextseq = GetNextSequenceNo($userid, $type); while () { my $pattern = param "pattern$nextseq"; @@ -41,33 +41,33 @@ sub Add2List { my $comment = param "comment$nextseq"; last if ((!defined $pattern || $pattern eq '') && - (!defined $domain || $domain eq '')); + (!defined $domain || $domain eq '')); $sender = lc "$pattern\@$domain"; - my ($status, $rule) = OnBlacklist $sender; + my ($status, $rule) = OnBlacklist($sender); if ($status != 0) { print br {-class => 'error'}, "The email address $sender is already on ${Userid}'s $type list"; } else { - Add2Blacklist $sender, $userid, $comment; + Add2Blacklist($sender, $userid, $comment); print br "The email address, $sender, has been added to ${Userid}'s $type list"; # Now remove this entry from the other lists (if present) - foreach my $otherlist ('white', 'null') { - my $sth = FindList $otherlist, $sender; - my ($sequence, $count); + for my $otherlist ('white', 'null') { + my $sth = FindList $otherlist, $sender; + my ($sequence, $count); - ($_, $_, $_, $_, $_, $sequence) = GetList $sth; + ($_, $_, $_, $_, $_, $sequence) = GetList($sth); - if ($sequence) { - $count = DeleteList $otherlist, $sequence; - print br "Removed $sender from ${Userid}'s " . ucfirst $otherlist . ' list' - if $count > 0; + if ($sequence) { + $count = DeleteList($otherlist, $sequence); + print br "Removed $sender from ${Userid}'s " . ucfirst $otherlist . ' list' + if $count > 0; - ResequenceList $userid, $otherlist; - } # if - } # foreach + ResequenceList($userid, $otherlist); + } # if + } # for } # if $nextseq++; @@ -75,7 +75,7 @@ sub Add2List { } # Add2List # Main -$userid = Heading ( +$userid = Heading( 'getcookie', '', 'Add to Black List', @@ -84,9 +84,9 @@ $userid = Heading ( $Userid = ucfirst $userid; -SetContext $userid; +SetContext($userid); -NavigationBar $userid; +NavigationBar($userid); Add2List; @@ -97,10 +97,10 @@ print start_form { }; print '

', - hidden ({-name => 'type', - -default => $type}), - submit ({-name => 'action', - -value => 'Add New Entry'}), + hidden ({-name => 'type', + -default => $type}), + submit ({-name => 'action', + -value => 'Add New Entry'}), '
'; Footing; diff --git a/maps/bin/add2nulllist.cgi b/maps/bin/add2nulllist.cgi index 03815fd..65f302a 100755 --- a/maps/bin/add2nulllist.cgi +++ b/maps/bin/add2nulllist.cgi @@ -2,8 +2,8 @@ ################################################################################ # # File: $RCSfile: add2nulllist.cgi,v $ -# Revision: $Revision: 1.1 $ -# Description: Add an email address to the nulllist +# Revision: $Revision: 1.1 $ +# Description: Add an email address to the nulllist # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; @@ -31,9 +31,9 @@ my $userid; my $Userid; my $type = 'null'; -sub Add2List { +sub Add2List() { my $sender = ''; - my $nextseq = MAPSDB::GetNextSequenceNo $userid, $type; + my $nextseq = GetNextSequenceNo($userid, $type); while () { my $pattern = param "pattern$nextseq"; @@ -46,33 +46,33 @@ sub Add2List { $sender = lc "$pattern\@$domain"; - my ($status, $rule) = OnNulllist $sender; + my ($status, $rule) = OnNulllist($sender); if ($status != 0) { print br {-class => 'error'}, "The email address $sender is already on ${Userid}'s $type list"; } else { - $hit_count ||= CountMsg $sender; + $hit_count ||= CountMsg($sender); - Add2Nulllist $sender, $userid, $comment, $hit_count; + Add2Nulllist($sender, $userid, $comment, $hit_count); print br "The email address, $sender, has been added to ${Userid}'s $type list"; # Now remove this entry from the other lists (if present) - foreach my $otherlist ('white', 'black') { + for my $otherlist ('white', 'black') { my $sth = FindList $otherlist, $sender; my ($sequence, $count); - ($_, $_, $_, $_, $_, $sequence) = GetList $sth; + ($_, $_, $_, $_, $_, $sequence) = GetList($sth); if ($sequence) { - $count = DeleteList $otherlist, $sequence; + $count = DeleteList($otherlist, $sequence); print br "Removed $sender from ${Userid}'s " . ucfirst $otherlist . ' list' if $count > 0; - ResequenceList $userid, $otherlist; + ResequenceList($userid, $otherlist); } # if - } # foreach + } # for } # if $nextseq++; @@ -80,32 +80,32 @@ sub Add2List { } # Add2List # Main -$userid = Heading ( +$userid = Heading( 'getcookie', '', 'Add to Null List', 'Add to Null List', ); -SetContext $userid; +SetContext($userid); -NavigationBar $userid; +NavigationBar($userid); $Userid = ucfirst $userid; Add2List; print start_form { - -method => 'post', - -action => 'processaction.cgi', - -name => 'list' + -method => 'post', + -action => 'processaction.cgi', + -name => 'list' }; print '

', - hidden ({-name => 'type', - -default => $type}), - submit ({-name => 'action', - -value => 'Add New Entry'}), + hidden ({-name => 'type', + -default => $type}), + submit ({-name => 'action', + -value => 'Add New Entry'}), '
'; Footing; diff --git a/maps/bin/add2nulllist.pl b/maps/bin/add2nulllist.pl index b6003c2..8ae2c78 100755 --- a/maps/bin/add2nulllist.pl +++ b/maps/bin/add2nulllist.pl @@ -4,7 +4,7 @@ use warnings; use FindBin; -use lib $FindBin::Bin, '/opt/clearscm/lib'; +use lib "$FindBin::Bin/../lib", '/opt/clearscm/lib'; use MAPS; use MAPSLog; @@ -16,8 +16,8 @@ my $userid = $ENV{USER}; my $Userid; my $type = "null"; -sub GetItems { - my $filename = shift; +sub GetItems($) { + my ($filename) = @_; my @items; @@ -28,7 +28,7 @@ sub GetItems { my @fields = split; my %item; - my @address = split /\@/, $fields [0]; + my @address = split /\@/, $fields[0]; $item{pattern} = $address[0]; $item{domain} = $address[1]; @@ -43,13 +43,13 @@ sub GetItems { return @items; } # GetItems -sub Add2List { +sub Add2List(@) { my @items = @_; - my $sender = ""; - my $nextseq = MAPSDB::GetNextSequenceNo $userid, $type; + my $sender = ''; + my $nextseq = GetNextSequenceNo($userid, $type); - foreach (@items) { + for (@items) { my %item = %{$_}; my $pattern = $item{pattern}; @@ -64,24 +64,25 @@ sub Add2List { $sender = lc ("$pattern\@$domain"); - if (OnNulllist $sender) { - display " Already on list"; + if (OnNulllist($sender)) { + display ' Already on list'; } else { - Add2Nulllist $sender, $userid, $comment, $hit_count; - display " done"; + Add2Nulllist($sender, $userid, $comment, $hit_count); + display ' done'; # Now remove this entry from the other lists (if present) - foreach my $otherlist ("white", "black") { - my $sth = FindList $otherlist, $sender; + for my $otherlist ('white', 'black') { + my $sth = FindList($otherlist, $sender); my ($sequence, $count); - ($_, $_, $_, $_, $_, $sequence) = GetList $sth; + ($_, $_, $_, $_, $_, $sequence) = GetList($sth); if ($sequence) { - $count = DeleteList $otherlist, $sequence; + $count = DeleteList($otherlist, $sequence); } # if - } # foreach + } # for } # if + $nextseq++; } # while @@ -91,16 +92,16 @@ sub Add2List { # Main my $filename; -if ($ARGV [0]) { +if ($ARGV[0]) { $filename = $ARGV[0]; } else { error "Must specify a filename of addresses to null list", 1; } # if -SetContext $userid; +SetContext($userid); $Userid = ucfirst $userid; -Add2List (GetItems $filename); +Add2List(GetItems ($filename)); exit; diff --git a/maps/bin/add2whitelist.cgi b/maps/bin/add2whitelist.cgi index 3e93d1d..46a5fff 100755 --- a/maps/bin/add2whitelist.cgi +++ b/maps/bin/add2whitelist.cgi @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; @@ -31,9 +31,9 @@ my $userid; my $Userid; my $type = 'white'; -sub Add2List { +sub Add2List() { my $sender = ''; - my $nextseq = MAPSDB::GetNextSequenceNo $userid, $type; + my $nextseq = GetNextSequenceNo($userid, $type); while () { my $pattern = param "pattern$nextseq"; @@ -45,12 +45,12 @@ sub Add2List { $sender = lc "$pattern\@$domain"; - my ($status, $rule) = OnWhitelist $sender, $userid; + my ($status, $rule) = OnWhitelist($sender, $userid); if ($status != 0) { print br {-class => 'error'}, "The email address $sender is already on ${Userid}'s $type list"; } else { - my $messages = Add2Whitelist $sender, $userid, $comment; + my $messages = Add2Whitelist($sender, $userid, $comment); print br "The email address, $sender, has been added to ${Userid}'s $type list"; if ($messages > 0) { @@ -66,20 +66,20 @@ sub Add2List { } # if # Now remove this entry from the other lists (if present) - foreach my $otherlist ('black', 'null') { - my $sth = FindList $otherlist, $sender; + for my $otherlist ('black', 'null') { + my $sth = FindList($otherlist, $sender); my ($sequence, $count); - ($_, $_, $_, $_, $_, $sequence) = GetList $sth; + ($_, $_, $_, $_, $_, $sequence) = GetList($sth); if ($sequence) { - $count = DeleteList $otherlist, $sequence; + $count = DeleteList($otherlist, $sequence); print br "Removed $sender from ${Userid}'s " . ucfirst $otherlist . ' list' if $count > 0; - ResequenceList $userid, $otherlist; + ResequenceList($userid, $otherlist); } # if - } # foreach + } # for } # if $nextseq++; @@ -87,7 +87,7 @@ sub Add2List { } # Add2List # Main -$userid = Heading ( +$userid = Heading( 'getcookie', '', 'Add to White List', @@ -98,9 +98,9 @@ $userid ||= $ENV{USER}; $Userid = ucfirst $userid; -SetContext $userid; +SetContext($userid); -NavigationBar $userid; +NavigationBar($userid); Add2List; diff --git a/maps/bin/checkaddress b/maps/bin/checkaddress index 3ebefbc..97da899 100755 --- a/maps/bin/checkaddress +++ b/maps/bin/checkaddress @@ -2,7 +2,7 @@ ################################################################################ # # File: $RCSfile: checkaddress,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: Check an email address # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 @@ -17,12 +17,12 @@ use warnings; use FindBin; -use lib $FindBin::Bin, '/opt/clearscm/lib'; +use lib "$FindBin::Bin/../lib", '/opt/clearscm/lib'; use MAPS; use Display; -error ("Must specify an email address to check", 1) +error("Must specify an email address to check", 1) if !$ARGV[0] or $ARGV[0] eq ""; foreach (@ARGV) { @@ -41,7 +41,7 @@ foreach (@ARGV) { } # unless if ($domain eq "defaria.com" and $user ne $username) { - display "Nulllist - $sender is from this domain but is not from $username"; + display"Nulllist - $sender is from this domain but is not from $username"; next; } # if @@ -63,11 +63,11 @@ foreach (@ARGV) { # Finally, we handle return processing # Check whitelist - if (OnWhitelist $sender, $username, 0) { + if (OnWhitelist($sender, $username, 0)) { display "Sender $sender would be whitelisted"; - } elsif (OnBlacklist $sender, 0) { + } elsif (OnBlacklist($sender, 0)) { display "Sender $sender would be be blacklisted"; - } elsif (OnNulllist $sender, 0) { + } elsif (OnNulllist($sender, 0)) { display "Sender $sender would be nulllisted" } else { display "Sender $sender would be returned" diff --git a/maps/bin/checkaddress.cgi b/maps/bin/checkaddress.cgi index 3b28cce..9166648 100755 --- a/maps/bin/checkaddress.cgi +++ b/maps/bin/checkaddress.cgi @@ -2,7 +2,7 @@ ################################################################################ # # File: $RCSfile: checkaddress.cgi,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: Check an email address # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 @@ -18,24 +18,24 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; -use CGI qw (:standard); +use CGI qw(:standard); # Get MAPSUser from cookie my $userid; if (param "user") { - $userid = param "user"; + $userid = param("user"); } else { - $userid = cookie ("MAPSUser"); + $userid = cookie("MAPSUser"); } # if -my $sender = param ("sender"); +my $sender = param("sender"); -sub Heading { +sub Heading() { print header (-title => "MAPS: Check Address"), start_html (-title => "MAPS: Check Address", @@ -45,7 +45,7 @@ sub Heading { "MAPS: Checking address $sender"; } # Heading -sub Body { +sub Body() { my ($onlist, $rule); # Algorithm change: We now first check to see if the sender is not found @@ -64,7 +64,7 @@ sub Body { # Then we process nulllist people. # # Finally, we handle return processing - ($onlist, $rule) = OnWhitelist $sender, $userid, 0; + ($onlist, $rule) = OnWhitelist($sender, $userid, 0); if ($onlist) { print div {-align => "center"}, @@ -72,7 +72,7 @@ sub Body { "Messages from", b ($sender), "will be", b ("delivered"), br, hr; print $rule; } else { - ($onlist, $rule) = OnBlacklist $sender, 0; + ($onlist, $rule) = OnBlacklist($sender, 0); if ($onlist) { print div {-align => "center"}, @@ -80,7 +80,7 @@ sub Body { "Messages from", b ($sender), "will be", b ("blacklisted"), br, hr; print $rule; } else { - ($onlist, $rule) = OnNulllist $sender, 0; + ($onlist, $rule) = OnNulllist($sender, 0); if ($onlist) { print div {-align => "center"}, @@ -96,17 +96,17 @@ sub Body { } # if print br div {-align => "center"}, - submit (-name => "submit", - -value => "Close", - -onClick => "window.close (self)"); + submit(-name => "submit", + -value => "Close", + -onClick => "window.close (self)"); } # Body -sub Footing { +sub Footing() { print end_html; } # Footing # Main -SetContext $userid; +SetContext($userid); Heading; Body; Footing; diff --git a/maps/bin/detail.cgi b/maps/bin/detail.cgi index 2da6965..1d39097 100755 --- a/maps/bin/detail.cgi +++ b/maps/bin/detail.cgi @@ -1,5 +1,5 @@ #!/usr/bin/perl -################################################################################# +################################################################################ # # File: $RCSfile: detail.cgi,v $ # Revision: $Revision: 1.1 $ @@ -19,19 +19,19 @@ use MIME::Words qw(:all); use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; use MAPSUtil; use MAPSWeb; -use CGI qw (:standard *table start_td end_td start_Tr end_Tr start_div end_div); +use CGI qw(:standard *table start_td end_td start_Tr end_Tr start_div end_div); use CGI::Carp 'fatalsToBrowser'; -my $type = param ('type'); -my $next = param ('next'); -my $lines = param ('lines'); -my $date = param ('date'); +my $type = param('type'); +my $next = param('next'); +my $lines = param('lines'); +my $date = param('date'); $date ||= ''; @@ -74,7 +74,7 @@ my %types = ( ); sub MakeButtons { - my $type = shift; + my ($type) = @_; my $prev_button = $prev >= 0 ? a ({-href => "detail.cgi?type=$type;date=$date;next=$prev", @@ -151,12 +151,12 @@ sub PrintTable { -action => 'processaction.cgi', -name => 'detail' }; - print start_table ({-align => 'center', - -id => $table_name, - -border => 0, - -cellspacing => 0, - -cellpadding => 0, - -width => '100%'}) . "\n"; + print start_table({-align => 'center', + -id => $table_name, + -border => 0, + -cellspacing => 0, + -cellpadding => 0, + -width => '100%'}) . "\n"; my $buttons = MakeButtons $type; @@ -171,20 +171,22 @@ sub PrintTable { ]; print end_div; - foreach my $sender (ReturnSenders $userid, $type, $next, $lines, $date) { - my @msgs = ReturnMessages $userid, $sender; + for my $sender (ReturnSenders($userid, $type, $next, $lines, $date)) { + my @msgs = ReturnMessages($userid, $sender); my @msgs2 = @msgs; + my ($onlist, $seq); + my $rule = 'none'; my $hit_count = 0; - ($onlist, $rule, $seq, $hit_count) = OnWhitelist $sender, $userid, 0; + ($onlist, $rule, $seq, $hit_count) = OnWhitelist($sender, $userid, 0); unless ($onlist) { - ($onlist, $rule, $seq, $hit_count) = OnBlacklist $sender, 0; + ($onlist, $rule, $seq, $hit_count) = OnBlacklist($sender, 0); unless ($onlist) { - ($onlist, $rule, $seq, $hit_count) = OnNulllist $sender, 0; + ($onlist, $rule, $seq, $hit_count) = OnNulllist($sender, 0); } # unless } # unless @@ -219,6 +221,10 @@ sub PrintTable { -border => 0, -width => '100%', -bgcolor => '#d4d0c8'}; + + # Get subject line + my $heading = $msgs2[0][0] || ''; + $heading = "?subject=$heading" if $heading; print td {-class => 'tablelabel', -valign => 'middle', @@ -226,7 +232,7 @@ sub PrintTable { td {-class => 'sender', -valign => 'middle', -width => '40%'}, - a {-href => "mailto:$sender?subject=$msgs2[0][0]"}, $sender, + a {-href => "mailto:$sender$heading"}, $sender, td { -valign => 'middle'}, $rule; @@ -235,7 +241,7 @@ sub PrintTable { my $messages = 1; - foreach (@msgs) { + for (@msgs) { my $msg_date = pop @{$_}; my $subject = pop @{$_}; @@ -275,10 +281,10 @@ sub PrintTable { -valign => 'middle'}, $msg_date ]; print end_table; - } # foreach + } # for print end_td; print end_Tr; - } # foreach + } # for print start_div {-class => 'toolbar'}; print @@ -292,6 +298,8 @@ sub PrintTable { print end_div; print end_table; print end_form; + + return; } # PrintTable # Main @@ -300,7 +308,7 @@ my @scripts = ('ListActions.js'); my $heading_date =$date ne '' ? ' on ' . FormatDate ($date) : ''; -$userid = Heading ( +$userid = Heading( 'getcookie', '', (ucfirst ($type) . ' Report'), @@ -312,11 +320,11 @@ $userid = Heading ( $userid ||= $ENV{USER}; -SetContext $userid; -NavigationBar $userid; +SetContext($userid); +NavigationBar($userid); unless ($lines) { - my %options = GetUserOptions $userid; + my %options = GetUserOptions($userid); $lines = $options{'Page'}; } # unless @@ -330,7 +338,7 @@ if ($date eq '') { . "and timestamp > '$sod' and timestamp < '$eod' "; } # if -$total = MAPSDB::count_distinct ('log', 'sender', $condition); +$total = count_distinct('log', 'sender', $condition); $next ||= 0; @@ -339,11 +347,11 @@ $last = $next + $lines < $total ? $next + $lines : $total; if (($next - $lines) > 0) { $prev = $next - $lines; } else { - $prev = $next eq 0 ? -1 : 0; + $prev = $next == 0 ? -1 : 0; } # if -PrintTable $type; +PrintTable($type); -Footing $table_name; +Footing($table_name); exit; diff --git a/maps/bin/display.cgi b/maps/bin/display.cgi index 28d46dd..10c706d 100755 --- a/maps/bin/display.cgi +++ b/maps/bin/display.cgi @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSWeb; @@ -35,13 +35,13 @@ my $sender = param('sender'); my $msg_nbr = param('msg_nbr'); my $table_name = 'message'; -sub ParseEmail (@) { +sub ParseEmail(@) { my (@header) = @_; my %header; # First output the header information. Note we'll skip uninteresting stuff - foreach (@header) { + for (@header) { last if ($_ eq '' || $_ eq "\cM"); # Escape "<" and ">" @@ -59,12 +59,12 @@ sub ParseEmail (@) { } elsif (/^Content-Transfer-Encoding: base64/) { $header{base64} = 1; } # if - } # while + } # for return %header; } # ParseEmail -sub Body ($) { +sub Body($) { my ($count) = @_; $count ||= 1; @@ -78,7 +78,7 @@ sub Body ($) { ($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle; } # for - my $parser = new MIME::Parser; + my $parser = MIME::Parser->new(); $parser->output_to_core (1); @@ -151,12 +151,12 @@ sub Body ($) { print ''; } # if } else { - foreach my $part ($entity->parts) { + for my $part ($entity->parts) { # We assume here that if this part is multipart/alternative then # there exists at least one part that is text/html and we favor # that (since we're outputing to a web page anyway... if ($part->mime_type eq 'multipart/alternative') { - foreach my $subpart ($part->parts) { + for my $subpart ($part->parts) { if ($subpart->mime_type eq 'text/html') { # There should be an easier way to get this but I couldn't find one. my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}; @@ -171,10 +171,14 @@ sub Body ($) { $subpart->print_body; last; } # if - } # foreach + } # for } else { if ($part->mime_type =~ /text/) { - my $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}; + my $encoding = ''; + + $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} + if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}; + if ($encoding =~ /base64/) { $part->bodyhandle->print(); } else { @@ -184,7 +188,7 @@ sub Body ($) { } # if } # if } # if - } # foreach + } # for } # if print "\n"; @@ -194,7 +198,7 @@ sub Body ($) { print end_table; } # Body -$userid = Heading ( +$userid = Heading( 'getcookie', '', "Email message from $sender", @@ -203,9 +207,9 @@ $userid = Heading ( $table_name, ); -SetContext $userid; -NavigationBar $userid; +SetContext($userid); +NavigationBar($userid); -Body $msg_nbr; +Body($msg_nbr); -Footing $table_name; +Footing($table_name); diff --git a/maps/bin/domains b/maps/bin/domains.pl similarity index 67% rename from maps/bin/domains rename to maps/bin/domains.pl index 8eb640f..4176922 100755 --- a/maps/bin/domains +++ b/maps/bin/domains.pl @@ -2,12 +2,12 @@ ################################################################################ # # File: $RCSfile: domains,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: Display entries from the list table where there is at least one -# entry with a null pattern (nuke the domain) and yet still other -# entries with the same domain name but having a pattern. We may -# want to eliminate the other entries since we're nuking the -# whole domain anyway. +# entry with a null pattern (nuke the domain) and yet still other +# entries with the same domain name but having a pattern. We may +# want to eliminate the other entries since we're nuking the +# whole domain anyway. # Author: Andrew@DeFaria.com # Created: Sat Oct 20 23:28:19 MST 2007 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -22,11 +22,9 @@ use warnings; use FindBin; use Getopt::Long; -use lib $FindBin::Bin, '/opt/clearscm/lib'; +use lib "$FindBin::Bin/../lib", '/opt/clearscm/lib'; use MAPS; -use MAPSDB; - use Display; sub Usage () { @@ -38,9 +36,9 @@ END } # Usage GetOptions ( - "verbose" => sub { set_verbose }, - "debug" => sub { set_debug }, - "usage" => sub { Usage }, + "verbose" => sub { set_verbose }, + "debug" => sub { set_debug }, + "usage" => sub { Usage }, ) || Usage; my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER}; @@ -50,20 +48,20 @@ SetContext $userid; my $statement = "select domain from list where userid=\"$userid\" and type=\"null\" and pattern is null"; -my $need_requence = 0; +my $need_resequence = 0; -foreach my $domain (sort (&MAPSDB::GetRows ($statement))) { +for my $domain (sort (GetRows($statement))) { verbose "Processing domain $domain"; $statement = "select sequence from list where userid = \"$userid\" and domain = \"$domain\" and type = \"null\" and pattern is not null"; - foreach my $sequence (MAPSDB::GetRows $statement) { + for my $sequence (GetRows $statement) { display "Deleting $domain ($sequence)"; - $need_requence = 1; + $need_resequence = 1; DeleteList "null", $sequence; - } # foreach -} # foreach + } # for +} # for -if ($need_requence) { +if ($need_resequence) { verbose "Resequencing null list..."; ResequenceList $userid, "null"; verbose "done"; diff --git a/maps/bin/editprofile.cgi b/maps/bin/editprofile.cgi index 4254326..092e35c 100755 --- a/maps/bin/editprofile.cgi +++ b/maps/bin/editprofile.cgi @@ -2,8 +2,8 @@ ################################################################################ # # File: $RCSfile: editprofile.cgi,v $ -# Revision: $Revision: 1.1 $ -# Description: Edit the user's profile +# Revision: $Revision: 1.1 $ +# Description: Edit the user's profile # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -18,187 +18,164 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSWeb; -use CGI qw (:standard *table); +use CGI qw(:standard *table); my $userid; -my $table_name = "profile"; +my $table_name = 'profile'; -sub Body { - my $handle = FindUser $userid; +sub Body() { + my $handle = FindUser($userid); my ($fullname, $email, $password); - ($_, $fullname, $email, $password) = GetUser ($handle); + ($_, $fullname, $email, $password) = GetUser($handle); $handle->finish; - my %options = GetUserOptions $userid; + my %options = GetUserOptions($userid); print start_form { - -method => "post", - -action => "updateprofile.cgi", - -onSubmit => "return validate (this);" + -method => 'post', + -action => 'updateprofile.cgi', + -onSubmit => 'return validate (this);' }; print start_table { - -align => "center", - -id => $table_name, - -border => 1, - -cellspacing => 0, - -cellpadding => 2, - -width => "100%"}; + -align => 'center', + -id => $table_name, + -border => 1, + -cellspacing => 0, + -cellpadding => 2, + -width => '100%'}; print Tr ([ - td {-class => "label", - -width => 134}, - "Username:", - td {-width => 290}, - $userid, - td {-class => "notetext"}, - "Specify a username to log into MAPS" + td {-class => 'label', + -width => 134}, 'Username:', + td {-width => 290}, $userid, + td {-class => 'notetext'}, 'Specify a username to log into MAPS' ]) . "\n"; print Tr ([ - td {-class => "label"}, - "Full name:", + td {-class => 'label'}, 'Full name:', td ( - textfield {-class => "inputfield", - -size => 50, - -name => "fullname", - -value => "$fullname"}), - td {-class => "notetext"}, - "Specify your full name" + textfield {-class => 'inputfield', + -size => 50, + -name => 'fullname', + -value => $fullname}), + td {-class => 'notetext'},'Specify your full name' ]) . "\n"; print Tr [ - td {-class => "label"}, - "Email:", + td {-class => 'label'}, 'Email:', td ( - textfield {-class => "inputfield", - -size => 50, - -name => "email", - -value => $email}), - td {-class => "notetext"}, - "Your email address is used if you are a " . + textfield {-class => 'inputfield', + -size => 50, + -name => 'email', + -value => $email}), + td {-class => 'notetext'},'Your email address is used if you are a ' . i ("Tag & Forward") . - " user. This is the email address that MAPS will forward your email to after it tags it. This email address is also used in case you forget your password so that we can email you your password." + ' user. This is the email address that MAPS will forward your email to after it tags it. This email address is also used in case you forget your password so that we can email you your password.' ]; print Tr [ - td {-class => "label"}, - "Old Password:", + td {-class => 'label'}, 'Old Password:', td ( - password_field {-class => "inputfield", - -size => 20, - -name => "old_password"}), - td {-class => "notetext"}, - "Enter your old password" + password_field {-class => 'inputfield', + -size => 20, + -name => 'old_password'}), + td {-class => 'notetext'}, 'Enter your old password' ]; print Tr [ - td {-class => "label"}, - "New Password:", + td {-class => 'label'}, 'New Password:', td ( - password_field {-class => "inputfield", - -size => 20, - -name => "new_password", - -value => ""}), - td {-class => "notetext"}, - "Choose a new password greater than 6 characters." + password_field {-class => 'inputfield', + -size => 20, + -name => 'new_password', + -value => ''}), + td {-class => 'notetext'}, 'Choose a new password greater than 6 characters.' ]; print Tr [ - td {-class => "label"}, - "Repeat Password:", + td {-class => 'label'},'Repeat Password:', td ( - password_field {-class => "inputfield", - -size => 20, - -name => "repeated_password", - -value => ""}), - td {-class => "notetext"}, - "Re-enter your password so we can be sure you typed it correctly." + password_field {-class => 'inputfield', + -size => 20, + -name => 'repeated_password', + -value => ''}), + td {-class => 'notetext'}, 'Re-enter your password so we can be sure you typed it correctly.' ]; print Tr [ - td {-class => "label"}, - "MAPSPOP user:", + td {-class => 'label'}, 'MAPSPOP user:', td ( - font ({-class => "label"}, - radio_group {-name => "MAPSPOP", - -values => ["yes", "no"], - -default => "no", - -labels => {"yes" => "Yes", - "no" => "No"}})), - td {-class => "notetext"}, - "MAPSPOP users need to download " . - a ({-href => "/maps/bin/MAPSPOP.exe"}, "MAPSPOP") . - ". See " . - a ({-href => "/maps/doc/UsingMAPSPOP.html"}, "Using MAPSPOP") . - " for more information." + font ({-class => 'label'}, + radio_group {-name => 'MAPSPOP', + -values => ['yes', 'no'], + -default => 'no', + -labels => {'yes' => 'Yes', + 'no' => 'No'}})), + td {-class => 'notetext'}, 'MAPSPOP users need to download ' . + a ({-href => '/maps/bin/MAPSPOP.exe'}, 'MAPSPOP') . + '. See ' . + a ({-href => '/maps/doc/UsingMAPSPOP.html'}, 'Using MAPSPOP') . + ' for more information.' ]; print Tr [ - td {-class => "label"}, - "Keep history for:", + td {-class => 'label'}, 'Keep history for:', td ( - font ({-class => "label"}, - popup_menu {-class => "inputfield", - -name => "history", - -values => ["7", "14", "30", "60", "90"], - -default => $options{"History"}}), - font ({-class => "label"}, " days")), - td {-class => "notetext"}, - "This specifies how many days of history that MAPS will keep before discarding returned messages." + font ({-class => 'label'}, + popup_menu {-class => 'inputfield', + -name => 'history', + -values => ['7', '14', '30', '60', '90'], + -default => $options{'History'}}), + font ({-class => 'label'}, ' days')), + td {-class => 'notetext'}, 'This specifies how many days of history that MAPS will keep before discarding returned messages.' ]; print Tr [ - td {-class => "label"}, - "Dates in Stats Page:", + td {-class => 'label'}, 'Dates in Stats Page:', td ( - font ({-class => "label"}, - popup_menu {-class => "inputfield", - -name => "dates", - -values => ["7", "14", "21", "30"], - -default => $options{"Dates"}})), - td {-class => "notetext"}, - "This specifies how many days are displayed in the MAPS Stats Page." + font ({-class => 'label'}, + popup_menu {-class => 'inputfield', + -name => 'dates', + -values => ['7', '14', '21', '30'], + -default => $options{'Dates'}})), + td {-class => 'notetext'}, 'This specifies how many days are displayed in the MAPS Stats Page.' ]; print Tr [ - td {-class => "label"}, - "Entries per page:", + td {-class => 'label'}, 'Entries per page:', td ( - font ({-class => "label"}, - popup_menu {-class => "inputfield", - -name => "days", - -values => ["10", "20", "30", "40", "50"], - -default => $options{"Page"}})), - td {-class => "notetext"}, - "This specifies how many entries are displayed per page in the online MAPS Reports." + font ({-class => 'label'}, + popup_menu {-class => 'inputfield', + -name => 'days', + -values => ['10', '20', '30', '40', '50'], + -default => $options{'Page'}})), + td {-class => 'notetext'}, 'This specifies how many entries are displayed per page in the online MAPS Reports.' ]; print Tr [ - td {-class => "label"}, - i ("Tag & Forward:"), + td {-class => 'label'}, i ('Tag & Forward:'), td ( - font ({-class => "label"}, - radio_group {-name => "tag_and_forward", - -values => ["yes", "no"], - -default => "no", - -labels => {"yes" => "Yes", - "no" => "No"}})), - td {-class => "notetext"}, - i ("Tag and Forward") . - " means that MAPS will not filter or save any email for you. Instead it will simply add an X-MAPS header to your email indicating what MAPS would have done with the email. This allows you to filter your email in your local email client." + font ({-class => 'label'}, + radio_group {-name => 'tag_and_forward', + -values => ['yes', 'no'], + -default => 'no', + -labels => {'yes' => 'Yes', + 'no' => 'No'}})), + td {-class => 'notetext'}, + i ('Tag and Forward') . ' means that MAPS will not filter or save any email for you. Instead it will simply add an X-MAPS header to your email indicating what MAPS would have done with the email. This allows you to filter your email in your local email client.' ]; print end_table; - print br (div {-align => "center"}, - submit (-name => "submit", - -value => "Update Profile")); + print br (div {-align => 'center'}, + submit (-name => 'submit', + -value => 'Update Profile')); print end_form; } # Body # Main -my @scripts = ("MAPSUtils.js", "CheckEditProfile.js"); - -$userid = Heading ( - "getcookie", - "", - "Edit Profile", - "Spam Elimination System", - "", +my @scripts = ('MAPSUtils.js', 'CheckEditProfile.js'); + +$userid = Heading( + 'getcookie', + '', + 'Edit Profile', + 'Spam Elimination System', + '', $table_name, @scripts ); diff --git a/maps/bin/exportlist.cgi b/maps/bin/exportlist.cgi index 45bcce1..d1900e4 100755 --- a/maps/bin/exportlist.cgi +++ b/maps/bin/exportlist.cgi @@ -17,7 +17,7 @@ use strict; use FindBin; local $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSWeb; @@ -25,18 +25,18 @@ use MAPSWeb; use CGI qw/:standard *table/; use CGI::Carp "fatalsToBrowser"; -my $type = param ("type"); -my $userid = cookie ("MAPSUser"); +my $type = param('type'); +my $userid = cookie("MAPSUser"); $userid //= $ENV{USER}; -my $Userid = ucfirst $userid; +my $Userid = ucfirst $userid; -sub PrintList { - my $type = shift; +sub PrintList($) { + my ($type) = @_; - my $year = substr ((scalar (localtime)), 20, 4); + my $year = substr((scalar(localtime)), 20, 4); my ($pattern, $domain, $comment, $hit_count, $last_hit); - my $sth = FindList $type; + my $sth = FindList($type); print "\################################################################################\n"; print "\#\n"; @@ -48,7 +48,7 @@ sub PrintList { print "\#\n"; print "\################################################################################\n"; - while (($_, $_, $pattern, $domain, $comment, $_, $hit_count, $last_hit) = GetList $sth) { + while (($_, $_, $pattern, $domain, $comment, $_, $hit_count, $last_hit) = GetList($sth)) { last if !(defined $pattern or defined $domain); $pattern //= ''; @@ -65,13 +65,13 @@ sub PrintList { } # PrintList # Main -SetContext $userid; +SetContext($userid); -print header ( +print header( -type => "application/octet-stream", -attachment => "$type.list", ); -PrintList $type; +PrintList($type); exit; diff --git a/maps/bin/importlist.cgi b/maps/bin/importlist.cgi index a8720a7..6f4e5f3 100755 --- a/maps/bin/importlist.cgi +++ b/maps/bin/importlist.cgi @@ -17,7 +17,7 @@ use strict; use FindBin; local $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use Getopt::Long; use Pod::Usage; @@ -28,7 +28,6 @@ use MAPSWeb; use CGI qw/:standard *table/; use CGI::Carp "fatalsToBrowser"; -my $type = param('type'); my $userid = cookie('MAPSUser'); $userid //= $ENV{USER}; my $Userid = ucfirst $userid; @@ -36,6 +35,7 @@ my $Userid = ucfirst $userid; my %opts = ( usage => sub { pod2usage }, help => sub { pod2usage (-verbose => 2)}, + type => param('type'), file => param('file'), ); @@ -57,17 +57,19 @@ sub importList ($) { my $alreadyExists; if ($type eq 'white') { - $alreadyExists = OnWhitelist $pattern, $userid; + ($alreadyExists) = OnWhitelist($pattern, $userid); } elsif ($type eq 'black') { - $alreadyExists = OnBlacklist $pattern, $userid; + ($alreadyExists) = OnBlacklist($pattern, $userid); } elsif ($type eq 'null') { - $alreadyExists = OnNulllist $pattern, $userid; + ($alreadyExists) = OnNulllist($pattern, $userid); } # if unless ($alreadyExists) { - AddList ($type, $pattern, 0, $comment, $hit_count, $last_hit); + AddList($type, $pattern, 0, $comment, $hit_count, $last_hit); $count++; + } else { + print br "$pattern is already on your " . ucfirst($type) . 'list'; } # unless } # while @@ -77,31 +79,32 @@ sub importList ($) { } # importList # Main -GetOptions ( +GetOptions( \%opts, 'usage', 'help', 'verbose', 'debug', 'file=s', + 'type=s', ); -pod2usage "Type not specified" unless $type; +pod2usage "Type not specified" unless $opts{type}; pod2usage '-file should be specified' unless $opts{file}; pod2usage "Unable to read $opts{file}" unless -r $opts{file}; -$userid = Heading ( +$userid = Heading( 'getcookie', '', 'Import List', 'Import List', ); -SetContext $userid; +SetContext($userid); -NavigationBar $userid; +NavigationBar($userid); -my $count = importList $type; +my $count = importList($opts{type}); if ($count == 1) { print br "$count list entry imported"; diff --git a/maps/bin/list.cgi b/maps/bin/list.cgi deleted file mode 100755 index edfc81b..0000000 --- a/maps/bin/list.cgi +++ /dev/null @@ -1,191 +0,0 @@ -#!/usr/bin/perl -################################################################################ -# -# File: $RCSfile: list.cgi,v $ -# Revision: $Revision: 1.1 $ -# Description: Manage lists -# Author: Andrew@DeFaria.com -# Created: Mon Jan 16 20:25:32 PST 2006 -# Modified: $Date: 2013/06/12 14:05:47 $ -# Language: perl -# -# (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved. -# -################################################################################ -use strict; -use warnings; - -use FindBin; - -local $0 = $FindBin::Script; - -use lib $FindBin::Bin; - -use MAPS; -use MAPSLog; -use MAPSUtil; -use MAPSWeb; -use CGI qw (:standard *table start_div end_div); -use CGI::Carp "fatalsToBrowser"; - -my $next = param("next"); -my $lines = param("lines"); -my $type = param("type"); -my $message = param("message"); -my $Type = ucfirst $type; -my $userid; -my $prev; -my $total; -my $last; -my $table_name = "list"; - -sub Body { - my $type = shift; - - if (defined $message) { - print div {-align => "center"}, - font {-class => "error"}, $message; - } # if - - print start_form { - -method => "post", - -action => "processaction.cgi", - -name => "list" - }; - - # Print some hidden fields to pass along - print - hidden (-name => "type", - -default => $type), - hidden (-name => "next", - -default => $next); - - my $current = $next + 1; - - print div {-align => "center"}, b ( - "(" . $current . "-" . $last . " of " . $total . ")"); - print start_div {-class => "toolbar", - -align => "center"}; - my $prev_button = $prev >= 0 ? - a ({-href => "list.cgi?type=$type;next=$prev", - -accesskey => 'p', - }, "Previous") : ""; - my $next_button = ($next + $lines) < $total ? - a {-href => "list.cgi?type=$type;next=" . ($next + $lines), - -accesskey => 'n', - }, "Next" : ""; - print $prev_button, - submit ({-name => "action", - -value => "Add New Entry", - -onClick => "return NoneChecked (document.list);"}), - submit ({-name => "action", - -value => "Delete Marked", - -onClick => "return CheckAtLeast1Checked (document.list) && AreYouSure ('Are you sure you want to delete these entries?');"}), - submit ({-name => "action", - -value => "Modify Marked", - -onClick => "return CheckAtLeast1Checked (document.list);"}), - submit ({-name => "action", - -value => "Reset Marks", - -onClick => "return ClearAll (document.list);"}), - $next_button; - print end_div; - print start_table {-align => "center", - -id => $table_name, - -border => 0, - -cellspacing => 0, - -cellpadding => 4, - -width => "100%"}; - print Tr [ - th {-class => "tableleftend"}, "Seq", - th {-class => "tableheader"}, "Mark", - th {-class => "tableheader"}, "Username", - th {-class => "tableheader"}, "@", - th {-class => "tableheader"}, "Domain", - th {-class => "tablerightend"}, "Comments" - ]; - - my @list = ReturnList $type, $next, $lines; - my %record; - my $i = 1; - - foreach (@list) { - %record = %{$_}; - $record{pattern} = " " if !defined $record{pattern}; - $record{domain} = " " if !defined $record{domain}; - $record{comment} = " " if !defined $record{comment}; - - my $leftclass = ($i eq $lines || $record{sequence} eq $total) ? - "tablebottomleft" : "tableleftdata"; - my $dataclass = ($i eq $lines || $record{sequence} eq $total) ? - "tablebottomdata" : "tabledata"; - my $rightclass = ($i eq $lines || $record{sequence} eq $total) ? - "tablebottomright" : "tablerightdata"; - $i++; - - print Tr [ - td {-class => $leftclass, - -align => "center"}, $record{sequence}, - td {-class => $dataclass, - -align => "center"}, - checkbox ({-name => "action$record{sequence}", - -label => ""}), - td {-class => $dataclass, - -align => "right"}, $record{pattern}, - td {-class => $dataclass, - -align => "center"}, "\@", - td {-class => $dataclass, - -align => "left"}, $record{domain}, - td {-class => $rightclass, - -align => "left"}, $record{comment} - ]; - } # foreach - print end_table; - print end_form; - - print div ({-align => "center"}, - a ({-href => "/maps/bin/exportlist.cgi?type=$type"}, - submit ({-name => "export", - -value => "Export List"})), - a ({-href => "/maps/bin/importlist.cgi?type=$type"}, - submit ({-name => "import", - -value => "Import List"}))); - - return; -} # Body - -# Main -my @scripts = ("ListActions.js"); - -$userid = Heading ( - "getcookie", - "", - "Manage $Type List", - "Manage $Type List", - "", - $table_name, - @scripts -); - -SetContext $userid; -NavigationBar $userid; - -if (!defined $lines) { - my %options = GetUserOptions $userid; - $lines = $options{"Page"}; -} # if - -$total = MAPSDB::count "list", "userid = \"$userid\" and type = \"$type\"";; - -$next = !defined $next ? 0 : $next; -$last = $next + $lines < $total ? $next + $lines : $total; - -if (($next - $lines) > 0) { - $prev = $next - $lines; -} else { - $prev = $next == 0 ? -1 : 0; -} # if - -Body $type; -Footing $table_name; - -exit; diff --git a/maps/bin/main.cgi b/maps/bin/main.cgi deleted file mode 100755 index d54a8b6..0000000 --- a/maps/bin/main.cgi +++ /dev/null @@ -1,109 +0,0 @@ -#!/usr/bin/perl -################################################################################ -# -# File: $RCSfile: main.cgi,v $ -# Revision: $Revision: 1.1 $ -# Description: This is the main or home page for maps. It is presented when the -# user logs in. -# Author: Andrew@DeFaria.com -# Created: Fri Nov 29 14:17:21 2002 -# Modified: $Date: 2013/06/12 14:05:47 $ -# Language: perl -# -# (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved. -# -################################################################################ -use strict; -use warnings; - -use FindBin; -$0 = $FindBin::Script; - -use lib $FindBin::Bin; - -use MAPS; -use MAPSLog; -use MAPSUtil; -use MAPSWeb; - -use CGI qw (:standard *table start_Tr end_Tr start_div end_div); -use CGI::Carp "fatalsToBrowser"; - -my $new_userid = param ("userid"); -my $password = param ("password"); - -sub Body { - print - h3 ("Welcome to MAPS!"), - p "This is the main or home page of MAPS. To the left - you see a menu of choices that you can use to explore MAPS - functionality.", - a ({-href => "/maps/bin/stats.cgi"}, - "Statistics"), - "gives you a view of the spam that MAPS has been trapping for you - in tabular format. You can use", - a ({-href => "/maps/bin/editprofile.cgi"}, - "Edit Profile"), - "to change your profile information or to change your password."; - print - p "MAPS also offers a series of web based", - a ({-href => "/maps/Reports.html"}, - "Reports"), - "to analyze your mail flow. You can manage your", - a ({-href => "/maps/bin/list.cgi?type=white"}, - "White") . ",", - a ({-href => "/maps/bin/list.cgi?type=black"}, - "Black"), "and", - a ({-href => "/maps/bin/list.cgi?type=null"}, - "Null"), - "lists although MAPS seeks to put that responsibility on those - who wish to email you. You can use this to pre-register somebody - or to black or null list somebody. You can also import/export - your lists through these pages."; - print - p a ({-href => "/maps/Admin.html"}, - "MAPS Administration"), - "is to administer MAPS itself and is only available to MAPS - Administrators."; - print - p "Also on the left you will see ", i ("Today's Activity"), - "which quickly shows you what mail MAPS processed today for you."; -} # Body - -# Main -my $action; - -if (defined $new_userid) { - my $result = Login $new_userid, $password; - - if ($result == -1) { - if ($new_userid eq "") { - print redirect ("/maps/?errormsg=Please specify a username"); - exit $result; - } else { - print redirect ("/maps/?errormsg=User \"$new_userid\" does not exist"); - exit $result; - } # if - } elsif ($result == -2) { - print redirect ("/maps/?errormsg=Invalid password"); - exit $result; - } else { - $action = "setcookie"; - } # if -} else { - $action = "getcookie" -} # if - -my $userid = Heading ( - $action, - $new_userid, - "Home", - "Spam Elimination System" -); - -SetContext $userid; -NavigationBar $userid; -Body; -Footing; - -exit; diff --git a/maps/bin/maps b/maps/bin/maps index de36ec9..4f960c4 100755 --- a/maps/bin/maps +++ b/maps/bin/maps @@ -60,7 +60,7 @@ use FindBin; use File::Temp qw (tempfile); use Net::Domain qw (hostdomain); -use lib $FindBin::Bin, '/opt/clearscm/lib'; +use lib "$FindBin::Bin/../lib", '/opt/clearscm/lib'; use MAPS; use MAPSLog; diff --git a/maps/bin/mapsscrub b/maps/bin/mapsscrub index 2f854b4..ab724eb 100755 --- a/maps/bin/mapsscrub +++ b/maps/bin/mapsscrub @@ -2,9 +2,9 @@ ################################################################################ # # File: $RCSfile: mapsscrub,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: This script scrubs messages from the MAPS database based on the -# users settings. +# users settings. # Author: Andrew@DeFaria.com # Created: Fri Nov 29 14:17:21 2002 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -18,17 +18,17 @@ use warnings; use FindBin; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSUtil; my $userid; -my $verbose = defined $ARGV[0] && $ARGV[0] eq "-v" ? 1 : 0; -my $total_emails = 0; -my $total_log_entries = 0; -my $total_list_entries = 0; -my $total_users_emails = 0; +my $verbose = defined $ARGV[0] && $ARGV[0] eq "-v" ? 1 : 0; +my $total_emails = 0; +my $total_log_entries = 0; +my $total_list_entries = 0; +my $total_users_emails = 0; my ($history, $nbr_emails, $nbr_log_entries, $nbr_list_entries, $users_emails); @@ -44,25 +44,28 @@ User ID Age Email Log List User's Emails ----------------- --- ------ ------ ------ ------------- . -sub verbose { - my $msg = shift; +sub verbose($) { + my ($msg) = @_; - return if $verbose eq 0; + return if $verbose == 0; print "$msg\n"; } # verbose -sub CleanUp { - my $userid = shift; +sub CleanUp($) { + my ($userid) = @_; + + my %options = GetUserOptions($userid); - my %options = GetUserOptions $userid; $history = $options{"History"}; - my $timestamp = SubtractDays (Today2SQLDatetime, $history); - $nbr_emails = CleanEmail $timestamp; - $nbr_log_entries = CleanLog $timestamp; - $nbr_list_entries = CleanList $timestamp, "null"; - $users_emails = MAPSDB::count ("email", "userid = \"$userid\""); + my $timestamp = SubtractDays(Today2SQLDatetime, $history); + + $nbr_emails = CleanEmail $timestamp; + $nbr_log_entries = CleanLog $timestamp; + $nbr_list_entries = CleanList $timestamp, "null"; + $users_emails = count("email", "userid = \"$userid\""); + write () if $verbose; return ($nbr_emails, $nbr_log_entries, $nbr_list_entries, $users_emails); @@ -73,26 +76,29 @@ my $handle = FindUser; #$~ = "REPORT" if $verbose; -while (($userid) = GetUser $handle) { - last if !defined $userid; - SetContext $userid; - my ($emails, $log_entries, $list_entries, $users_emails) = CleanUp $userid; - $total_emails += $emails; - $total_log_entries += $log_entries; - $total_list_entries += $list_entries; - $total_users_emails += $users_emails; +while (($userid) = GetUser($handle)) { + last unless $userid; + + SetContext($userid); + + my ($emails, $log_entries, $list_entries, $users_emails) = CleanUp($userid); + + $total_emails += $emails; + $total_log_entries += $log_entries; + $total_list_entries += $list_entries; + $total_users_emails += $users_emails; } # while $handle->finish; if ($verbose) { - $userid = "Total:"; - $history = "n/a"; - $nbr_emails = $total_emails; - $nbr_log_entries = $total_log_entries; - $nbr_list_entries = $total_list_entries; - $users_emails = $total_users_emails; - write (); + $userid = "Total:"; + $history = "n/a"; + $nbr_emails = $total_emails; + $nbr_log_entries = $total_log_entries; + $nbr_list_entries = $total_list_entries; + $users_emails = $total_users_emails; + write(); } # if # Now optimize the database diff --git a/maps/bin/mapsutil b/maps/bin/mapsutil.pl similarity index 65% rename from maps/bin/mapsutil rename to maps/bin/mapsutil.pl index fd623a3..cb608ac 100755 --- a/maps/bin/mapsutil +++ b/maps/bin/mapsutil.pl @@ -1,9 +1,9 @@ #!/usr/bin/perl -################################################################################# +################################################################################ # File: $RCSfile: mapsutil,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: This script implements a small command interpreter to exercise -# MAPS functions. +# MAPS functions. # Author: Andrew@DeFaria.com # Created: Fri Nov 29 14:17:21 2002 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -11,64 +11,68 @@ # # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved. # -################################################################################use strict; +################################################################################ +use strict; use warnings; use FindBin; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; + use Term::ReadLine; use Term::ReadLine::Gnu; use Term::ReadKey; -sub EncryptPassword { - my $password = shift; - my $userid = shift; +my $maps_username; + +sub EncryptPassword($$) { + my ($password, $userid) = @_; my $encrypted_password = Encrypt $password, $userid; print "Password: $password = $encrypted_password\n"; + + return; } # EncryptPassword -sub DecryptPassword { - my $password = shift; - my $userid = shift; +sub DecryptPassword($$) { + my ($password, $userid) = @_; - my $decrypted_password = Decrypt $password, $userid; + my $decrypted_password = Decrypt($password, $userid); print "Password: $password = $decrypted_password\n"; + + return; } # DecryptPassword -sub Resequence { - my $userid = shift; - my $type = shift; +sub Resequence($$) { + my ($userid, $type) = @_; - ResequenceList $userid, $type; + MAPS::ResequenceList($userid, $type); } # Resequence -sub GetPassword { +sub GetPassword() { print "Password:"; ReadMode "noecho"; - my $password = ReadLine (0); + my $password = ReadLine(0); chomp $password; print "\n"; ReadMode "normal"; - return $password + return $password; } # GetPassword -sub Login2MAPS { - my $username = shift; - my $password = shift; +sub Login2MAPS($;$) { + my ($username, $password) = @_; - if ($username ne "") { + if ($username ne '') { $password = GetPassword if !defined $password or $password eq ""; } # if - while (Login ($username, $password) != 0) { + while (Login($username, $password) != 0) { print "Login failed!\n"; print "Username:"; $username = <>; @@ -83,10 +87,10 @@ sub Login2MAPS { return $username; } # Login2MAPS -sub LoadListFile { +sub LoadListFile($) { # This function loads a ".list" file. This is to "import" our old ".list" # files. Note it assumes that the ".list" files have specific names. - my $listfilename = shift; + my ($listfilename) = @_; my $listtype; @@ -101,22 +105,24 @@ sub LoadListFile { return; } # if - if (!open LISTFILE, "<$listfilename") { + my $listfile; + + if (!open $listfile, '<', $listfilename) { print "Unable to open $listfilename\n"; return; } # if my $sequence = 0; - Info "Adding $listfilename to $listtype list"; + Info("Adding $listfilename to $listtype list"); - while () { + while ($listfile) { chomp; next if m/^#/ || m/^$/; my ($pattern, $comment) = split /\,/; - AddList $listtype, $pattern, 0, $comment; + AddList($listtype, $pattern, 0, $comment); $sequence++; } # while @@ -129,30 +135,32 @@ sub LoadListFile { } # if print "from $listfilename\n"; - close LISTFILE; + close $listfile; } # LoadListFile -sub LoadEmail { +sub LoadEmail($) { # This function loads an mbox file. - my $file = shift; + my ($filename) = @_; + + my $file; - if (!open FILE, "<$file") { - print "Unable to open \"$file\" - $!\n"; + if (!open $file, '<', $filename) { + print "Unable to open \"$filename\" - $!\n"; return; } # if - binmode FILE; + binmode $file; my $nbr_msgs; - while (! eof FILE) { - my ($sender, $reply_to, $subject, $data) = ReadMsg (*FILE); + while (!eof $file) { + my ($sender, $reply_to, $subject, $data) = ReadMsg (*$file); $nbr_msgs++; - AddEmail $sender, $subject, $data; + AddEmail($sender, $subject, $data); - Info "Added message from $sender to email"; + Info("Added message from $sender to email"); } # while if ($nbr_msgs == 0) { @@ -165,50 +173,53 @@ sub LoadEmail { print "from $file\n"; } # LoadEmail -sub DumpEmail { +sub DumpEmail($) { # This function unloads email to a mbox file. - my $file = shift; + my ($filename) = @_; + + my $file; - if (!open FILE, ">$file") { - print "Unable to open \"$file\" - $!\n"; + if (!open $file, '>', $filename) { + print "Unable to open \"$filename\" - $!\n"; return; } # if - binmode FILE; + binmode $file; - my $i = 0; + my $i = 0; my $handle = FindEmail; + my ($userid, $sender, $subject, $timestamp, $message); - while (($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle) { - print FILE $message; + while (($userid, $sender, $subject, $timestamp, $message) = GetEmail($handle)) { + print $file $message; $i++; } # while print "$i messages dumped to $file\n"; - close FILE; + close $file; } # DumpEmail -sub SwitchUser { - my $new_user = shift; +sub SwitchUser($) { + my ($new_user) = @_; - if ($new_user = Login2MAPS $new_user) { + if ($new_user = Login2MAPS($new_user)) { print "You are now logged in as $new_user\n"; } # if } # SwitchContext -sub ShowSpace { - my $detail = shift; +sub ShowSpace($) { + my ($detail) = @_; my $userid = GetContext; - if (defined $detail) { - my %msg_space = MAPS::Space $userid; + if ($detail) { + my %msg_space = Space($userid); - foreach (sort (keys (%msg_space))) { - my $sender = $_; - my $size = $msg_space {$_}; + for (sort (keys (%msg_space))) { + my $sender = $_; + my $size = $msg_space{$_}; format PER_MSG= @######### @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $size,$sender @@ -217,8 +228,10 @@ $~ = "PER_MSG"; write (); } # foreach } else { - my $total_space = MAPS::Space $userid; + my $total_space = Space($userid); + $total_space = $total_space / (1024 * 1024); + format TOTALSIZE= Total size @###.### Meg $total_space @@ -228,12 +241,12 @@ $~ = "TOTALSIZE"; } # if } # ShowSpace -sub ShowUser { - print "Current userid is " . GetContext () . "\n"; +sub ShowUser() { + print "Current userid is " . GetContext() . "\n"; } # ShowContext -sub ShowUsers { - my $handle = FindUser; +sub ShowUsers() { + my ($handle) = FindUser; my ($userid, $name, $email); @@ -242,16 +255,16 @@ User ID: @<<<<<<<<< Name: @<<<<<<<<<<<<<<<<<<< Email: @<<<<<<<<<<<<<<<<<<<<<<< $userid,$name,$email . $~ = "USERLIST"; - while (($userid, $name, $email) = GetUser $handle) { + while (($userid, $name, $email) = GetUser($handle)) { last if ! defined $userid; - write (); + write(); } # while $handle->finish; } # ShowUsers -sub ShowEmail { - my $handle = FindEmail; +sub ShowEmail() { + my ($handle) = FindEmail; my ($userid, $sender, $subject, $timestamp, $message); @@ -260,20 +273,20 @@ format EMAIL = $timestamp,$sender,$subject . $~ = "EMAIL"; - while (($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle) { - last if ! defined $userid; - write (); + while (($userid, $sender, $subject, $timestamp, $message) = GetEmail($handle)) { + last unless $userid; + write(); } # while $handle->finish; } # ShowEmail -sub ShowLog { - my $how_many = shift; +sub ShowLog($) { + my ($how_many) = @_; $how_many = defined $how_many ? $how_many : -20; - my $handle = FindLog $how_many; + my $handle = FindLog($how_many); my ($userid, $timestamp, $sender, $type, $message); @@ -283,15 +296,15 @@ $timestamp,$type,$sender,$message . $~ = "LOG"; while (($userid, $timestamp, $sender, $type, $message) = GetLog $handle) { - last if ! defined $userid; - write (); + last unless $userid; + write(); } # while $handle->finish; } # ShowLog -sub ShowList { - my $type = shift; +sub ShowList($) { + my ($type) = @_; my $lines = 10; my $next = 0; @@ -304,85 +317,88 @@ $record{sequence},$record{pattern},$record{domain},$record{comment} . $~ = "LIST"; - while (@list = ReturnList $type, $next, $lines) { - foreach (@list) { + while (@list = ReturnList($type, $next, $lines)) { + for (@list) { %record = %{$_}; - write (); - } # foreach + write(); + } # for print "Hit any key to continue"; ReadLine (0); $next += $lines; } # while } # ShowList -sub ShowStats { - my $nbr_days = shift; +sub ShowStats($) { + my ($nbr_days) = @_; - $nbr_days = 1 if !defined $nbr_days; + $nbr_days ||= 1; - my %dates = GetStats $nbr_days; + my %dates = GetStats($nbr_days); - foreach my $date (keys (%dates)) { - foreach (keys (%{$dates{$date}})) { + for my $date (keys(%dates)) { + for (keys(%{$dates{$date}})) { print "$date $_:"; - print "\t$dates{$date}{$_}\n"; - } # foreach - } # foreach + print "\t$dates{$date}{$_}\n"; + } # for + } # for } # ShowStats -sub Deliver { - my $file = shift; +sub Deliver($) { + my ($filename) = @_; + + my $message; - if (!open MESSAGE, "<$file") { - print "Unable to open message file $file\n"; + if (!open $message, '<', $filename) { + print "Unable to open message file $filename\n"; return; } # if my $data; - while () { + + while ($message) { $data = $data . $_; } # while Whitelist "Andrew\@DeFaria.com", $data; + + close $message; + + return; } # Deliver -sub ParseCommand { - # Crude parser... - my $cmd = shift; - my $parm1 = shift; - my $parm2 = shift; - my $parm3 = shift; - my $parm4 = shift; +sub ParseCommand($$$$$){ + my ($cmd, $parm1, $parm2, $parm3,$parm4) = @_; + + $_ = $cmd . ' '; - $_ = $cmd . " "; SWITCH: { /^$/ && do { last SWITCH }; /^resequence / && do { - Resequence GetContext (), $parm1; + Resequence(GetContext(), $parm1); last SWITCH }; /^encrypt / && do { - EncryptPassword $parm1, $parm2; + EncryptPassword($parm1, $parm2); last SWITCH }; /^decrypt / && do { - my $password = UserExists (GetContext()); - DecryptPassword $password; + my $password = UserExists(GetContext()); + DecryptPassword($password, $maps_username); last SWITCH }; /^deliver / && do { - Deliver $parm1; + Deliver($parm1); last SWITCH }; /^add2whitelist / && do { - Add2Whitelist $parm1, GetContext (), $parm2; + Add2Whitelist($parm1, GetContext(), $parm2); last SWITCH }; @@ -392,56 +408,56 @@ sub ParseCommand { }; /^adduser / && do { - AddUser $parm1, $parm2, $parm3, $parm4; + AddUser($parm1, $parm2, $parm3, $parm4); last SWITCH; }; /^cleanemail / && do { - if ($parm1 eq "") { - $parm1 = "9999-12-31 23:59:59"; + if ($parm1 eq '') { + $parm1 = "9999-12-31 23:59:59"; } # if - my $nbr_entries = CleanEmail $parm1; + my $nbr_entries = CleanEmail($parm1); print "$nbr_entries email entries cleaned\n"; last SWITCH; }; /^deleteemail / && do { - my $nbr_entries = DeleteEmail $parm1; + my $nbr_entries = DeleteEmail($parm1); print "$nbr_entries email entries deleted\n"; last SWITCH; }; /^cleanlog / && do { - if ($parm1 eq "") { + if ($parm1 eq '') { $parm1 = "9999-12-31 23:59:59"; } # if - my $nbr_entries = CleanLog $parm1; + my $nbr_entries = CleanLog($parm1); print "$nbr_entries log entries cleaned\n"; last SWITCH; }; /^loadlist / && do { - LoadListFile $parm1; + LoadListFile($parm1); last SWITCH; }; /^loademail / && do { - LoadEmail $parm1; + LoadEmail($parm1); last SWITCH; }; /^dumpemail / && do { - DumpEmail $parm1; + DumpEmail($parm1); last SWITCH; }; /^log / && do { - Logmsg "info", "$parm1 $parm2", $parm3; + Logmsg("info", "$parm1 $parm2", $parm3); last SWITCH; }; /^switchuser / && do { - SwitchUser $parm1; + SwitchUser($parm1); last SWITCH; }; @@ -456,22 +472,22 @@ sub ParseCommand { }; /^showlog / && do { - ShowLog $parm1; + ShowLog($parm1); last SWITCH }; /^showlist / && do { - ShowList $parm1; + ShowList($parm1); last SWITCH }; /^space / && do { - ShowSpace $parm1; + ShowSpace($parm1); last SWITCH }; /^showstats / && do { - ShowStats $parm1; + ShowStats($parm1); last SWITCH }; @@ -504,27 +520,20 @@ sub ParseCommand { print "Unknown command: $_"; - print " ($parm1" if defined $parm1; - print ", $parm2" if defined $parm2; - print ", $parm3" if defined $parm3; - print ", $parm4" if defined $parm4; - - if (defined $parm1) { - print ")\n"; - } else { - print "\n"; - } # if + print " ($parm1" if $parm1; + print ", $parm2" if $parm2; + print ", $parm3" if $parm3; + print ", $parm4" if $parm4; + print ")\n"; } # SWITCH } # ParseCommand -sub GetOpts { -} # GetOpts +$maps_username = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER}; -my $maps_username = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER}; -my $username = Login2MAPS $maps_username, $ENV{MAPS_PASSWORD}; +my $username = Login2MAPS($maps_username, $ENV{MAPS_PASSWORD}); -if (defined $ARGV [0]) { - ParseCommand $ARGV [0], $ARGV [1], $ARGV [2], $ARGV [3]; +if ($ARGV[0]) { + ParseCommand($ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4]); exit; } # if @@ -534,15 +543,15 @@ my $term = new Term::ReadLine 'mapsutil'; while (1) { $_ = $term->readline ("MAPSUtil:"); - last if !defined $_; + last unless $_; my ($cmd, $parm1, $parm2, $parm3, $parm4) = split; last if ($cmd =~ /exit/i || $cmd =~ /quit/i); - ParseCommand $cmd, $parm1, $parm2, $parm3, $parm4 if defined $cmd; + ParseCommand($cmd, $parm1, $parm2, $parm3, $parm4) if defined $cmd; } # while -print "\n" if !defined $_; +print "\n" unless $_; exit; diff --git a/maps/bin/modifyentries.cgi b/maps/bin/modifyentries.cgi index b2624a1..4c58984 100755 --- a/maps/bin/modifyentries.cgi +++ b/maps/bin/modifyentries.cgi @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; @@ -27,9 +27,9 @@ use MAPSWeb; use CGI qw/:standard/; use CGI::Carp 'fatalsToBrowser'; -my $userid = cookie ('MAPSUser'); -my $type = param ('type'); -my $next = param ('next'); +my $userid = cookie('MAPSUser'); +my $type = param('type'); +my $next = param('next'); $userid ||= $ENV{USER}; @@ -37,11 +37,11 @@ sub ReturnSequenceNbrs { my @names = param; my @sequence_nbrs; - foreach (@names) { + for (@names) { if (/pattern(\d+)/) { push @sequence_nbrs, $1; } # if - } # foreach + } # for return @sequence_nbrs; } # ReturnSequenceNbrs @@ -50,16 +50,17 @@ sub ReturnSequenceNbrs { my $i = 0; foreach (ReturnSequenceNbrs) { - UpdateList + UpdateList( $userid, $type, - param ("pattern$_"), - param ("domain$_"), - param ("comment$_"), - param ("hit_count$_"), - $_; + param("pattern$_"), + param("domain$_"), + param("comment$_"), + param("hit_count$_"), + $_, + ); $i++; -} # foreach +} # for if ($i eq 0) { print redirect ("/maps/php/list.php?type=$type&next=$next&message=Unable to update entries"); diff --git a/maps/bin/processaction.cgi b/maps/bin/processaction.cgi index f5ef9c6..c9f0f58 100755 --- a/maps/bin/processaction.cgi +++ b/maps/bin/processaction.cgi @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSWeb; @@ -40,11 +40,11 @@ sub ReturnSequenceNbrs { my @names = param; my @sequence_nbrs; - foreach (@names) { + for (@names) { if (/action(\d+)/) { push @sequence_nbrs, $1; } # if - } # foreach + } # for return @sequence_nbrs; } # ReturnSequenceNbrs @@ -57,13 +57,13 @@ sub DeleteEntries { my $count; foreach (@sequence_nbrs) { - $count += DeleteList $type, $_; + $count += DeleteList($type, $_); } # foreach if ($count == 0) { - DisplayError 'Nothing to delete!'; + DisplayError('Nothing to delete!'); } else { - ResequenceList $userid, $type; + ResequenceList($userid, $type); if ($count == 1) { print redirect ("/maps/php/list.php?type=$type&next=$next&message=Deleted entry"); @@ -89,7 +89,7 @@ sub PrintInputLine ($$$$$) { ($pattern, $domain) = split /\@/, $email; } # if - $hit_count = CountMsg $email; + $hit_count = CountMsg($email); } # if print Tr [ @@ -142,7 +142,7 @@ sub AddNewEntry { # empty, editable entries (possibly filled in) for the user to add # the new entry my $selected = @selected; - my $nextseq = MAPSDB::GetNextSequenceNo $userid, $type; + my $nextseq = GetNextSequenceNo($userid, $type); my $next = ($nextseq - $lines) + $selected - 1; $next = 0 @@ -150,7 +150,7 @@ sub AddNewEntry { my $Type = ucfirst $type; - Heading ( + Heading( 'getcookie', '', "Add to $Type List", @@ -160,7 +160,7 @@ sub AddNewEntry { @scripts ); - NavigationBar $userid; + NavigationBar($userid); # Now display table and new entry print start_form { @@ -184,11 +184,11 @@ sub AddNewEntry { th {-class => 'tablerightend'}, 'Hit Count' ]; - my @list = ReturnList $type, $next, $lines; + my @list = ReturnList($type, $next, $lines); my %record; my $i = 1; - foreach (@list) { + for (@list) { $i++; %record = %{$_}; @@ -214,20 +214,20 @@ sub AddNewEntry { td {-class => 'tablerightdata', -align => 'right'}, $hit_count, ]; - } # foreach + } # for # Now the input line(s) if (@selected == 0) { - PrintInputLine $nextseq, undef, 'tablebottomleft', 'tablebottomdata', - 'tablebottomright'; + PrintInputLine($nextseq, undef, 'tablebottomleft', 'tablebottomdata', + 'tablebottomright'); } else { - foreach (@selected) { + for (@selected) { my $leftclass = $i == $lines ? 'tablebottomleft' : 'tableleftdata'; my $dataclass = $i == $lines ? 'tablebottomdata' : 'tabledata'; my $rightclass = $i == $lines ? 'tablebottomright' : 'tablerightdata'; $i++; - PrintInputLine $nextseq++, $_, $leftclass, $dataclass, $rightclass; - } # foreach + PrintInputLine($nextseq++, $_, $leftclass, $dataclass, $rightclass); + } # for } # for print end_table; @@ -252,7 +252,7 @@ sub ModifyEntries { my $Type = ucfirst $type; - Heading ( + Heading( 'getcookie', '', "Modify $Type List", @@ -262,7 +262,7 @@ sub ModifyEntries { @scripts ); - NavigationBar $userid; + NavigationBar($userid); # Redisplay the page but open up the lines that are getting modified print start_form { @@ -293,20 +293,26 @@ sub ModifyEntries { th {-class => 'tablerightend'}, 'Hit Count', ]; - my @list = ReturnList $type, $next, $lines; + # Corner case: If on the first page (i.e. $next=0) then being zero based, we + # will actually get 21 entries in @list (i.e. $next=0, $lines=20 - 21 $entries + # are retrieved). So in that case, and that case only, we will change $lines + # to $lines - 1. + --$lines if $next == 0; + + my @list = ReturnList($type, $next, $lines); my %record; my $s = 0; my $i = 1; - foreach (@list) { + for (@list) { %record = %{$_}; my $sequence = $record{sequence}; - my $leftclass = ($i eq $lines || $sequence eq $total) ? + my $leftclass = ($i == @list || $sequence eq $total) ? 'tablebottomleft' : 'tableleftdata'; - my $dataclass = ($i eq $lines || $sequence eq $total) ? + my $dataclass = ($i == @list || $sequence eq $total) ? 'tablebottomdata' : 'tabledata'; - my $rightclass = ($i eq $lines || $sequence eq $total) ? + my $rightclass = ($i == @list || $sequence eq $total) ? 'tablebottomright' : 'tablerightdata'; $i++; @@ -324,8 +330,8 @@ sub ModifyEntries { my $hit_count = $record{hit_count} ? $record{hit_count} : ''; print - td {-class => $dataclass, - -align => 'right'}, + td {-class => $dataclass, + -align => 'right'}, (textfield {-class => 'inputfield', -style => 'width:100%', -align => 'right', @@ -333,9 +339,9 @@ sub ModifyEntries { -maxlength => '255', -name => "pattern$sequence", -value => $pattern}), - td {-class => $dataclass, - -align => 'center'}, '@', - td {-class => $dataclass}, + td {-class => $dataclass, + -align => 'center'}, '@', + td {-class => $dataclass}, (textfield {-class => 'inputfield', -style => 'width:100%', -align => 'left', @@ -343,15 +349,15 @@ sub ModifyEntries { -maxlength => '255', -name => "domain$sequence", -value => $domain}), - td {-class => $dataclass}, - (textfield {-class => 'inputfield', - -style => 'width:100%', - -align => 'left', - -size => 25, - -maxlength => '255', - -name => "comment$sequence", - -value => $comment}), - td {-class => $rightclass}, + td {-class => $dataclass}, + (textfield {-class => 'inputfield', + -style => 'width:100%', + -align => 'left', + -size => 25, + -maxlength => '255', + -name => "comment$sequence", + -value => $comment}), + td {-class => $rightclass}, (textfield {-class => 'inputfield', -style => 'width:100%', -align => 'left', @@ -380,7 +386,7 @@ sub ModifyEntries { } # if print end_Tr; - } # foreach + } # for print end_table; print br, @@ -398,35 +404,34 @@ sub ModifyEntries { } # ModifyEntries sub WhitelistMarked { - AddNewEntry 'white', ReturnSequenceNbrs; + AddNewEntry('white', ReturnSequenceNbrs); } # WhitelistMarked sub BlacklistMarked { - AddNewEntry 'black', ReturnSequenceNbrs; + AddNewEntry('black', ReturnSequenceNbrs); } # BlacklistMarked sub NulllistMarked { - AddNewEntry 'null', ReturnSequenceNbrs; + AddNewEntry('null', ReturnSequenceNbrs); } # NulllistMarked # Main $userid ||= $ENV{USER}; -SetContext $userid; +SetContext($userid); -my %options = GetUserOptions $userid; +my %options = GetUserOptions($userid); $lines = $options{'Page'}; -$total = MAPSDB::count 'list', "userid = \"$userid\" and type = \"$type\"" - if $type; +$total = count('list', "userid = \"$userid\" and type = \"$type\"") if $type; if ($action eq 'Add New Entry') { - AddNewEntry $type; + AddNewEntry($type); } elsif ($action eq 'Delete Marked') { - DeleteEntries $type; + DeleteEntries($type); } elsif ($action eq 'Modify Marked') { - ModifyEntries $type; + ModifyEntries($type); } elsif ($action eq 'Whitelist Marked') { WhitelistMarked; } elsif ($action eq 'Blacklist Marked') { @@ -434,17 +439,17 @@ if ($action eq 'Add New Entry') { } elsif ($action eq 'Nulllist Marked') { NulllistMarked; } else { - Heading ( + Heading( 'getcookie', '', "Unknown action ($action)", "Unknown action ($action)" ); - NavigationBar $userid; - DisplayError "Unknown action encountered ($action)"; + NavigationBar($userid); + DisplayError("Unknown action encountered ($action)"); } # if -Footing $table_name; +Footing($table_name); exit; diff --git a/maps/bin/register.cgi b/maps/bin/register.cgi index 63975b4..b97efae 100755 --- a/maps/bin/register.cgi +++ b/maps/bin/register.cgi @@ -2,7 +2,7 @@ ################################################################################ # # File: $RCSfile: register.cgi,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: Register a MAPS user # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; @@ -26,20 +26,21 @@ use MAPSWeb; use CGI qw/:standard/; -my $fullname = param ("fullname"); -my $sender = lc (param ("sender")); -my $userid = param ("userid"); +my $fullname = param("fullname"); +my $sender = lc(param("sender")); +my $userid = param("userid"); -sub MyFooting { - print div ({-align => "center"}, - button (-name => "close", - -value => "Close Window", - -onClick => "window.close ()")); +sub MyFooting() { + print div({-align => "center"}, + button (-name => "close", + -value => "Close Window", + -onClick => "window.close ()") + ); print end_html; } # MyFooting -sub MyError { - my $errmsg = shift; +sub MyError($) { + my ($errmsg) = @_; print h3 ({-class => "error", -align => "center"}, "ERROR: " . $errmsg); @@ -49,33 +50,33 @@ sub MyError { exit 1; } # MyError -sub MyHeading { +sub MyHeading() { print - header (-title => "MAPS Registration"), - start_html (-title => "MAPS Registration", - -author => "Andrew\@DeFaria.com", - -style => {-src => "/maps/css/MAPSPlain.css"}); + header(-title => "MAPS Registration"), + start_html(-title => "MAPS Registration", + -author => "Andrew\@DeFaria.com", + -style => {-src => "/maps/css/MAPSPlain.css"} + ); print - h2 ({-class => "header", - -align => "center"}, + h2 ({-class => "header", + -align => "center"}, font ({-class => "standout"}, - "MAPS"), "Registration Results"); + "MAPS"), "Registration Results" + ); } # MyHeading # Main MyHeading; -if ($sender eq "") { - MyError "Sender not specified!"; -} +MyError("Sender not specified!") if $sender eq ''; -my $rule; +my ($status, $rule) = OnWhitelist($sender, $userid, 0); -if (OnWhitelist $sender, $userid) { - MyError "The email address $sender is already on ${userid}'s list" +if ($status) { + MyError("The email address $sender is already on ${userid}'s list)"); } # if -my $messages = Add2Whitelist $sender, $userid, $fullname; +my $messages = Add2Whitelist($sender, $userid, $fullname); print p "$fullname, your email address, $sender, has been added to ${userid}'s white list."; diff --git a/maps/bin/registerform.cgi b/maps/bin/registerform.cgi index eb762c6..03f2c5a 100755 --- a/maps/bin/registerform.cgi +++ b/maps/bin/registerform.cgi @@ -2,8 +2,8 @@ ################################################################################ # # File: $RCSfile: registerform.cgi,v $ -# Revision: $Revision: 1.1 $ -# Description: Register a MAPS user +# Revision: $Revision: 1.1 $ +# Description: Register a MAPS user # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -20,89 +20,91 @@ $0 = $FindBin::Script; use CGI qw/:standard *table start_div end_div/; +use lib "$FindBin::Bin/../lib"; + use MAPS; use MAPSWeb; -my $userid = param ("userid"); -my $Userid = ucfirst $userid; -my $sender = param ("sender"); -my $errormsg = param ("errormsg"); +my $userid = param ('userid'); +my $Userid = ucfirst $userid; +my $sender = param ('sender'); +my $errormsg = param ('errormsg'); -sub Heading { +sub MyHeading { print - header (-title => "MAPS Registration"), + header (-title => "MAPS Registration"), start_html (-title => "MAPS Registration", - -author => "Andrew\@DeFaria.com", - -style => {-src => "/maps/css/MAPSPlain.css"}, - -script => [{ -language => "JavaScript1.2", - -src => "/maps/JavaScript/MAPSUtils.js"}, - { -language => "JavaScript1.2", - -src => "/maps/JavaScript/CheckRegistration.js"} - ]); + -author => "Andrew\@DeFaria.com", + -style => {-src => "/maps/css/MAPSPlain.css"}, + -script => [{ -language => "JavaScript1.2", + -src => "/maps/JavaScript/MAPSUtils.js"}, + { -language => "JavaScript1.2", + -src => "/maps/JavaScript/CheckRegistration.js"} + ]); print h2 ({-class => "header", -align => "center"}, font ({-class => "standout"}, "MAPS"), "Mail Authorization and Permission System"); - if (defined $errormsg) { + if ($errormsg) { DisplayError $errormsg; exit; } # if -} # Heading +} # MyHeading sub Body { print start_div {-class => "content"}; print p ("${Userid}'s email is protected by MAPS, a spam elimination - system. In order to email $Userid you must register. You need - only register once to be added to ${Userid}'s white list, - thereafter you should have no problems emailing them. This is not - unlike the acceptance procedure for many instant messaging clients."); + system. In order to email $Userid you must register. You need + only register once to be added to ${Userid}'s white list, + thereafter you should have no problems emailing them. This is not + unlike the acceptance procedure for many instant messaging clients."); print p ("Please enter your full name and click on Register to complete the - registration."); + registration."); print start_form { - -method => "post", - -action => "register.cgi", - -onSubmit => "return validate (this);" + -method => "post", + -action => "register.cgi", + -onSubmit => "return validate (this);" }; print start_table { - -cellpadding => 2, - -cellspacing => 0, - -border => 0, - -align => "center", - -width => "360" + -cellpadding => 2, + -cellspacing => 0, + -border => 0, + -align => "center", + -width => "360" }; - print hidden (-name => "userid", - -value => "$userid"); + print hidden (-name => "userid", + -value => "$userid"); print Tr [ td ({-class => "header"}, "Full name:") . - td (textfield {-class => "inputfield", - -size => 50, - -name => "fullname"}) + td (textfield {-class => "inputfield", + -size => 50, + -name => "fullname"}) ]; - print hidden (-name => "sender", - -value => "$userid"); + print hidden (-name => "sender", + -value => "$userid"); print end_table; - print p {-align => "center"}, - submit (-name => "submit", - -value => "Register"); + print p {-align => "center"}, + submit (-name => "submit", + -value => "Register"); print end_form; print p ("Tired of dealing with unsolicited email (AKA SPAM)? Want to know - more about MAPS, the Mail Authorization and Permission System for - eliminating SPAM? Click", - a ({-href => "/maps/", - -target => "_blank"}, - "here"), - "to find out more."); + more about MAPS, the Mail Authorization and Permission System for + eliminating SPAM? Click", + a ({-href => "/maps/", + -target => "_blank"}, + "here"), + "to find out more."); print start_table { - -cellpadding => 2, - -cellspacing => 0, - -border => 1, - -align => "center", - -width => "50%" + -cellpadding => 2, + -cellspacing => 0, + -border => 1, + -align => "center", + -width => "50%" }; print Tr [ td ({-class => "note", - -align => "center"}, "Note") + -align => "center"}, "Note") ]; print Tr [ td ({-class => "notetext"}, @@ -114,7 +116,7 @@ sub Body { print end_div; } # Body -if (!defined $userid) { +if (!$userid) { $errormsg = "Internal error: Userid not specified"; } else { if (!UserExists ($userid)) { @@ -122,6 +124,6 @@ if (!defined $userid) { } # if } -Heading; +MyHeading; Body; Footing; diff --git a/maps/bin/search.cgi b/maps/bin/search.cgi index 2584f39..f7de688 100755 --- a/maps/bin/search.cgi +++ b/maps/bin/search.cgi @@ -2,8 +2,8 @@ ################################################################################ # # File: $RCSfile: search.cgi,v $ -# Revision: $Revision: 1.1 $ -# Description: Search by sender and subject +# Revision: $Revision: 1.1 $ +# Description: Search by sender and subject # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSWeb; @@ -26,14 +26,14 @@ use MAPSUtil; use CGI qw (:standard *table start_Tr start_td start_div end_Tr end_td end_div); use CGI::Carp "fatalsToBrowser"; -my $str = param ("str"); -my $next = param ("next"); -my $lines = param ("lines"); +my $str = param('str'); +my $next = param('next'); +my $lines = param('lines'); my $userid; my $prev; my $total; my $last; -my $table_name = "searchresults"; +my $table_name = 'searchresults'; sub MakeButtons { my $prev_button = $prev >= 0 ? @@ -46,18 +46,18 @@ sub MakeButtons { my $buttons = $prev_button; $buttons = $buttons . - submit ({-name => "action", - -value => "Whitelist Marked", - -onClick => "return CheckAtLeast1Checked (document.detail);"}) . - submit ({-name => "action", - -value => "Blacklist Marked", - -onClick => "return CheckAtLeast1Checked (document.detail);"}) . - submit ({-name => "action", - -value => "Nulllist Marked", - -onClick => "return CheckAtLeast1Checked (document.detail);"}) . - submit ({-name => "action", - -value => "Reset Marks", - -onClick => "return ClearAll (document.detail);"}); + submit ({-name => "action", + -value => "Whitelist Marked", + -onClick => "return CheckAtLeast1Checked (document.detail);"}) . + submit ({-name => "action", + -value => "Blacklist Marked", + -onClick => "return CheckAtLeast1Checked (document.detail);"}) . + submit ({-name => "action", + -value => "Nulllist Marked", + -onClick => "return CheckAtLeast1Checked (document.detail);"}) . + submit ({-name => "action", + -value => "Reset Marks", + -onClick => "return ClearAll (document.detail);"}); return $buttons . $next_button; } # MakeButtons @@ -82,25 +82,25 @@ sub Body { print div {-align => "center"}, b ( "(" . $current . "-" . $last . " of " . $total . ")"); print start_form { - -method => "post", - -action => "processaction.cgi", - -name => "detail" + -method => "post", + -action => "processaction.cgi", + -name => "detail" }; my $buttons = MakeButtons; - print div {-align => "center", - -class => "toolbar"}, $buttons; - print start_table ({-align => "center", - -id => $table_name, - -border => 0, - -cellspacing => 0, - -cellpadding => 0, - -width => "100%"}) . "\n"; + print div {-align => "center", + -class => "toolbar"}, $buttons; + print start_table ({-align => "center", + -id => $table_name, + -border => 0, + -cellspacing => 0, + -cellpadding => 0, + -width => "100%"}) . "\n"; print Tr [ th {-class => "tableleftend"}, - th {-class => "tableheader"}, "Sender", - th {-class => "tableheader"}, "Subject", - th {-class => "tablerightend"}, "Date" + th {-class => "tableheader"}, "Sender", + th {-class => "tableheader"}, "Subject", + th {-class => "tablerightend"}, "Date" ]; foreach (@emails) { @@ -116,17 +116,17 @@ sub Body { print Tr [ td {-class => "tableleftdata", - -align => "center"}, - (checkbox {-name => "action$next", - -label => ""}), - hidden ({-name => "email$next", - -default => $sender}), - td {-class => "sender"}, - a {-href => "mailto:$sender"}, $display_sender, - td {-class => "subject"}, - a {-href => "display.cgi?sender=$sender"}, $subject, - td {-class => "dateright", - -width => "115"}, SQLDatetime2UnixDatetime $date + -align => "center"}, + (checkbox {-name => "action$next", + -label => ""}), + hidden ({-name => "email$next", + -default => $sender}), + td {-class => "sender"}, + a {-href => "mailto:$sender"}, $display_sender, + td {-class => "subject"}, + a {-href => "display.cgi?sender=$sender"}, $subject, + td {-class => "dateright", + -width => "115"}, SQLDatetime2UnixDatetime $date ]; } # foreach print end_table; @@ -150,12 +150,12 @@ NavigationBar $userid; DisplayError "No search string specified" if !defined $str; -if (!defined $lines) { +if (!$lines) { my %options = GetUserOptions $userid; $lines = $options{"Page"}; } # if -$total = MAPSDB::count "email", +$total = count "email", "userid = \"$userid\" and (subject like \"%$str%\" or sender like \"%$str%\")"; DisplayError "Nothing matching!" if $total eq 0; diff --git a/maps/bin/signup.cgi b/maps/bin/signup.cgi index a429698..fb4541e 100755 --- a/maps/bin/signup.cgi +++ b/maps/bin/signup.cgi @@ -18,39 +18,39 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::New; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSWeb; use CGI qw (:standard); -my $userid = param ("userid"); -my $fullname = param ("fullname"); -my $email = param ("email"); -my $password = param ("password"); -my $repeated_password = param ("repeated_password"); -my $mapspop = param ("MAPSPOP"); -my $history = param ("history"); -my $days = param ("days"); -my $dates = param ("dates"); -my $tag_and_forward = param ("tag_and_forward"); +my $userid = param('userid'); +my $fullname = param('fullname'); +my $email = param('email'); +my $password = param('password'); +my $repeated_password = param('repeated_password'); +my $mapspop = param('MAPSPOP'); +my $history = param('history'); +my $days = param('days'); +my $dates = param('dates'); +my $tag_and_forward = param('tag_and_forward'); my $message; sub MyError { my $errmsg = shift; $userid = Heading ( - "getcookie", - "", - "Signup", - "Signup" + 'getcookie', + '', + 'Signup', + 'Signup' ); NavigationBar $userid; - print h2 {-align => "center", - -class => "error"}, "Error: " . $errmsg; + print h2 {-align => 'center', + -class => 'error'}, 'Error: ' . $errmsg; Footing; @@ -59,42 +59,42 @@ sub MyError { sub Body { # Check required fields - if ($userid eq "" ) { - MyError "You must specify a userid!"; + if ($userid eq '' ) { + MyError 'You must specify a userid!'; } # if - if ($email eq "" ) { - MyError "You must specify an email address!"; + if ($email eq '' ) { + MyError 'You must specify an email address!'; } # if - if ($password eq "") { - MyError "You must specify a password!"; + if ($password eq '') { + MyError 'You must specify a password!'; } # if - if ($fullname eq "") { - MyError "You must specify your full name!"; + if ($fullname eq '') { + MyError 'You must specify your full name!'; } # if # Password field checks if (length $password < 6) { - MyError "Password must be longer than 6 characters!"; + MyError 'Password must be longer than 6 characters!'; } # if if ($password ne $repeated_password) { - MyError "Passwords do not match"; + MyError 'Passwords do not match'; } # if - my $status = AddUser $userid, $fullname, $email, $password; + my $status = AddUser($userid, $fullname, $email, $password); if ($status ne 0) { - MyError "Username already exists"; + MyError 'Username already exists'; } # if my %options = ( - "MAPSPOP" => $mapspop, - "History" => $history, - "Page" => $days, - "Dates" => $dates, - "Tag&Forward" => $tag_and_forward + MAPSPOP => $mapspop, + History => $history, + Page => $days, + Dates => $dates, + 'Tag&Forward' => $tag_and_forward, ); - my $status = AddUserOptions $userid, %options; + my $status = AddUserOptions($userid, %options); if ($status == 0) { print redirect ("/maps/?errormsg=User account \"$userid\" created.
You may now login"); diff --git a/maps/bin/stats.cgi b/maps/bin/stats.cgi index 9964f4a..b68a5dd 100755 --- a/maps/bin/stats.cgi +++ b/maps/bin/stats.cgi @@ -2,9 +2,9 @@ ################################################################################ # # File: $RCSfile: stats.cgi,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: This script produces a table of statistics of mail processed for -# the user. +# the user. # Author: Andrew@DeFaria.com # Created: Fri Nov 29 14:17:21 2002 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -19,7 +19,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSLog; @@ -27,85 +27,85 @@ use MAPSUtil; use MAPSWeb; use CGI qw (:standard *table start_Tr end_Tr); -use CGI::Carp "fatalsToBrowser"; +use CGI::Carp 'fatalsToBrowser'; -my $nbr_days = param ("nbr_days"); -my $date = param ("date"); +my $nbr_days = param('nbr_days'); +my $date = param('date'); -my $table_name = "stats"; +my $table_name = 'stats'; $date = defined $date ? $date : Today2SQLDatetime; sub Body { - print start_table ({-align => "center", - -id => $table_name, - -border => 0, - -cellspacing => 0, - -cellpadding => 2, - -cols => 9, - -width => "100%"}); - print start_Tr {-valign => "bottom"}; - print th {-class => "tableleftend"}, "Date"; - - foreach (@Types) { - print th {-class => "tableheader"}, ucfirst; - } # foreach - - print th {-class => "tablerightend"}, "Total"; - - my %dates = GetStats $nbr_days, $date; + print start_table ({-align => 'center', + -id => $table_name, + -border => 0, + -cellspacing => 0, + -cellpadding => 2, + -cols => 9, + -width => '100%'}); + print start_Tr {-valign => 'bottom'}; + print th {-class => 'tableleftend'}, 'Date'; + + for (@Types) { + print th {-class => 'tableheader'}, ucfirst; + } # for + + print th {-class => 'tablerightend'}, 'Total'; + + my %dates = GetStats($nbr_days, $date); my %totals; - foreach my $date (sort {$b cmp $a} (keys (%dates))) { + for my $date (sort {$b cmp $a} (keys (%dates))) { print start_Tr; - print td {-class => "tablerightleftdata", - -align => "center"}, FormatDate $date; + print td {-class => 'tablerightleftdata', + -align => 'center'}, FormatDate $date; my $day_total = 0; - foreach (@Types) { + for (@Types) { my $value = $dates{$date}{$_}; - if ($value eq 0) { - print td {-class => "tabledata"}, " "; + if ($value == 0) { + print td {-class => 'tabledata'}, ' '; } else { - print td {-class => "tabledata", - -align => "center"}, - a {-href => "detail.cgi?type=$_;date=$date"}, - $value; + print td {-class => 'tabledata', + -align => 'center'}, + a {-href => "detail.cgi?type=$_;date=$date"}, + $value; } # if $totals{$_} += $value; $day_total += $value; - } # foreach + } # for - if ($day_total eq 0) { - print td {-class => "tableleftrightdata"}, " "; + if ($day_total == 0) { + print td {-class => 'tableleftrightdata'}, ' '; } else { - print td {-class => "tableleftrightdata", - -align => "center"}, $day_total; + print td {-class => 'tableleftrightdata', + -align => 'center'}, $day_total; } # if print end_Tr; - } # foreach + } # for my $grand_total = 0; print start_Tr; - print th {-class => "tablebottomlefttotal"}, "Totals"; + print th {-class => 'tablebottomlefttotal'}, 'Totals'; - foreach (@Types) { + for (@Types) { if ($totals{$_} eq 0) { - print td {-class => "tablebottomtotal"}, " "; + print td {-class => 'tablebottomtotal'}, ' '; } else { - print td {-class => "tablebottomtotal", - -align => "center"}, - a {-href => "detail.cgi?type=$_"}, $totals{$_}; + print td {-class => 'tablebottomtotal', + -align => 'center'}, + a {-href => "detail.cgi?type=$_"}, $totals{$_}; } # if $grand_total += $totals{$_}; - } # foreach + } # for - print td {-class => "tablebottomrighttotal", - -align => "center"}, $grand_total; + print td {-class => 'tablebottomrighttotal', + -align => 'center'}, $grand_total; print end_Tr; print end_table; @@ -113,25 +113,25 @@ sub Body { # Main my $userid = Heading ( - "getcookie", - "", - "Statistics", - "Statistics", - "", + 'getcookie', + '', + 'Statistics', + 'Statistics', + '', $table_name ); -SetContext $userid; +SetContext($userid); -if (!defined $nbr_days) { +if (!$nbr_days) { my %options = GetUserOptions $userid; - $nbr_days = $options{"Dates"}; + $nbr_days = $options{Dates}; } # if -NavigationBar $userid; +NavigationBar($userid); Body; -Footing $table_name; +Footing($table_name); exit; diff --git a/maps/bin/updateprofile.cgi b/maps/bin/updateprofile.cgi index a2f9a82..db2e201 100755 --- a/maps/bin/updateprofile.cgi +++ b/maps/bin/updateprofile.cgi @@ -2,8 +2,8 @@ ################################################################################ # # File: $RCSfile: updateprofile.cgi,v $ -# Revision: $Revision: 1.1 $ -# Description: Update the users profile +# Revision: $Revision: 1.1 $ +# Description: Update the users profile # Author: Andrew@DeFaria.com # Created: Mon Jan 16 20:25:32 PST 2006 # Modified: $Date: 2013/06/12 14:05:47 $ @@ -18,7 +18,7 @@ use warnings; use FindBin; $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; use MAPS; use MAPSWeb; @@ -27,56 +27,57 @@ use CGI qw (:standard); my $userid; my $Userid; -my $fullname = param ("fullname"); -my $email = param ("email"); -my $old_password = param ("old_password"); -my $new_password = param ("new_password"); -my $repeated_password = param ("repeated_password"); -my $mapspop = param ("MAPSPOP"); -my $history = param ("history"); -my $days = param ("days"); -my $dates = param ("dates"); -my $tag_and_forward = param ("tag_and_forward"); +my $fullname = param('fullname'); +my $email = param('email'); +my $old_password = param('old_password'); +my $new_password = param('new_password'); +my $repeated_password = param('repeated_password'); +my $mapspop = param('MAPSPOP'); +my $history = param('history'); +my $days = param('days'); +my $dates = param('dates'); +my $tag_and_forward = param('tag_and_forward'); sub Body { my %options = ( - "MAPSPOP" => $mapspop, - "History" => $history, - "Page" => $days, - "Dates" => $dates, - "Tag&Forward" => $tag_and_forward + MAPSPOP => $mapspop, + History => $history, + Page => $days, + Dates => $dates, + 'Tag&Forward' => $tag_and_forward, ); - if (defined $old_password && $old_password ne "") { - my $dbpassword = UserExists $userid; - my $encrypted_old_password = Encrypt $old_password, $userid; + if ($old_password && $old_password ne '') { + my $dbpassword = UserExists($userid); + my $encrypted_old_password = Encrypt($old_password, $userid); if ($dbpassword ne $encrypted_old_password) { - DisplayError "Your old password was not correct!"; + DisplayError 'Your old password was not correct!'; } # if } # if - if (UpdateUser ($userid, $fullname, $email, $new_password) != 0) { + if (UpdateUser($userid, $fullname, $email, $new_password) != 0) { DisplayError "Unable to update user record for user $userid"; } # if - if (UpdateUserOptions ($userid, %options) != 0) { + if (UpdateUserOptions($userid, %options) != 0) { DisplayError "Unable to update user options for user $userid"; } # if - print h2 {-class => "header", - -align => "center"}, + print h2 {-class => 'header', + -align => 'center'}, "${Userid}'s profile has been updated"; } # Body $userid = Heading ( - "getcookie", - "", - "Update Profile", - "Update user's profile" + 'getcookie', + '', + 'Update Profile', + "Update user's profile", ); $Userid = ucfirst $userid; -SetContext $userid; -NavigationBar $userid; -Body; -Footing; + +SetContext($userid); +NavigationBar($userid); +Body(); +Footing(); diff --git a/maps/bin/MAPSDB.pm b/maps/lib/MAPS.pm similarity index 50% rename from maps/bin/MAPSDB.pm rename to maps/lib/MAPS.pm index 5836e2a..f1871ff 100644 --- a/maps/bin/MAPSDB.pm +++ b/maps/lib/MAPS.pm @@ -1,141 +1,246 @@ #!/usr/bin/perl ################################################################################# # -# File: $RCSfile: MAPSDB.pm,v $ +# File: $RCSfile: MAPS.pm,v $ # Revision: $Revision: 1.1 $ -# Description: MAPS Database routines +# Description: Main module for Mail Authentication and Permission System (MAPS) # Author: Andrew@DeFaria.com # Created: Fri Nov 29 14:17:21 2002 # Modified: $Date: 2013/06/12 14:05:47 $ # Language: perl # -# (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved. +# (c) Copyright 2000-2018, Andrew@DeFaria.com, all rights reserved. # ################################################################################ -package MAPSDB; +package MAPS; use strict; -use vars qw (@ISA @EXPORT); +use warnings; + use DBI; use Carp; +use FindBin; +use vars qw(@ISA @EXPORT); +use Exporter; +use MAPSLog; +use MAPSFile; use MAPSUtil; - -@ISA = qw (Exporter); +use MIME::Entity; # Globals my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER}; my %useropts; my $DB; -@EXPORT = qw ( +@ISA = qw(Exporter); + +@EXPORT = qw( + Add2Blacklist + Add2Nulllist + Add2Whitelist + AddEmail + AddList AddLog - CheckOnList - CloseDB - DBError - OpenDB - RecordHit + AddUser + AddUserOptions + Blacklist + CleanEmail + CleanLog + CleanList + CountMsg + Decrypt + DeleteEmail + DeleteList + DeleteLog + Encrypt + FindEmail + FindList + FindLog + FindUser + ForwardMsg + GetContext + GetEmail + GetList + GetLog + GetNextSequenceNo + GetRows + GetUser + GetUserOptions + ListLog + ListUsers + Login + Nulllist + OnBlacklist + OnNulllist + OnWhitelist + OptimizeDB + ReadMsg + ResequenceList + ReturnList + ReturnListEntry + ReturnMsg + ReturnMessages + ReturnSenders + SaveMsg + SearchEmails + SetContext + Space + UpdateList + UpdateUser + UpdateUserOptions + UserExists + Whitelist + count + countlog + count_distinct ); -# Forwards -sub AddEmail; -sub AddList; -sub AddLog; -sub AddUser; -sub AddUserOption; -sub CheckOnList; -sub CleanEmail; -sub CleanLog; -sub CleanList; -sub CloseDB; -sub CountMsg; -sub DBError; -sub Decrypt; -sub DeleteEmail; -sub DeleteList; -sub Encrypt; -sub FindEmail; -sub FindList; -sub FindLog; -sub FindUser; -sub GetContext; -sub GetEmail; -sub GetList; -sub GetLog; -sub GetNextSequenceNo; -sub GetUser; -sub GetUserInfo; -sub GetUserOptions; -sub OpenDB; -sub OptimizeDB; -sub ResequenceList; -sub ReturnEmails; -sub ReturnList; -sub ReturnListEntry; -sub SetContext; -sub Space; -sub UpdateList; -sub UpdateUser; -sub UpdateUserOption; -sub UserExists; -sub count; -sub countlog; - -sub AddEmail ($$$) { +my $mapsbase = "$FindBin::Bin/.."; + +sub Add2Blacklist($$$) { + # Add2Blacklist will add an entry to the blacklist + my ($sender, $userid, $comment) = @_; + + # First SetContext to the userid whose black list we are adding to + SetContext($userid); + + # Add to black list + AddList("black", $sender, 0, $comment); + + # Log that we black listed the sender + Info("Added $sender to " . ucfirst $userid . "'s black list"); + + # Delete old emails + my $count = DeleteEmail($sender); + + # Log out many emails we managed to remove + Info("Removed $count emails from $sender"); + + return; +} # Add2Blacklist + +sub Add2Nulllist($$;$$) { + # Add2Nulllist will add an entry to the nulllist + my ($sender, $userid, $comment, $hit_count) = @_; + + # First SetContext to the userid whose null list we are adding to + SetContext($userid); + + # Add to null list + AddList("null", $sender, 0, $comment, $hit_count); + + # Log that we null listed the sender + Info("Added $sender to " . ucfirst $userid . "'s null list"); + + # Delete old emails + my $count = DeleteEmail($sender); + + # Log out many emails we managed to remove + Info("Removed $count emails from $sender"); + + return; +} # Add2Nulllist + +sub Add2Whitelist($$;$) { + # Add2Whitelist will add an entry to the whitelist + my ($sender, $userid, $comment) = @_; + + # First SetContext to the userid whose white list we are adding to + SetContext($userid); + + # Add to white list + AddList('white', $sender, 0, $comment); + + # Log that we registered a user + Logmsg("registered", $sender, "Registered new sender"); + + # Check to see if there are any old messages to deliver + my $handle = FindEmail($sender); + + my ($dbsender, $subject, $timestamp, $message); + + # Deliver old emails + my $messages = 0; + my $return_status = 0; + + while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail($handle)) { + last unless $userid; + + $return_status = Whitelist($sender, $message); + + last if $return_status; + + $messages++; + } # while + + # Done with $handle + $handle->finish; + + # Return if we has a problem delivering email + return $return_status if $return_status; + + # Remove delivered messages. + DeleteEmail($sender); + + return $messages; +} # 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); + $sender = 'Unknown' if (!defined $sender || $sender eq ''); + $sender = $DB->quote($sender); + $subject = $DB->quote($subject); + $data = $DB->quote($data); - my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime)); + my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime)); my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)"; $DB->do ($statement) - or DBError 'AddEmail: Unable to do statement', $statement; + or DBError('AddEmail: Unable to do statement', $statement); return; } # AddEmail -sub AddList ($$$;$$$) { - my ($listtype, $pattern, $sequence, $comment, $hitcount, $last_hit) = @_; +sub AddList($$$;$$$) { + my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_; - $hitcount ||= 0; + $hit_count //= CountMsg($pattern); my ($user, $domain) = split /\@/, $pattern; if (!$domain || $domain eq '') { $domain = 'NULL'; - $pattern = $DB->quote ($user); + $pattern = $DB->quote($user); } else { $domain = "'$domain'"; + if ($user eq '') { $pattern = 'NULL'; } else { - $pattern = $DB->quote ($user); + $pattern = $DB->quote($user); } # if } # if if (!$comment || $comment eq '') { $comment = 'NULL'; } else { - $comment = $DB->quote ($comment); + $comment = $DB->quote($comment); } # if # Get next sequence # if ($sequence == 0) { - $sequence = GetNextSequenceNo $userid, $listtype; + $sequence = GetNextSequenceNo($userid, $listtype); } # if - $last_hit //= UnixDatetime2SQLDatetime (scalar (localtime)); + $last_hit //= UnixDatetime2SQLDatetime(scalar (localtime)); - my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hitcount, \"$last_hit\")"; + my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hit_count, \"$last_hit\")"; - $DB->do ($statement) - or DBError 'AddList: Unable to do statement', $statement; + $DB->do($statement) + or DBError('AddList: Unable to do statement', $statement); return; } # AddList @@ -143,11 +248,11 @@ sub AddList ($$$;$$$) { sub AddLog ($$$) { my ($type, $sender, $msg) = @_; - my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime)); + my $timestamp = UnixDatetime2SQLDatetime(scalar(localtime)); my $statement; # Use quote to protect ourselves - $msg = $DB->quote ($msg); + $msg = $DB->quote($msg); if ($sender eq '') { $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)"; @@ -155,56 +260,65 @@ sub AddLog ($$$) { $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)"; } # if - $DB->do ($statement) - or DBError 'AddLog: Unable to do statement', $statement; + $DB->do($statement) + or DBError('AddLog: Unable to do statement', $statement); return; } # AddLog -sub AddUser ($$$$) { +sub AddUser($$$$) { my ($userid, $realname, $email, $password) = @_; - $password = Encrypt $password, $userid; + $password = Encrypt($password, $userid); - if (UserExists $userid) { + if (UserExists($userid)) { return 1; } else { my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')"; - $DB->do ($statement) - or DBError 'AddUser: Unable to do statement', $statement; + $DB->do($statement) + or DBError('AddUser: Unable to do statement', $statement); } # if return 0; -} # AddUser +} # Adduser -sub AddUserOption ($$$) { - my ($userid, $name, $value) = @_; +sub AddUserOptions($%) { + my ($userid, %options) = @_; - if (!UserExists $userid) { - return 1; - } # if + for (keys %options) { + return 1 if !UserExists($userid); - my $statement = "insert into useropts values ('$userid', '$name', '$value')"; + my $statement = "insert into useropts values ('$userid', '$_', '$options{$_}')"; - $DB->do ($statement) - or DBError 'AddUserOption: Unable to do statement', $statement; + $DB->do($statement) + or DBError('AddUserOption: Unable to do statement', $statement); + } # for return 0; -} # AddUserOption +} # AddUserOptions -sub RecordHit ($$$) { - my ($listtype, $sequence, $hit_count) = @_; +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 $current_date = UnixDatetime2SQLDatetime (scalar (localtime)); + # Check to see if this sender has already emailed us. + my $msg_count = CountMsg($sender); - my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence"; + if ($msg_count < 5) { + # Bounce email + SendMsg($sender, "Your email has been discarded by MAPS", "$mapsbase/blacklist.html", @msg); + Logmsg("blacklist", $sender, "Sent blacklist reply"); + } else { + Logmsg("mailloop", $sender, "Mail loop encountered"); + } # if - $DB->do ($statement) - or DBError 'AddList: Unable to do statement', $statement; + RecordHit("black", $sequence, ++$hit_count) if $sequence; return; -} # RecordHit +} # Blacklist sub CheckOnList ($$;$) { # CheckOnList will check to see if the $sender is on the $listfile. @@ -216,13 +330,15 @@ sub CheckOnList ($$;$) { my $status = 0; my ($rule, $sequence, $hit_count); - my $statement = "select pattern, domain, comment, sequence, hit_count from list where userid = '$userid' and type = '$listtype'"; + my $statement = 'select pattern, domain, comment, sequence, hit_count ' + . "from list where userid = '$userid' and type = '$listtype' " + . 'order by sequence'; - my $sth = $DB->prepare ($statement) - or DBError 'CheckOnList: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('CheckOnList: Unable to prepare statement', $statement); $sth->execute - or DBError 'CheckOnList: Unable to execute statement', $statement; + or DBError('CheckOnList: Unable to execute statement', $statement); while (my @row = $sth->fetchrow_array) { last if !@row; @@ -260,13 +376,12 @@ sub CheckOnList ($$;$) { : !defined $domain ? "$email_on_file\@" : $email_on_file; - if ($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; + RecordHit($listtype, $sequence, ++$hit_count) if $update; last; } # if @@ -277,7 +392,7 @@ sub CheckOnList ($$;$) { return ($status, $rule, $sequence, $hit_count); } # CheckOnList -sub CleanEmail ($) { +sub CleanEmail($) { my ($timestamp) = @_; # First see if anything needs to be deleted @@ -286,12 +401,12 @@ sub CleanEmail ($) { 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; + 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; + or DBError('CleanEmail: Unable to execute statement', $statement); # Get return value, which should be how many entries were deleted my @row = $sth->fetchrow_array; @@ -313,17 +428,17 @@ sub CleanEmail ($) { $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'"; # Prepare statement - $sth = $DB->prepare ($statement) - or DBError 'CleanEmail: Unable to prepare statement', $statement; + $sth = $DB->prepare($statement) + or DBError('CleanEmail: Unable to prepare statement', $statement); # Execute statement $sth->execute - or DBError 'CleanEmail: Unable to execute statement', $statement; + or DBError('CleanEmail: Unable to execute statement', $statement); return $count; -} # CleanEmail +} # ClearEmail -sub CleanLog ($) { +sub CleanLog($) { my ($timestamp) = @_; # First see if anything needs to be deleted @@ -332,12 +447,12 @@ sub CleanLog ($) { my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'"; # Prepare statement - my $sth = $DB->prepare ($statement) - or DBError $DB, 'CleanLog: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError($DB, 'CleanLog: Unable to prepare statement', $statement); # Execute statement $sth->execute - or DBError 'CleanLog: Unable to execute statement', $statement; + or DBError('CleanLog: Unable to execute statement', $statement); # Get return value, which should be how many entries were deleted my @row = $sth->fetchrow_array; @@ -359,20 +474,20 @@ sub CleanLog ($) { $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'"; # Prepare statement - $sth = $DB->prepare ($statement) - or DBError 'CleanLog: Unable to prepare statement', $statement; + $sth = $DB->prepare($statement) + or DBError('CleanLog: Unable to prepare statement', $statement); # Execute statement $sth->execute - or DBError 'CleanLog: Unable to execute statement', $statement; + or DBError('CleanLog: Unable to execute statement', $statement); return $count; } # CleanLog -sub CleanList ($;$) { +sub CleanList($;$) { my ($timestamp, $listtype) = @_; - $listtype = 'null' if !$listtype; + $listtype //= 'null'; # First see if anything needs to be deleted my $count = 0; @@ -380,12 +495,12 @@ sub CleanList ($;$) { my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'"; # Prepare statement - my $sth = $DB->prepare ($statement) - or DBError $DB, 'CleanList: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError($DB, 'CleanList: Unable to prepare statement', $statement); # Execute statement $sth->execute - or DBError 'CleanList: Unable to execute statement', $statement; + or DBError('CleanList: Unable to execute statement', $statement); # Get return value, which should be how many entries were deleted my @row = $sth->fetchrow_array; @@ -403,28 +518,28 @@ sub CleanList ($;$) { $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'"; # Prepare statement - $sth = $DB->prepare ($statement) - or DBError 'CleanList: Unable to prepare statement', $statement; + $sth = $DB->prepare($statement) + or DBError('CleanList: Unable to prepare statement', $statement); # Execute statement $sth->execute - or DBError 'CleanList: Unable to execute statement', $statement; + or DBError('CleanList: Unable to execute statement', $statement); $count = 0; while (my @row = $sth->fetchrow_array) { last if !@row; - my $hit_count = pop (@row); - my $sequence = pop (@row); - my $listtype = pop (@row); + my $hit_count = pop(@row); + my $sequence = pop(@row); + my $listtype = pop(@row); 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; + $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 @@ -435,44 +550,41 @@ sub CleanList ($;$) { # 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 dividing it's - # $hit_count in half. Sucessive halfing then will quickly age - # the entry down to size. However we don't want to age small - # $hit_count's too quickly, therefore once their numbers drop to - # < 30 we revert to the old method of subtracting 1. + # 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 = $hit_count / 2; + $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; + $DB->do($statement) + or DBError('CleanList: Unable to execute statement', $statement); } # if } # while - ResequenceList $userid, $listtype if $count > 0; + ResequenceList($userid, $listtype); return $count; } # CleanList -sub CloseDB () { +sub CloseDB() { $DB->disconnect; return; } # CloseDB -sub CountMsg ($) { +sub CountMsg($) { my ($sender) = @_; - return count ('email', "userid = '$userid' and sender like '%$sender%'"); + return count('email', "userid = '$userid' and sender like '%$sender%'"); } # CountMsg -sub DBError ($$) { +sub DBError($$) { my ($msg, $statement) = @_; - print 'MAPSDB::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n"; + print 'MAPS::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n"; if ($statement) { print "SQL Statement: $statement\n"; @@ -486,11 +598,11 @@ sub Decrypt ($$) { my $statement = "select decode('$password','$userid')"; - my $sth = $DB->prepare ($statement) - or DBError 'Decrypt: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('Decrypt: Unable to prepare statement', $statement); $sth->execute - or DBError 'Decrypt: Unable to execute statement', $statement; + or DBError('Decrypt: Unable to execute statement', $statement); # Get return value, which should be the encoded password my @row = $sth->fetchrow_array; @@ -501,7 +613,7 @@ sub Decrypt ($$) { return $row[0] } # Decrypt -sub DeleteEmail ($) { +sub DeleteEmail($) { my $sender = shift; my ($username, $domain) = split /@/, $sender; @@ -514,37 +626,37 @@ sub DeleteEmail ($) { } # if # First see if anything needs to be deleted - my $count = count ('email', $condition); + my $count = count('email', $condition); # Just return if there's nothing to delete return $count if ($count == 0); my $statement = 'delete from email where ' . $condition; - $DB->do ($statement) - or DBError 'DeleteEmail: Unable to execute statement', $statement; + $DB->do($statement) + or DBError('DeleteEmail: Unable to execute statement', $statement); return $count; } # DeleteEmail -sub DeleteList ($$) { +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'"); + 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); my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'"; - $DB->do ($statement) - or DBError 'DeleteList: Unable to execute statement', $statement; + $DB->do($statement) + or DBError('DeleteList: Unable to execute statement', $statement); return $count; } # DeleteList -sub DeleteLog ($) { +sub DeleteLog($) { my ($sender) = @_; my ($username, $domain) = split /@/, $sender; @@ -557,29 +669,29 @@ sub DeleteLog ($) { } # if # First see if anything needs to be deleted - my $count = count ('log', $condition); + my $count = count('log', $condition); # Just return if there's nothing to delete return $count if ($count == 0); my $statement = 'delete from log where ' . $condition; - $DB->do ($statement) - or DBError 'DeleteLog: Unable to execute statement', $statement; + $DB->do($statement) + or DBError('DeleteLog: Unable to execute statement', $statement); return $count; } # DeleteLog -sub Encrypt ($$) { +sub Encrypt($$) { my ($password, $userid) = @_; my $statement = "select encode('$password','$userid')"; - my $sth = $DB->prepare ($statement) - or DBError 'Encrypt: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('Encrypt: Unable to prepare statement', $statement); $sth->execute - or DBError 'Encrypt: Unable to execute statement', $statement; + or DBError('Encrypt: Unable to execute statement', $statement); # Get return value, which should be the encoded password my @row = $sth->fetchrow_array; @@ -587,10 +699,10 @@ sub Encrypt ($$) { # Done with $sth $sth->finish; - return $row[0] + return $row[0]; } # Encrypt -sub FindEmail (;$) { +sub FindEmail(;$) { my ($sender) = @_; my $statement; @@ -601,16 +713,16 @@ sub FindEmail (;$) { $statement = "select * from email where userid = '$userid' and sender = '$sender'"; } # if - my $sth = $DB->prepare ($statement) - or DBError 'FindEmail: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('FindEmail: Unable to prepare statement', $statement); $sth->execute - or DBError 'FindEmail: Unable to execute statement', $statement; + or DBError('FindEmail: Unable to execute statement', $statement); return $sth; } # FindEmail -sub FindList ($;$) { +sub FindList($;$) { my ($type, $sender) = @_; my $statement; @@ -624,35 +736,43 @@ sub FindList ($;$) { } # unless # Prepare statement - my $sth = $DB->prepare ($statement) - or DBError 'FindList: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('FindList: Unable to prepare statement', $statement); # Execute statement $sth->execute - or DBError 'FindList: Unable to execute statement', $statement; + or DBError('FindList: Unable to execute statement', $statement); # Get return value, which should be how many entries were deleted return $sth; } # FindList -sub FindLog ($$) { - my ($start_at, $end_at) = @_; +sub FindLog($) { + my ($how_many) = @_; + + my $start_at = 0; + my $end_at = countlog(); + + 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; + 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; + or DBError('FindLog: Unable to execute statement', $statement); # Get return value, which should be how many entries were deleted return $sth; } # FindLog -sub FindUser (;$) { +sub FindUser(;$) { my ($userid) = @_; my $statement; @@ -663,20 +783,20 @@ sub FindUser (;$) { $statement = "select * from user where userid = '$userid'"; } # if - my $sth = $DB->prepare ($statement) - or DBError 'FindUser: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('FindUser: Unable to prepare statement', $statement); $sth->execute - or DBError 'FindUser: Unable to execute statement', $statement; + or DBError('FindUser: Unable to execute statement', $statement); return $sth; } # FindUser -sub GetContext () { +sub GetContext() { return $userid; } # GetContext -sub GetEmail ($) { +sub GetEmail($) { my ($sth) = @_; my @email; @@ -693,7 +813,7 @@ sub GetEmail ($) { } # if } # GetEmail -sub GetList ($) { +sub GetList($) { my ($sth) = @_; my @list; @@ -713,7 +833,7 @@ sub GetList ($) { } # if } # GetList -sub GetLog ($) { +sub GetLog($) { my ($sth) = @_; my @log; @@ -730,7 +850,7 @@ sub GetLog ($) { } # if } # GetLog -sub GetNextSequenceNo ($$) { +sub GetNextSequenceNo($$) { my ($userid, $listtype) = @_; my $count = count ('list', "userid = '$userid' and type = '$listtype'"); @@ -738,7 +858,7 @@ sub GetNextSequenceNo ($$) { return $count + 1; } # GetNextSequenceNo -sub GetUser ($) { +sub GetUser($) { my ($sth) = @_; my @user; @@ -754,16 +874,16 @@ sub GetUser ($) { } # if } # GetUser -sub GetUserInfo ($) { +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; + my $sth = $DB->prepare($statement) + or DBError('GetUserInfo: Unable to prepare statement', $statement); $sth->execute - or DBError 'GetUserInfo: Unable to execute statement', $statement; + or DBError('GetUserInfo: Unable to execute statement', $statement); my @userinfo = $sth->fetchrow_array; my $user_email = lc (pop @userinfo); @@ -774,16 +894,16 @@ sub GetUserInfo ($) { return ($username, $user_email); } # GetUserInfo -sub GetUserOptions ($) { +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; + my $sth = $DB->prepare($statement) + or DBError('GetUserOptions: Unable to prepare statement', $statement); $sth->execute - or DBError 'GetUserOptions: Unable to execute statement', $statement; + or DBError('GetUserOptions: Unable to execute statement', $statement); my @useropts; @@ -793,7 +913,9 @@ sub GetUserOptions ($) { while (@useropts = $sth->fetchrow_array) { my $value = pop @useropts; my $name = pop @useropts; + pop @useropts; + $useropts{$name} = $value; } # while @@ -805,24 +927,76 @@ sub GetUserOptions ($) { sub GetRows ($) { my ($statement) = @_; - my $sth = $DB->prepare ($statement) - or DBError 'Unable to prepare statement' , $statement; + my $sth = $DB->prepare($statement) + or DBError('Unable to prepare statement' , $statement); $sth->execute - or DBError 'Unable to execute statement' , $statement; + or DBError('Unable to execute statement' , $statement); my @array; while (my @row = $sth->fetchrow_array) { - foreach (@row) { + for (@row) { push @array, $_; - } # foreach + } # for } # while return @array; } # GetRows -sub OpenDB ($$) { +sub Login($$) { + my ($userid, $password) = @_; + + $password = Encrypt($password, $userid); + + # Check if user exists + my $dbpassword = UserExists($userid); + + # Return -1 if user doesn't exist + return -1 if !$dbpassword; + + # Return -2 if password does not match + if ($password eq $dbpassword) { + SetContext($userid); + return 0 + } else { + return -2 + } # if +} # Login + +sub Nulllist($;$$) { + # Nulllist will simply discard the message. + my ($sender, $sequence, $hit_count) = @_; + + RecordHit("null", $sequence, ++$hit_count) if $sequence; + + # Discard Message + Logmsg("nulllist", $sender, "Discarded message"); + + return; +} # Nulllist + +sub OnBlacklist($;$) { + my ($sender, $update) = @_; + + return CheckOnList('black', $sender, $update); +} # OnBlacklist + +sub OnNulllist($;$) { + my ($sender, $update) = @_; + + return CheckOnList("null", $sender, $update); +} # CheckOnNulllist + +sub OnWhitelist($;$$) { + my ($sender, $userid, $update) = @_; + + SetContext($userid) if $userid; + + return CheckOnList("white", $sender, $update); +} # OnWhitelist + +sub OpenDB($$) { my ($username, $password) = @_; my $dbname = 'MAPS'; @@ -838,200 +1012,295 @@ sub OpenDB ($$) { return $DB; } # OpenDB -sub OptimizeDB () { +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 $sth = $DB->prepare($statement) + or DBError('OptimizeDB: Unable to prepare statement', $statement); $sth->execute - or DBError 'OptimizeDB: Unable to execute statement', $statement; + or DBError('OptimizeDB: Unable to execute statement', $statement); $statement = 'check table email, list, log, user, useropts'; - $sth = $DB->prepare ($statement) - or DBError 'OptimizeDB: Unable to prepare statement', $statement; + $sth = $DB->prepare($statement) + or DBError('OptimizeDB: Unable to prepare statement', $statement); $sth->execute - or DBError 'OptimizeDB: Unable to execute statement', $statement; + or DBError('OptimizeDB: Unable to execute statement', $statement); $statement = 'unlock tables'; - $sth = $DB->prepare ($statement) - or DBError 'OptimizeDB: Unable to prepare statement', $statement; + $sth = $DB->prepare($statement) + or DBError('OptimizeDB: Unable to prepare statement', $statement); $sth->execute - or DBError 'OptimizeDB: Unable to execute statement', $statement; + or DBError('OptimizeDB: Unable to execute statement', $statement); $statement = 'optimize table email, list, log, user, useropts'; - $sth = $DB->prepare ($statement) - or DBError 'OptimizeDB: Unable to prepare statement', $statement; + $sth = $DB->prepare($statement) + or DBError('OptimizeDB: Unable to prepare statement', $statement); $sth->execute - or DBError 'OptimizeDB: Unable to execute statement', $statement; - + or DBError('OptimizeDB: Unable to execute statement', $statement); + return; } # OptimizeDB -sub ResequenceList ($$) { - my ($userid, $type) = @_; +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; + + # Find first message's "From " line indicating start of message + while (<$input>) { + chomp; + last if /^From /; + } # while - if ($type ne 'white' && $type ne 'black' && $type ne 'null') { - return 1; + # 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 - if (!UserExists $userid) { - return 2; + if (/From (\S*)/) { + $envelope_sender = $1; + $sender_long = $envelope_sender; } # if - my $statement = "select sequence from list where userid = '$userid' ". - " and type = '$type' order by sequence"; + push @data, $_ if /^From /; - my $sth = $DB->prepare ($statement) - or DBError 'ResequenceList: Unable to prepare statement', $statement; + while (<$input>) { + chomp; + push @data, $_; - $sth->execute - or DBError 'ResequenceList: Unable to execute statement', $statement; + # Blank line indicates start of message body + last if ($_ eq "" || $_ eq "\r"); - my $sequence = 1; + # Extract sender's address + if (/^from: .*/i) { + $_ = substr ($_, 6); - while (my @row = $sth->fetchrow_array) { - last if !@row; - my $old_sequence = pop (@row); + $sender_long = $_; - 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 (/<(\S*)@(\S*)>/) { + $sender = lc ("$1\@$2"); + } elsif (/(\S*)@(\S*)\ /) { + $sender = lc ("$1\@$2"); + } elsif (/(\S*)@(\S*)/) { + $sender = 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"); + } # if } # if + } # while - $sequence++; + # Read message body + while (<$input>) { + chomp; + + last if (/^From /); + push @data, $_; } # while - return 0; -} # ResequenceList + # Set file pointer back by length of the line just read + 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; + + # 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) = @_; -# 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) = @_; + my $current_date = UnixDatetime2SQLDatetime(scalar(localtime)); - $start_at ||= 0; + my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence"; - my $dateCond = ''; + $DB->do($statement) + or DBError('RecordHit: Unable to do statement', $statement); - if ($date) { - my $sod = $date . ' 00:00:00'; - my $eod = $date . ' 23:59:59'; - - $dateCond = "and timestamp > '$sod' and timestamp < '$eod'"; - } # if + return; +} # RecordHit - my $statement = <<"END"; +sub ResequenceList($$) { + my ($userid, $type) = @_; + + return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null'; + + return 2 unless UserExists($userid); + + my $statement = 'lock tables list write'; + my $sth = $DB->prepare($statement) + or DBError('ResquenceList: Unable to prepare statement', $statement); + + $sth->execute + or DBError('ResequenceList: Unable to execute statement', $statement); + + # Now get all of the list entries renumbering as we go + $statement = <<"END"; select - sender, - timestamp + pattern, + domain, + comment, + sequence, + hit_count, + last_hit from - log + list where userid = '$userid' and type = '$type' - $dateCond -order by - timestamp desc +order by + hit_count desc END - my $sth = $DB->prepare ($statement) - or DBError 'ReturnSenders: Unable to prepare statement', $statement; + $sth = $DB->prepare($statement) + or DBError('ResequenceList: Unable to prepare statement', $statement); $sth->execute - or DBError 'ReturnSenders: Unable to execute statement', $statement; + or DBError('ResequenceList: Unable to execute statement', $statement); - # Watch the distinction between senders (plural) and sender (singular) - my (%senders, %sendersByTimestamp); + my $sequence = 1; + my @new_rows; - # 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 - # timestamp value. Since we already sorted timestamp desc by the - # 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}; + while (my @row = $sth->fetchrow_array) { + last if !@row; - $senders{$sender{sender}} = $sender{timestamp} - unless $senders{$sender{sender}}; + 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) || '', + ); + + push @new_rows, \%record; } # while - $sth->finish; + # 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 - # Make a hash whose keys are the timestamp (so we can later sort on - # them). - while (my ($key, $value) = each %senders) { - $sendersByTimestamp{$value} = $key; - } # while + $DB->do($statement) + or DBError('ResequenceList: Unable to do statement', $statement); + } # for - my @senders; + $statement = 'unlock tables'; + $sth = $DB->prepare($statement) + or DBError('OptimizeDB: Unable to prepare statement', $statement); - # Sort by timestamp desc and push on to the @senders array - push @senders, $sendersByTimestamp{$_} - foreach (sort { $b cmp $a } keys %sendersByTimestamp); + $sth->execute + or DBError('OptimizeDB: Unable to execute statement', $statement); - # Finally slice for the given range - my $end_at = $start_at + $nbr_emails - 1; + return 0; +} # ResequenceList - $end_at = (@senders - 1) - if $end_at > @senders; +sub ResequenceListold($$) { + my ($userid, $type) = @_; - return (@senders) [$start_at .. $end_at]; -} # ReturnSenders + return 1 if $type ne 'white' && $type ne 'black' && $type ne 'null'; -sub ReturnMessages ($$) { - my ($userid, $sender) = @_; + return 2 unless UserExists($userid); - my $statement = <<"END"; -select - subject, - timestamp -from - email -where - userid = '$userid' and - sender = '$sender' -group by - timestamp desc -END + my $statement = "select sequence from list where userid = '$userid' " + . " and type = '$type' order by sequence"; - my $sth = $DB->prepare ($statement) - or DBError 'ReturnMessages: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('ResequenceList: Unable to prepare statement', $statement); $sth->execute - or DBError 'ReturnMessages: Unable to execute statement', $statement; + or DBError('ResequenceList: Unable to execute statement', $statement); - my @messages; + my $sequence = 1; while (my @row = $sth->fetchrow_array) { - my $date = pop @row; - my $subject = pop @row; + last if !@row; - push @messages, [$subject, $date]; - } # while + my $old_sequence = pop @row; - $sth->finish; + if ($old_sequence != $sequence) { + my $update_statement = "update list set sequence = $sequence " . + "where userid = '$userid' and " . + "type = '$type' and sequence = $old_sequence"; - return @messages; -} # ReturnMessages + $DB->do($update_statement) + or DBError('ResequenceList: Unable to do statement', $statement); + } # if -sub ReturnEmails ($$$;$$) { + $sequence++; + } # while + + return 0; +} # ResequenceList + +sub ReturnEmails($$$;$$) { my ($userid, $type, $start_at, $nbr_emails, $date) = @_; $start_at ||= 0; @@ -1115,11 +1384,11 @@ END } # if } # if - my $sth = $DB->prepare ($statement) - or DBError 'ReturnEmails: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('ReturnEmails: Unable to prepare statement', $statement); $sth->execute - or DBError 'ReturnEmails: Unable to execute statement', $statement; + or DBError('ReturnEmails: Unable to execute statement', $statement); my @emails; @@ -1132,11 +1401,11 @@ END $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; + my $sth2 = $DB->prepare($statement) + or DBError('ReturnEmails: Unable to prepare statement', $statement); $sth2->execute - or DBError 'ReturnEmails: Unable to execute statement', $statement; + or DBError('ReturnEmails: Unable to execute statement', $statement); while (my @row = $sth2->fetchrow_array) { my $subject = pop @row; @@ -1148,8 +1417,7 @@ END if ($earliestDateShort eq $dateShort and $earliestDate > $date) { - $earliestDate = $date - if $earliestDateShort eq $dateShort; + $earliestDate = $date if $earliestDateShort eq $dateShort; } # if } else { $earliestDate = $date; @@ -1177,7 +1445,7 @@ END return @emails; } # ReturnEmails -sub ReturnList ($$$) { +sub ReturnList($$$) { my ($type, $start_at, $lines) = @_; $lines ||= 10; @@ -1193,11 +1461,11 @@ sub ReturnList ($$$) { "and type = '$type' order by sequence"; } # if - my $sth = $DB->prepare ($statement) - or DBError 'ReturnList: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('ReturnList: Unable to prepare statement', $statement); $sth->execute - or DBError 'ReturnList: Unable to execute statement', $statement; + or DBError('ReturnList: Unable to execute statement', $statement); my @list; my $i = 0; @@ -1207,84 +1475,212 @@ sub ReturnList ($$$) { my %list; - $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; + $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; } # ReturnList -sub ReturnListEntry ($$) { +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; + my $sth = $DB->prepare($statement) + or DBError('ReturnListEntry: Unable to prepare statement', $statement); $sth->execute - or DBError 'ReturnListEntry: Unable to execute statement', $statement; + 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; + $list{sequence} = pop @row; + $list{comment} = pop @row; + $list{domain} = pop @row; + $list{pattern} = pop @row; + $list{type} = pop @row; + $list{userid} = pop @row; return %list; } # ReturnListEntry -sub UpdateList ($$$$$$$) { - my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_; - - if (!$pattern || $pattern eq '') { - $pattern = 'NULL'; +# 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) = @_; + + # Check to see if this sender has already emailed us. + my $msg_count = CountMsg($sender); + + if ($msg_count < 5) { + # Return register message + my @msg; + + for (split /\n/,$data) { + push @msg, "$_\n"; + } # for + + 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); } else { - $pattern = "'" . quotemeta ($pattern) . "'"; + Add2Nulllist($sender, GetContext, "Auto Null List - Mail loop"); + Logmsg("mailloop", $sender, "Mail loop encountered"); } # if - if (!$domain || $domain eq '') { - $domain = 'NULL'; - } else { - $domain = "'" . quotemeta ($domain) . "'"; - } # if + return; +} # ReturnMsg - if (!$comment || $comment eq '') { - $comment = 'NULL'; - } else { - $comment = "'" . quotemeta ($comment) . "'"; +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); + + $sth->execute + or DBError('ReturnMessages: Unable to execute statement', $statement); + + my @messages; + + while (my @row = $sth->fetchrow_array) { + my $date = pop @row; + my $subject = pop @row; + + push @messages, [$subject, $date]; + } # while + + $sth->finish; + + return @messages; +} # 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'"; } # if - if (!$hit_count || $hit_count eq '') { - $hit_count = 0; - #} else { - # TODO: Check if numeric - } # fi + my $statement = <<"END"; +select + sender, + timestamp +from + log +where + userid = '$userid' and + type = '$type' + $dateCond +order by + timestamp desc +END - my $statement = - 'update list set ' . - "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " . - "where userid = '$userid' and type = '$type' and sequence = $sequence"; + my $sth = $DB->prepare($statement) + or DBError('ReturnSenders: Unable to prepare statement', $statement); - $DB->do ($statement) - or DBError 'UpdateList: Unable to do statement', $statement; + $sth->execute + or DBError('ReturnSenders: Unable to execute statement', $statement); - return 0; -} # UpdateList + # Watch the distinction between senders (plural) and sender (singular) + my (%senders, %sendersByTimestamp); + + # 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 + # timestamp value. Since we already sorted timestamp desc by the + # 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}; -sub SearchEmails ($$) { + $senders{$sender{sender}} = $sender{timestamp} + unless $senders{$sender{sender}}; + } # while + + $sth->finish; + + # Make a hash whose keys are the timestamp (so we can later sort on + # them). + while (my ($key, $value) = each %senders) { + $sendersByTimestamp{$value} = $key; + } # while + + my @senders; + + # Sort by timestamp desc and push on to the @senders array + push @senders, $sendersByTimestamp{$_} + for (sort { $b cmp $a } keys %sendersByTimestamp); + + # Finally slice for the given range + my $end_at = $start_at + $nbr_emails - 1; + + $end_at = (@senders - 1) + if $end_at > @senders; + + return (@senders) [$start_at .. $end_at]; +} # ReturnSenders + +sub SaveMsg($$$) { + my ($sender, $subject, $data) = @_; + + AddEmail($sender, $subject, $data); + + return; +} # SaveMsg + +sub SearchEmails($$) { my ($userid, $searchfield) = @_; my @emails; @@ -1294,11 +1690,11 @@ sub SearchEmails ($$) { sender like '%$searchfield%' or subject like '%$searchfield%') order by timestamp desc"; - my $sth = $DB->prepare ($statement) - or DBError 'SearchEmails: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('SearchEmails: Unable to prepare statement', $statement); $sth->execute - or DBError 'SearchEmails: Unable to execute statement', $statement; + or DBError('SearchEmails: Unable to execute statement', $statement); while (my @row = $sth->fetchrow_array) { my $date = pop @row; @@ -1313,35 +1709,90 @@ sub SearchEmails ($$) { return @emails; } # SearchEmails -sub SetContext ($) { +sub SendMsg($$$$@) { + # SendMsg will send the message contained in $msgfile. + 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"; + + # Read return message template file and print it to $msg_body + while (<$return_msg_file>) { + if (/\$userid/) { + # Replace userid + s/\$userid/$userid/; + } # if + if (/\$sender/) { + # Replace sender + s/\$sender/$sender/; + } #if + + push @lines, $_; + } # while + + close $return_msg_file; + + # Create the message, and set up the mail headers: + my $msg = MIME::Entity->build( + From => "MAPS\@DeFaria.com", + To => $sender, + Subject => $subject, + Type => "text/html", + Data => \@lines + ); + + # Need to obtain the spam message here... + $msg->attach( + Type => "message", + Disposition => "attachment", + Data => \@spammsg + ); + + # Send it + open my $mail, '|-', '/usr/lib/sendmail -t -oi -oem' + or croak "SendMsg: Unable to open pipe to sendmail $!"; + + $msg->print(\*$mail); + + close $mail; + + return; +} # SendMsg + +sub SetContext($) { my ($to_user) = @_; my $old_user = $userid; - if (UserExists $to_user) { + if (UserExists($to_user)) { $userid = $to_user; - GetUserOptions $userid; + + GetUserOptions($userid); return GetUserInfo $userid; } else { return 0; } # if } # SetContext -sub Space ($) { +sub Space($) { my ($userid) = @_; - my $total_space = 0; + 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; + my $sth = $DB->prepare($statement) + or DBError('Unable to prepare statement', $statement); $sth->execute - or DBError 'Unable to execute statement', $statement; + 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; @@ -1364,13 +1815,49 @@ sub Space ($) { return wantarray ? %msg_space : $total_space; } # Space -sub UpdateUser ($$$$) { - my ($userid, $fullname, $email, $password) = @_; +sub UpdateList($$$$$$$) { + my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_; - if (!UserExists $userid) { - return 1; + if (!$pattern || $pattern eq '') { + $pattern = 'NULL'; + } else { + $pattern = "'" . quotemeta ($pattern) . "'"; + } # if + + if (!$domain || $domain eq '') { + $domain = 'NULL'; + } else { + $domain = "'" . quotemeta ($domain) . "'"; + } # if + + if (!$comment || $comment eq '') { + $comment = 'NULL'; + } else { + $comment = "'" . quotemeta ($comment) . "'"; } # if + if (!$hit_count || $hit_count eq '') { + $hit_count = 0; + #} else { + # TODO: Check if numeric + } # fi + + 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); + + return 0; +} # UpdateList + +sub UpdateUser($$$$) { + my ($userid, $fullname, $email, $password) = @_; + + return 1 if !UserExists($userid); + my $statement; if (!defined $password || $password eq '') { @@ -1380,46 +1867,45 @@ sub UpdateUser ($$$$) { $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; + $DB->do($statement) + or DBError('UpdateUser: Unable to do statement', $statement); return 0; } # UpdateUser -sub UpdateUserOption ($$$) { - my ($userid, $name, $value) = @_; +sub UpdateUserOptions ($@) { + my ($userid, %options) = @_; - if (!UserExists $userid) { - return 1; - } # if + return unless UserExists($userid); - my $statement = "update useropts set value='$value' where userid='$userid' and name='$name'"; + for (keys(%options)) { + my $statement = "update useropts set value='$options{$_}' where userid='$userid' and name='$_'"; - $DB->do ($statement) - or DBError 'UpdateUserOption: Unable to do statement', $statement; + $DB->do($statement) + or DBError('UpdateUserOption: Unable to do statement', $statement); + } # for - return 0; + return; } # UpdateUserOptions -sub UserExists ($) { +sub UserExists($) { my ($userid) = @_; - return 0 - unless $userid; + 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 $sth = $DB->prepare($statement) + or DBError('UserExists: Unable to prepare statement', $statement); $sth->execute - or DBError 'UserExists: Unable to execute statement', $statement; + or DBError('UserExists: Unable to execute statement', $statement); my @userdata = $sth->fetchrow_array; $sth->finish; - return 0 if scalar (@userdata) == 0; + return 0 if scalar(@userdata) == 0; my $dbpassword = pop @userdata; my $dbuserid = pop @userdata; @@ -1431,7 +1917,37 @@ sub UserExists ($) { } # if } # UserExists -sub count ($$) { +sub Whitelist ($$;$$) { + # Whitelist will deliver the message. + my ($sender, $data, $sequence, $hit_count) = @_; + + my $userid = GetContext; + + # Dump message into a file + open my $message, '>', "/tmp/MAPSMessage.$$" + 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.$$"; + + unlink "/tmp/MAPSMessage.$$"; + + if ($status == 0) { + Logmsg("whitelist", $sender, "Delivered message"); + } 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; @@ -1442,11 +1958,11 @@ sub count ($$) { $statement = "select count(*) from $table"; } # if - my $sth = $DB->prepare ($statement) - or DBError 'count: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('count: Unable to prepare statement', $statement); $sth->execute - or DBError 'count: Unable to execute statement', $statement; + or DBError('count: Unable to execute statement', $statement); # Get return value, which should be how many message there are my @row = $sth->fetchrow_array; @@ -1466,7 +1982,7 @@ sub count ($$) { return $count } # count -sub count_distinct ($$$) { +sub count_distinct($$$) { my ($table, $column, $condition) = @_; my $statement; @@ -1477,11 +1993,11 @@ sub count_distinct ($$$) { $statement = "select count(distinct $column) from $table"; } # if - my $sth = $DB->prepare ($statement) - or DBError 'count: Unable to prepare statement', $statement; + my $sth = $DB->prepare($statement) + or DBError('count: Unable to prepare statement', $statement); $sth->execute - or DBError 'count: Unable to execute statement', $statement; + or DBError('count: Unable to execute statement', $statement); # Get return value, which should be how many message there are my @row = $sth->fetchrow_array; @@ -1497,19 +2013,14 @@ sub count_distinct ($$$) { } # unless } # count_distinct -sub countlog (;$$) { - my ($additional_condition, $type) = @_; - - $type ||= ''; - - my $condition; +sub countlog(;$) { + my ($additional_condition) = @_; - $condition = "userid=\'$userid\' "; + my $condition = "userid=\'$userid\' "; - $condition .= "and $additional_condition" - if $additional_condition; + $condition .= "and $additional_condition" if $additional_condition; - return count_distinct ('log', 'sender', $condition); + return count_distinct('log', 'sender', $condition); } # countlog 1; diff --git a/maps/bin/MAPSFile.pm b/maps/lib/MAPSFile.pm similarity index 83% rename from maps/bin/MAPSFile.pm rename to maps/lib/MAPSFile.pm index f9fc4c6..a38692b 100644 --- a/maps/bin/MAPSFile.pm +++ b/maps/lib/MAPSFile.pm @@ -2,7 +2,7 @@ ################################################################################ # # File: $RCSfile: MAPSFile.pm,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: File manipulation routines for MAPS. # Author: Andrew@DeFaria.com # Created: Fri Nov 29 14:17:21 2002 @@ -27,17 +27,19 @@ use Exporter; Unlock ); -sub Lock { - my $file = shift; +sub Lock($) { + my ($file) = @_; + + flock($file, LOCK_EX); - flock ($file, LOCK_EX); # and, in case someone appended while we were waiting... seek ($file, 0, 2); } # lock -sub Unlock { - my $file = shift; - flock ($file,LOCK_UN); +sub Unlock($) { + my ($file) = @_; + + flock($file,LOCK_UN); } # unlock 1; diff --git a/maps/bin/MAPSLog.pm b/maps/lib/MAPSLog.pm similarity index 64% rename from maps/bin/MAPSLog.pm rename to maps/lib/MAPSLog.pm index d52587b..4a86954 100644 --- a/maps/bin/MAPSLog.pm +++ b/maps/lib/MAPSLog.pm @@ -2,7 +2,7 @@ ################################################################################# # # File: $RCSfile: MAPSLog.pm,v $ -# Revision: $Revision: 1.1 $ +# Revision: $Revision: 1.1 $ # Description: MAPS routines for logging. # Author: Andrew@DeFaria.com # Created: Fri Nov 29 14:17:21 2002 @@ -15,14 +15,14 @@ package MAPSLog; use strict; +use warnings; use FindBin; -use lib $FindBin::Bin; - -use MAPSDB; +use MAPS; use MAPSUtil; -use vars qw (@ISA @EXPORT); + +use vars qw(@ISA @EXPORT); use Exporter; @ISA = qw (Exporter); @@ -33,7 +33,6 @@ use Exporter; GetStats Info Logmsg - countlog getstats @Types ); @@ -47,23 +46,17 @@ our @Types = ( 'nulllist' ); -sub countlog (;$$) { - my ($condition, $type) = @_; - - return MAPSDB::countlog $condition, $type; -} # countlog - -sub nbr_msgs ($) { +sub nbr_msgs($) { my ($sender) = @_; - return MAPSDB::FindEmail $sender; + return FindEmail($sender); } # nbr_msgs -sub GetStats (;$$) { +sub GetStats(;$$) { my ($nbr_days, $date) = @_; - $nbr_days ||= 1; - $date ||= Today2SQLDatetime + $nbr_days ||= 1; + $date ||= Today2SQLDatetime(); my %dates; @@ -74,10 +67,12 @@ sub GetStats (;$$) { my %stats; - foreach (@Types) { - my $condition = "log.type=\'$_\' and (log.timestamp > \'$sod\' and log.timestamp < \'$eod\')"; - $stats{$_} = countlog $condition, $_; - } # foreach + for (@Types) { + my $condition = "type=\'$_\' and (timestamp > \'$sod\' and timestamp < \'$eod\')"; + + # Not sure why I need to qualify countlog + $stats{$_} = MAPS::countlog($condition); + } # for $dates{$ymd} = \%stats; @@ -88,28 +83,37 @@ sub GetStats (;$$) { return %dates } # GetStats -sub Logmsg ($$$) { +sub Logmsg($$$) { my ($type, $sender, $msg) = @_; - AddLog $type, $sender, $msg; + # Todo: Why do I need to specify MAPS:: here? + MAPS::AddLog($type, $sender, $msg); + + return; } # logmsg -sub Debug ($) { +sub Debug($) { my ($msg) = @_; - Logmsg 'debug', '', $msg; + Logmsg('debug', '', $msg); + + return; } # Debug -sub Error ($) { +sub Error($) { my ($msg) = @_; - Logmsg 'error', '', $msg; + Logmsg('error', '', $msg); + + return; } # Error -sub Info ($) { +sub Info($) { my ($msg) = @_; - Logmsg 'info', '', $msg; + Logmsg('info', '', $msg); + + return; } # info 1; diff --git a/maps/bin/MAPSUtil.pm b/maps/lib/MAPSUtil.pm similarity index 96% rename from maps/bin/MAPSUtil.pm rename to maps/lib/MAPSUtil.pm index 82f7bc7..4a2a97d 100644 --- a/maps/bin/MAPSUtil.pm +++ b/maps/lib/MAPSUtil.pm @@ -15,6 +15,8 @@ package MAPSUtil; use strict; +use warnings; + use vars qw (@ISA @EXPORT); BEGIN { @@ -125,10 +127,10 @@ sub SubtractDays { # Adjust if crossing year boundary if ($days <= 0) { $year--; - $days_in_year = (($year % 4) eq 0) ? 366 : 365; + $days_in_year = (($year % 4) == 0) ? 366 : 365; $days = $days_in_year + $days; } else { - $days_in_year = (($year % 4) eq 0) ? 366 : 365; + $days_in_year = (($year % 4) == 0) ? 366 : 365; } # if # Convert back @@ -158,8 +160,8 @@ sub SubtractDays { return $year . '-' . $month . '-' . $days . substr $timestamp, 10; } # SubtractDays -sub UnixDatetime2SQLDatetime { - my $datetime = shift; +sub UnixDatetime2SQLDatetime($) { + my ($datetime) = @_; my $orig_datetime = $datetime; my %months = ( @@ -258,7 +260,7 @@ sub UnixDatetime2SQLDatetime { } # UnixDatetime2SQLDatetime sub Today2SQLDatetime { - return UnixDatetime2SQLDatetime scalar localtime; + return UnixDatetime2SQLDatetime(scalar localtime); } # Today2SQLDatetime 1; diff --git a/maps/bin/MAPSWeb.pm b/maps/lib/MAPSWeb.pm similarity index 96% rename from maps/bin/MAPSWeb.pm rename to maps/lib/MAPSWeb.pm index f167aae..3b68a80 100644 --- a/maps/bin/MAPSWeb.pm +++ b/maps/lib/MAPSWeb.pm @@ -14,10 +14,7 @@ package MAPSWeb; use strict; - -use FindBin; - -use lib $FindBin::Bin; +#use warnings; use MAPS; use MAPSLog; @@ -38,19 +35,19 @@ use Exporter; NavigationBar ); -sub getquickstats { - my $date = shift; +sub getquickstats($) { + my ($date) = @_; my %dates = GetStats (1, $date); for (@MAPSLog::Types) { $dates{$date}{processed} += $dates{$date}{$_}; - } # foreach + } # for return %dates; } # getquickstats -sub displayquickstats { +sub displayquickstats() { # Quick stats are today only. my $today = Today2SQLDatetime; my $time = substr $today, 11; @@ -107,14 +104,16 @@ sub displayquickstats { } # foreach print end_table; print end_div; + + return; } # displayquickstats -sub Footing (;$) { +sub Footing(;$) { my ($table_name) = @_; # General footing (copyright). Note we calculate the current year # so that the copyright automatically extends itself. - my $year = substr ((scalar (localtime)), 20, 4); + my $year = substr((scalar (localtime)), 20, 4); print start_div {-class => "copyright"}; print "Copyright © 2001-$year - All rights reserved"; @@ -129,15 +128,19 @@ sub Footing (;$) { print "" if $table_name; print end_html; + + return; } # Footing -sub Debug ($) { +sub Debug($) { my ($msg) = @_; print br, font ({ -class => 'error' }, 'DEBUG: '), $msg; + + return; } # Debug -sub DisplayError ($) { +sub DisplayError($) { my ($errmsg) = @_; print h3 ({-class => 'error', @@ -150,7 +153,7 @@ sub DisplayError ($) { # This subroutine puts out the header for web pages. It is called by # various cgi scripts thus has a few parameters. -sub Heading ($$$$;$$@) { +sub Heading($$$$;$$@) { my ($action, # One of getcookie, setcookie, unsetcookie $userid, # User id (if setting a cookie) $title, # Title string @@ -253,8 +256,8 @@ sub Heading ($$$$;$$@) { return $userid } # Heading -sub NavigationBar { - my $userid = shift; +sub NavigationBar($) { + my ($userid) = @_; print start_div {-id => 'leftbar'}; diff --git a/maps/php/list.php b/maps/php/list.php index 81d65ed..8edb44a 100755 --- a/maps/php/list.php +++ b/maps/php/list.php @@ -119,13 +119,13 @@ $this_page = $next / $lines + 1;
+
- -- 2.17.1