Fixed long standing bug with hit_count

Seems I had a long standing bug with hit_count getting incremented each
time we checked if a sender was on a list. The On<list>List functions not
only checked if the sender was on the list but also, as a side effect,
incremented hit_count. But we didn't get another hit, we were simply
checking if this sender was on this list. The solution, semi kludgy, was
to add an option $update parameter. If true we update the hit_counter.
Also if unspecified we will default it to true and update the hit_counter.
But if we call these routines with $update set to false we won't update
hit_counter. Then change the places were we just want to check if on this
list to explicitly pass in false.

This bug reared it's head when I implemented the displaying of the rule
information in detail.cgi. In order to get the rule information I was
calling these On<list>List routines and suddenly I was seeing abnormally
high numbers of hits on just added nulllist entries. IOW I was calling
these routines more frequently and they were updating hit_count more
frequently so the bug got exposed. Note that this bug also was triggered
when calling checkaddress and checkaddress.cgi but since that was
infrequently done I didn't notice it.

diff --git a/maps/bin/MAPS.pm b/maps/bin/MAPS.pm
index dd7c672..bf6c82a 100644 (file)
--- a/maps/bin/MAPS.pm
+++ b/maps/bin/MAPS.pm
@@ -439,26 +439,26 @@ sub Nulllist ($;$$) {
   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 () {

diff --git a/maps/bin/MAPSDB.pm b/maps/bin/MAPSDB.pm
index 6fa6e9b..d4405f9 100644 (file)
--- a/maps/bin/MAPSDB.pm
+++ b/maps/bin/MAPSDB.pm
@@ -206,10 +206,12 @@ sub RecordHit ($$$) {
   return;
 } # RecordHit
 
-sub CheckOnList ($$) {
+sub CheckOnList ($$;$) {
   # CheckOnList will check to see if the $sender is on the $listfile.
   # Return 1 if found 0 if not.
-  my ($listtype, $sender) = @_;
+  my ($listtype, $sender, $update) = @_;
+
+  $update //= 1;
 
   my $status   = 0;
   my $rule;
@@ -264,7 +266,7 @@ sub CheckOnList ($$) {
       $rule  .= " - $comment" if $comment and $comment ne '';
       $status = 1;
 
-      RecordHit $listtype, $sequence, ++$hit_count;
+      RecordHit $listtype, $sequence, ++$hit_count if $update;
 
       last;
     } # if

diff --git a/maps/bin/checkaddress.cgi b/maps/bin/checkaddress.cgi
index 06c3bc9..0912182 100755 (executable)
--- a/maps/bin/checkaddress.cgi
+++ b/maps/bin/checkaddress.cgi
@@ -64,7 +64,7 @@ sub Body {
   # Then we process nulllist people.
   #
   # Finally, we handle return processing
-  ($onlist, $rule) = OnWhitelist $sender;
+  ($onlist, $rule) = OnWhitelist $sender, 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;
+    ($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;
+      ($onlist, $rule) = OnNulllist $sender, 0;
 
       if ($onlist) {
         print div {-align      => "center"},
@@ -95,10 +95,10 @@ sub Body {
     } # if
   } # if
 
-  print br div {-align => "center"},
-    submit (-name    => "submit",
-            -value   => "Close",
-            -onClick => "window.close (self)");
+  print br div {-align => "center"},
+    submit (-name      => "submit",
+            -value     => "Close",
+            -onClick   => "window.close (self)");
 } # Body
 
 sub Footing {

diff --git a/maps/bin/detail.cgi b/maps/bin/detail.cgi
index 12abc73..fe98a1b 100755 (executable)
--- a/maps/bin/detail.cgi
+++ b/maps/bin/detail.cgi
@@ -11,7 +11,8 @@
 #
 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
 #
-################################################################################use strict;
+################################################################################
+use strict;
 use warnings;
 
 use MIME::Words qw(:all);
@@ -177,13 +178,13 @@ sub PrintTable {
     my ($onlist, $rule);
     $rule = 'none';
 
-    ($onlist, $rule) = OnWhitelist $sender;
+    ($onlist, $rule) = OnWhitelist $sender, 0;
 
     unless ($onlist) {
-      ($onlist, $rule) = OnBlacklist $sender;
+      ($onlist, $rule) = OnBlacklist $sender, 0;
 
       unless ($onlist) {
-        ($onlist, $rule) = OnNulllist $sender;
+        ($onlist, $rule) = OnNulllist $sender, 0;
       } # unless
     } # unless
 
@@ -294,6 +295,7 @@ sub PrintTable {
 } # PrintTable
 
 # Main
+my $condition;
 my @scripts = ('ListActions.js');
 
 my $heading_date =$date ne '' ? ' on ' . FormatDate ($date) : '';