minor upgrades

1 files changed, 44 insertions, 8 deletions

diff --git a/tools/blacklist-update b/tools/blacklist-update
index 99fe4cc..4621ef2 100755
--- a/tools/blacklist-update
+++ b/tools/blacklist-update
@@ -1,9 +1,33 @@
 #! /usr/bin/perl -w
 
+#########################
+# BEWARE:
+#
+# The most dangerous criminals routinely forge email from-addresses.
+# Therefore blacklisting addresses only works for senders
+# who have bad manners but are otherwise quasi-legitimate.
+#
+# Overuse of blacklisting will punish innocent parties
+# whose domain-names look nice to forgers.
+
+## hint:  mail-scan +from * | iconv -c \...
+##  | sed 's/.*@//;s/>$//' | sort | uniq -c | sort -nr > some-junk.from-count
+
 use strict;
 use Symbol;
 
 main: {
+  my $baremode = 0;
+  my @argv = @ARGV;
+  @ARGV = ();
+  while (@argv){
+    my $arg = shift @argv;
+    if ($arg eq '-bare') {
+      $baremode++;
+    } else {
+      die "Unrecognized verbiage '$arg'\n";
+    }
+  }
   my $file = '/etc/mail/spamassassin/local.cf';
   my $inch = Symbol::gensym;
   my $mainpart = '';
@@ -15,6 +39,7 @@ main: {
     chomp $line;
     my @stuff = split(' ', $line, 2);
     if (0+@stuff == 2 && $stuff[0] eq $verb) {
+        my $key = lc($stuff[1]);
         $blacklist{$stuff[1]} ++;
     } else {
       $mainpart .= $line . "\n";
@@ -23,23 +48,34 @@ main: {
   close $inch;
   my $unchanged = 0;
   my $new = 0;
-  while (my $line=<>){
+  liner: while (my $line=<>){
     chomp $line;
-    if ($line =~ m'<.*@(.*)>$') {
-      my $key = "*@" . $1;
+    my $domain = '';
+    if ($baremode) {
+      my @stuff = split(' ', $line);
+      $domain = $stuff[$#stuff];
+    } else {
+      if ($line =~ m'<.*@(.*)>$') {
+        $domain = $1;
+      } else {
+        print STDERR "no '<user\@domain>'; ignoring line ...\n";
+        print STDERR "... '$line'\n";
+        next liner;
+      }
+    }
+    if ($domain ne '') {
+      my $key = "*@" . lc($domain);
       if (exists $blacklist{$key}) {
         $unchanged++;
       } else {
         $new++;
       }
-      $blacklist{$key} ++;      
-    } else {
-      print STDERR "no '<user\@domain>'; ignoring line ...\n";
-      print STDERR "... '$line'\n";
+      $blacklist{$key} ++;
     }
+
   }
 
-  my $ouch = Symbol::gensym;  
+  my $ouch = Symbol::gensym;
   open($ouch, '>', $file)
     || die "Could not open output file '$file'\n";
   print $ouch $mainpart;