--- /usr/sbin/bogofilter-milter-1.33.pl 2007-08-01 19:56:32.000000000 -0400
+++ /usr/sbin/bogofilter-milter-1.33-new.pl     2007-08-08 22:30:22.000000000 -0400
@@ -24,8 +24,9 @@

 # You will need the following non-standard Perl modules installed to
 # use this script: Sendmail::Milter, Mail::Alias, Proc::Daemon,
-# IO::Stringy.  Before using this script, search for CONFIGURABLE
-# SETTINGS and configure them appropriately for your site.
+# IO::Stringy, Socket, Net::CIDR, DB_File, POSIX.  Before using this
+# script, search for CONFIGURABLE SETTINGS and configure them
+# appropriately for your site.
 #
 # Inserts "X-Bogosity: Spam, tests=bogofilter" into messages that
 # appear to be spam (or "Ham" into ones that don't).  If the message is
@@ -78,6 +79,14 @@
     "If it isn't, resend it with $magic_string " .
     "in the Subject line.";

+# Whitelist any IP addresses or ranges from this filter
+our @whitelist = ("127.0.0.1");
+
+# If you want to whitelist any addresses which have authenticated
+# via poprelayd (i.e. remote workstations of users on your server)
+# set $dbfile to your popip.db location, else set it to undef
+our $dbfile = "/etc/mail/popip.db";
+
 # The largest message to keep in memory rather than writing to a
 # temporary file.
 my $MAX_INCORE_MSG_LENGTH = 1000000;
@@ -197,6 +206,10 @@
 use IO::Scalar;
 use IPC::Open2;
 use Data::Dumper;
+use Socket;
+use Net::CIDR;
+use DB_File;
+use POSIX;

 $Data::Dumper::Indent = 0;

@@ -210,6 +223,7 @@

 my %my_milter_callbacks =
 (
+ 'connect' => \&my_connect_callback,
  'envrcpt' => \&my_rcpt_callback,
  'header'  => \&my_header_callback,
  'eoh'     => \&my_eoh_callback,
@@ -233,6 +247,26 @@
 my $magic_string_re = $magic_string;
 $magic_string_re =~ s/(\W)/\\$1/g;

+# convert whitelist into CIDR notation
+our @cidr_list = ();
+foreach my $IP (@whitelist) {
+  if (not eval {@cidr_list = Net::CIDR::cidradd ($IP, @cidr_list)}) {
+    &die("Error processing whitelist: \"$IP\" is not a valid IP address or range.");
+  }
+}
+
+# add popip database to whitelist
+our %db;
+if ($dbfile) {
+  &opendb_read;
+  foreach my $IP (keys(%db)) {
+    if (not eval {@cidr_list = Net::CIDR::cidradd ($IP, @cidr_list)}) {
+      &die("Error processing $dbfile: \"$IP\" is not a valid IP address.");
+    }
+  }
+  &closedb;
+}
+
 setlogsock('unix');
 openlog($whoami, 'pid', $log_facility);
 if (! $debug) {
@@ -262,6 +296,31 @@

 Sendmail::Milter::main($milter_interpreters);

+sub my_connect_callback {
+    my $ctx = shift; # milter context object
+    my $hostname = shift;       # The connection's host name.
+    my $sockaddr_in = shift;    # AF_INET portion of the host address, from getpeername(2) syscall
+    my ($port,$ipaddr) = Socket::unpack_sockaddr_in($sockaddr_in) or &die("Could not unpack socket address: $!");
+    $ipaddr = Socket::inet_ntoa($ipaddr); # translates it into a standard IPv4 address
+
+    &debuglog("my_connect_callback: entering with hostname=$hostname, ipaddr=$ipaddr, port=$port");
+
+    # check if the connecting server is listed in the whitelist
+    if (scalar @cidr_list)
+    {
+        if (eval {Net::CIDR::cidrlookup($ipaddr, @cidr_list)}) {
+          syslog('info', '%s', "$ipaddr is whitelisted, so this email is being accepted unfiltered.");
+          $ctx -> setpriv(undef);
+          return SMFIS_ACCEPT;
+        }
+        else { &debuglog("$ipaddr is not in the whitelist"); }
+    }
+
+    $ctx->setpriv(undef);
+    &debuglog("my_connect_callback: return CONTINUE with undef");
+    return SMFIS_CONTINUE;
+}
+
 sub my_rcpt_callback {
     my $ctx = shift;
     my $hash = $ctx->getpriv();
@@ -737,6 +796,14 @@
     }
 }

+sub opendb_read {
+    tie(%db, "DB_File", $dbfile, O_RDONLY, 0, $DB_HASH) or &die("Can't open $dbfile: $!");
+}
+
+sub closedb {
+    untie %db;
+}
+
 sub die {
     my(@msg) = @_;