X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=maps%2Flib%2FMAPS.pm;h=96276123c0a69031cf71cc8ac9477f464cd4b9e2;hb=8666b497d1f10703a0eac60dd954b2538efe9609;hp=92a03218982087b04aa52b77a7d8e1e0100e7bf7;hpb=252d1ff39d76bc3a23c2c330e4529f72550bcded;p=clearscm.git

diff --git a/maps/lib/MAPS.pm b/maps/lib/MAPS.pm
index 92a0321..9627612 100644
--- a/maps/lib/MAPS.pm
+++ b/maps/lib/MAPS.pm
@@ -1,5 +1,4 @@
-#!/usr/bin/perl
-#################################################################################
+################################################################################
 #
 # File:         $RCSfile: MAPS.pm,v $
 # Revision:     $Revision: 1.1 $
@@ -39,6 +38,7 @@ our $VERSION = '2.0';
 # Globals
 my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER};
 my %useropts;
+my $mailLoopMax = 5;
 
 our @EXPORT = qw(
   Add2Blacklist
@@ -310,6 +310,9 @@ sub AddList(%) {
 sub AddLog(%) {
   my (%params) = @_;
 
+  # Some email senders are coming in mixed case. We don't want that
+  $params{sender} = $params{sender} ? lc $params{sender} : '';
+
   $params{timestamp} = UnixDatetime2SQLDatetime(scalar(localtime));
 
   return $db->add('log', %params);
@@ -360,7 +363,7 @@ sub Blacklist(%) {
   # Check to see if this sender has already emailed us.
   my $msg_count = $db->count('email', "userid='$rec{userid}' and sender like '%$rec{sender}%'");
 
-  if ($msg_count < 5) {
+  if ($msg_count < $mailLoopMax) {
     # Bounce email
     my @spammsg = split "\n", $rec{data};
 
@@ -420,6 +423,68 @@ sub CheckEmail(;$$) {
   } # if
 } # CheckEmail
 
+sub CheckOnList2 ($$;$) {
+  # CheckOnList will check to see if the $sender is on the list.  Return 1 if
+  # found 0 if not.
+  my ($listtype, $sender, $update) = @_;
+
+  $update //= 1;
+
+  my ($status, $rule, $sequence);
+
+  my $table      = 'list';
+  my $condition  = "userid='$userid' and type='$listtype'";
+
+  my ($err, $errmsg) = $db->find($table, $condition, '*', 'order by sequence');
+
+  my ($email_on_file, $rec);
+
+  while ($rec = $db->getnext) {
+    unless ($rec->{domain}) {
+      $email_on_file = $rec->{pattern};
+    } else {
+      unless ($rec->{pattern}) {
+        $email_on_file = '@' . $rec->{domain};
+      } else {
+        $email_on_file = $rec->{pattern} . '@' . $rec->{domain};
+      } # if
+    } # unless
+
+    # Escape some special characters
+    $email_on_file =~ s/\@/\\@/;
+    $email_on_file =~ s/^\*/.\*/;
+
+    # We want to terminate the search string with a "$" iff there's an
+    # "@" in there. This is because some "email_on_file" may have no
+    # domain (e.g. "mailer-daemon" with no domain). In that case we
+    # don't want to terminate the search string with a "$" rather we
+    # wish to terminate it with an "@". But in the case of say
+    # "@ti.com" if we don't terminate the search string with "$" then
+    # "@ti.com" would also match "@tixcom.com"!
+    my $search_for = $email_on_file =~ /\@/
+                   ? "$email_on_file\$"
+                   : !defined $rec->{domain}
+                   ? "$email_on_file\@"
+                   : $email_on_file;
+    if ($sender and $sender =~ /$search_for/i) {
+      $status = 1;
+
+      $rec->{hit_count} //= 0;
+
+      RecordHit(
+        userid    => $userid,
+        type      => $listtype,
+        sequence  => $rec->{sequence},
+        hit_count => $rec->{hit_count} + 1,
+      ) if $update;
+
+      last;
+    } # if
+  } # while
+
+  return ($status, $rec);
+} # CheckOnList2
+
 sub CheckOnList ($$;$) {
   # CheckOnList will check to see if the $sender is on the list.  Return 1 if 
   # found 0 if not.
@@ -865,13 +930,13 @@ sub Nulllist($;$$) {
 sub OnBlacklist($;$) {
   my ($sender, $update) = @_;
 
-  return CheckOnList('black', $sender, $update);
+  return CheckOnList2('black', $sender, $update);
 } # OnBlacklist
 
 sub OnNulllist($;$) {
   my ($sender, $update) = @_;
 
-  return CheckOnList('null', $sender, $update);
+  return CheckOnList2('null', $sender, $update);
 } # CheckOnNulllist
 
 sub OnWhitelist($;$$) {
@@ -879,7 +944,7 @@ sub OnWhitelist($;$$) {
 
   SetContext($userid) if $userid;
 
-  return CheckOnList('white', $sender, $update);
+  return CheckOnList2('white', $sender, $update);
 } # OnWhitelist
 
 sub OptimizeDB() {
@@ -901,67 +966,67 @@ sub 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;
+  my (%msgInfo, @data, $envelope_sender);
 
-  # Find first message's "From " line indicating start of message
+  # Reads an email message file from $input. Returns sender, subject, date and
+  # data, which is a copy of the entire message. Find first message's "From "
+  # line indicating start of message.
   while (<$input>) {
     chomp;
     last if /^From /;
   } # while
 
   # If we hit eof here then the message was garbled. Return indication of this
-  if (eof($input)) {
-    $data = "Garbled message - unable to find From line";
-    return $sender, $sender_long, $reply_to, $subject, $data;
-  } # if
+  return if eof($input);
 
   if (/From (\S*)/) {
-    $envelope_sender = $1;
-    $sender_long     = $envelope_sender;
+    $msgInfo{sender_long} = $envelope_sender = $1;
   } # if
 
   push @data, $_ if /^From /;
 
   while (<$input>) {
-    chomp;
+    chomp; chop if /\r$/;
+
     push @data, $_;
 
     # Blank line indicates start of message body
-    last if ($_ eq "" || $_ eq "\r");
+    last if ($_ eq '' || $_ eq "\r");
 
     # Extract sender's address
-    if (/^from: .*/i) {
-      $_ = substr ($_, 6);
-
-      $sender_long = $_;
-
-      if (/<(\S*)@(\S*)>/) {
-        $sender = lc ("$1\@$2");
-      } elsif (/(\S*)@(\S*)\ /) {
-        $sender = lc ("$1\@$2");
-      } elsif (/(\S*)@(\S*)/) {
-        $sender = lc ("$1\@$2");
+    if (/^from: (.*)/i) {
+      $msgInfo{sender_long} = $msgInfo{sender} = $1;
+
+      if ($msgInfo{sender} =~ /<(\S*)@(\S*)>/) {
+        $msgInfo{sender} = lc ("$1\@$2");
+      } elsif ($msgInfo{sender} =~ /(\S*)@(\S*)\ /) {
+        $msgInfo{sender} = lc ("$1\@$2");
+      } elsif ($msgInfo{sender} =~ /(\S*)@(\S*)/) {
+        $msgInfo{sender} = lc ("$1\@$2");
+      } # if
+    } elsif (/^subject: (.*)/i) {
+      $msgInfo{subject} = $1;
+    } elsif (/^reply-to: (.*)/i) {
+      $msgInfo{reply_to} = $1;
+
+      if ($msgInfo{reply_to} =~ /<(\S*)@(\S*)>/) {
+        $msgInfo{reply_to} = lc ("$1\@$2");
+      } elsif ($msgInfo{reply_to} =~ /(\S*)@(\S*)\ /) {
+        $msgInfo{reply_to} = lc ("$1\@$2");
+      } elsif ($msgInfo{reply_to} =~ /(\S*)@(\S*)/) {
+        $msgInfo{reply_to} = lc ("$1\@$2");
       } # if
-    } elsif (/^subject: .*/i) {
-      $subject = substr ($_, 9);
-    } elsif (/^reply-to: .*/i) {
-      $_ = substr ($_, 10);
-      if (/<(\S*)@(\S*)>/) {
-        $reply_to = lc ("$1\@$2");
-      } elsif (/(\S*)@(\S*)\ /) {
-        $reply_to = lc ("$1\@$2");
-      } elsif (/(\S*)@(\S*)/) {
-        $reply_to = lc ("$1\@$2");
+    } elsif (/^to: (.*)/i) {
+      $msgInfo{to} = $1;
+
+      if ($msgInfo{to} =~ /<(\S*)@(\S*)>/) {
+        $msgInfo{to} = lc ("$1\@$2");
+      } elsif ($msgInfo{to} =~ /(\S*)@(\S*)\ /) {
+        $msgInfo{to} = lc ("$1\@$2");
+      } elsif ($msgInfo{to} =~ /(\S*)@(\S*)/) {
+        $msgInfo{to} = lc ("$1\@$2");
       } # if
     } # if
   } # while
@@ -971,48 +1036,57 @@ sub ReadMsg($) {
     chomp;
 
     last if (/^From /);
+
     push @data, $_;
   } # while
 
   # Set file pointer back by length of the line just read
-  seek ($input, -length () - 1, 1) if !eof $input;
+  seek ($input, -length() - 1, 1) if !eof $input;
 
   # Sanitize email addresses
-  $envelope_sender =~ s/\<//g;
-  $envelope_sender =~ s/\>//g;
-  $envelope_sender =~ s/\"//g;
-  $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;
+  $envelope_sender   =~ s/\<//g;
+  $envelope_sender   =~ s/\>//g;
+  $envelope_sender   =~ s/\"//g;
+  $envelope_sender   =~ s/\'//g;
+
+  $msgInfo{sender}   =~ s/\<//g;
+  $msgInfo{sender}   =~ s/\>//g;
+  $msgInfo{sender}   =~ s/\"//g;
+  $msgInfo{sender}   =~ s/\'//g;
+
+  if ($msgInfo{reply_to}) {
+    $msgInfo{reply_to} =~ s/\<//g;
+    $msgInfo{reply_to} =~ s/\>//g;
+    $msgInfo{reply_to} =~ s/\"//g;
+    $msgInfo{reply_to} =~ s/\'//g;
+  } # if
 
   # Determine best addresses
-  $sender    = $envelope_sender if $sender eq "";
-  $reply_to  = $sender          if $reply_to eq "";
+  $msgInfo{sender}   = $envelope_sender unless $msgInfo{sender};
+  $msgInfo{reply_to} = $msgInfo{sender} unless $msgInfo{reply_to};
+
+  $msgInfo{data} = join "\n", @data;
 
-  return $sender, $sender_long, $reply_to, $subject, join "\n", @data;
+  return %msgInfo;
 } # ReadMsg
 
 sub RecordHit(%) {
   my (%rec) = @_;
 
-  CheckParms(['userid', 'type', 'sequence', ], \%rec);
-
-  my $current_date = UnixDatetime2SQLDatetime(scalar(localtime));
+  CheckParms(['userid', 'type', 'sequence'], \%rec);
 
   my $table     = 'list';
-  my $condition = "userid='rec{userid} and type=$rec{type} and sequence='$rec{sequence}";
+  my $condition = "userid='$rec{userid}' and type='$rec{type}' and sequence='$rec{sequence}'";
 
-  return $db->modify(
-    table     => $table,
-    condition => $condition,
-    %rec,
-  );
+  # We don't need these fields in %rec as we are not updating them
+  delete $rec{sequence};
+  delete $rec{type};
+  delete $rec{userid};
+
+  # We are, however, updating last_hit
+  $rec{last_hit} = UnixDatetime2SQLDatetime(scalar(localtime));
+
+  return $db->modify($table, $condition, %rec);
 } # RecordHit
 
 sub ResequenceList(%) {
@@ -1085,7 +1159,7 @@ sub ReturnMsg(%) {
   # Check to see if this sender has already emailed us.
   my $msg_count = $db->count('email', "userid='$userid' and sender like '%$params{sender}%'");
 
-  if ($msg_count < 5) {
+  if ($msg_count < $mailLoopMax) {
     # Return register message
     SendMsg(
       userid   => $params{userid},
@@ -1174,20 +1248,27 @@ sub ReturnSenders(%) {
       unless $senders{$rec->{sender}};
   } # while
 
-  # Make a hash whose keys are the timestamp (so we can later sort on
-  # them).
-  my %sendersByTimestamp = reverse %senders;
-
-  my @senders;
+  my (@unsorted, @senders);
+
+  # Here we have a hash in %senders that has email address and timestamp. In the
+  # past we would merely create a reverse hash by timestamp and sort that. The
+  # The problem is that it is possible for two emails to come in with the same
+  # timestamp. By reversing the hash we clobber any row that has a dumplicte
+  # timestamp. But we want to sort on timestamp. So first we convers this hash
+  # to an array of hashes and then we can sort by timestamp later.
+  while (my ($key, $value) = each %senders) {
+    push @unsorted, {
+      sender    => $key,
+      timestamp => $value,
+    };
+  } # while
 
-  # Sort by timestamp desc and push on to the @senders array
-  push @senders, $sendersByTimestamp{$_}
-    for (sort { $b cmp $a } keys %sendersByTimestamp);
+  push @senders, $_->{sender} for sort { $b->{timestamp} cmp $a->{timestamp}} @unsorted;
 
   # Finally slice for the given range
-  my $end_at = $params{start_at} + $params{lines} - 1;
+  my $end_at = $params{start_at} + ($params{lines} - 1);
 
-  $end_at = (@senders - 1) if $end_at >= @senders;
+  $end_at = (@senders) - 1 if $end_at >= @senders;
 
   return (@senders) [$params{start_at} .. $end_at];
 } # ReturnSenders
@@ -1393,14 +1474,29 @@ sub Whitelist ($$;$$) {
 
   # Dump message into a file
   open my $message, '>', "/tmp/MAPSMessage.$$"
-    or Error("Unable to open message file (/tmp/MAPSMessage.$$): $!\n"), return -1;
+    or error("Unable to open message file (/tmp/MAPSMessage.$$): $!\n"), return -1;
 
   print $message $data;
 
   close $message;
 
   # Now call MAPSDeliver
-  my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
+  my ($status, @output) = Execute "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
+  #my $status = system "$FindBin::Bin/MAPSDeliver $userid /tmp/MAPSMessage.$$";
+
+  if ($status != 0) {
+    my $msg =  "Unable to deliver message (message left at /tmp/MAPSMessage.%%\n\n";
+       $msg .= join "\n", @output;
+
+    Logmsg(
+      userid  => $userid,
+      type    => 'whitelist',
+      sender  => $sender,
+      message => $msg,
+    );
+
+    Error ($msg, 1);
+  } # if
 
   unlink "/tmp/MAPSMessage.$$";
 
@@ -1411,8 +1507,8 @@ sub Whitelist ($$;$$) {
       sender  => $sender, 
       message => 'Delivered message',
     );
-  } else { 
-    Error("Unable to deliver message - is MAPSDeliver setgid? - $!");
+  } else {
+    error("Unable to deliver message - is MAPSDeliver setgid? - $!", $status);
   } # if
 
   $hit_count++ if $sequence;