#################################################################################
#
# File: $RCSfile: MAPS.pm,v $
-# Revision: $Revision: 1.1 $
+# 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
sub Whitelist;
BEGIN {
- my $MAPS_username = "mapsadmin";
- my $MAPS_password = "mapsadmin";
+ my $MAPS_username = "maps";
+ my $MAPS_password = "spam";
OpenDB $MAPS_username, $MAPS_password;
} # BEGIN
Info "Removed $count emails from $sender"
} # Add2Blacklist
-sub Add2Nulllist ($$;$) {
+sub Add2Nulllist ($$;$$) {
# Add2Nulllist will add an entry to the nulllist
- my ($sender, $userid, $comment) = @_;
+ 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;
+ AddList "null", $sender, 0, $comment, $hit_count;
# Log that we null listed the sender
Info "Added $sender to " . ucfirst $userid . "'s null list";
my ($dbsender, $subject, $timestamp, $message);
# Deliver old emails
- my $messages = 0;
- my $return_status = 0;
+ my $messages = 0;
+ my $return_status = 0;
while (($userid, $dbsender, $subject, $timestamp, $message) = GetEmail $handle) {
last
MAPSDB::AddEmail $sender, $subject, $data;
} # AddEmail
-sub AddList ($$$;$) {
- my ($listtype, $pattern, $sequence, $comment) = @_;
+sub AddList ($$$;$$$) {
+ my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_;
+
+ $hit_count //= CountMsg $pattern;
- MAPSDB::AddList $listtype, $pattern, $sequence, $comment, CountMsg $pattern;
+ MAPSDB::AddList $listtype, $pattern, $sequence, $comment, $hit_count, $last_hit;
} # AddList
sub AddUser ($$$$) {
Logmsg "nulllist", $sender, "Discarded message";
} # Nulllist
-sub OnBlacklist ($) {
- my ($sender) = @_;
+sub OnBlacklist ($;$) {
+ my ($sender, $update) = @_;
- return CheckOnList "black", $sender;
+ return CheckOnList "black", $sender, $update;
} # CheckOnBlacklist
-sub OnNulllist ($) {
- my ($sender) = @_;
+sub OnNulllist ($;$) {
+ my ($sender, $update) = @_;
- return CheckOnList "null", $sender;
+ return CheckOnList "null", $sender, $update;
} # CheckOnNulllist
-sub OnWhitelist {
- my ($sender, $userid) = @_;
+sub OnWhitelist ($;$$) {
+ my ($sender, $userid, $update) = @_;
if (defined $userid) {
MAPSDB::SetContext $userid;
} # if
- return CheckOnList "white", $sender;
+ return CheckOnList "white", $sender, $update;
} # OnWhitelist
sub OptimizeDB () {
# 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 $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
# Extract sender's address
if (/^from: .*/i) {
$_ = substr ($_, 6);
+
$sender_long = $_;
+
if (/<(\S*)@(\S*)>/) {
- $sender = lc ("$1\@$2");
+ $sender = lc ("$1\@$2");
} elsif (/(\S*)@(\S*)\ /) {
- $sender = lc ("$1\@$2");
+ $sender = lc ("$1\@$2");
} elsif (/(\S*)@(\S*)/) {
- $sender = lc ("$1\@$2");
+ $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");
+ $reply_to = lc ("$1\@$2");
} elsif (/(\S*)@(\S*)\ /) {
- $reply_to = lc ("$1\@$2");
+ $reply_to = lc ("$1\@$2");
} elsif (/(\S*)@(\S*)/) {
- $reply_to = lc ("$1\@$2");
+ $reply_to = lc ("$1\@$2");
} # if
- } else {
- next;
} # if
} # while
seek ($input, -length () - 1, 1) if !eof $input;
# Sanitize email addresses
- $envelope_sender =~ s/\<//g;
- $envelope_sender =~ s/\>//g;
- $envelope_sender =~ s/\"//g;
- $envelope_sender =~ s/\'//g;
- $sender =~ s/\<//g;
- $sender =~ s/\>//g;
- $sender =~ s/\"//g;
- $sender =~ s/\'//g;
- $reply_to =~ s/\<//g;
- $reply_to =~ s/\>//g;
- $reply_to =~ s/\"//g;
- $reply_to =~ s/\'//g;
-
- # Now let's pack the @data array to a scalar
- foreach (@data) {
- $data = $data . $_ . "\n";
- } # foreach
+ $envelope_sender =~ s/\<//g;
+ $envelope_sender =~ s/\>//g;
+ $envelope_sender =~ s/\"//g;
+ $envelope_sender =~ s/\'//g;
+ $sender =~ s/\<//g;
+ $sender =~ s/\>//g;
+ $sender =~ s/\"//g;
+ $sender =~ s/\'//g;
+ $reply_to =~ 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 "";
+ $sender = $envelope_sender if $sender eq "";
+ $reply_to = $sender if $reply_to eq "";
- return $sender, $sender_long, $reply_to, $subject, $data;
+ return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
} # ReadMsg
sub ResequenceList ($$) {
} # ReturnSenders
sub ReturnList ($$$) {
- my ($type, $start_at, $lines) = @_;
+ my ($type, $start_at, $lines) = @_;
return MAPSDB::ReturnList $type, $start_at, $lines;
} # ReturnList
my $to = "renn.leech\@compassbank.com";
my $msg = MIME::Entity->build (
- From => $sender,
- To => $to,
- Subject => $subject,
- Type => "text/html",
- Data => \@lines,
+ From => $sender,
+ To => $to,
+ Subject => $subject,
+ Type => "text/html",
+ Data => \@lines,
);
# Send it
# 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
+ 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
+ Type => "message",
+ Disposition => "attachment",
+ Data => \@spammsg
);
# Send it
return MAPSDB::Space $userid;
} # Space
-sub UpdateList ($$$$$$) {
- my ($userid, $type, $pattern, $domain, $comment, $sequence) = @_;
+sub UpdateList ($$$$$$$) {
+ my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
- return MAPSDB::UpdateList $userid, $type, $pattern, $domain, $comment, $sequence;
+ return MAPSDB::UpdateList $userid, $type, $pattern, $domain, $comment, $hit_count, $sequence;
} # UpdateList
sub UpdateUser ($$$$) {
} # UpdateUser
sub UpdateUserOptions ($@) {
- my ($userid, %options) = @_;
+ my ($userid, %options) = @_;
my $status;