qqrbl

From: jay@soffian.org
To: nelson@qmail.org
Subject: qqrbl
Date: Wed, 27 Dec 2000 16:52:06 -0800

----Next_Part(Wed_Dec_27_16:52:06_2000_747)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


Russ,

Find attached a quick script I hacked up to use with Bruce Guenter's
QMAILQUEUE patch. I have it installed on my system as
/var/qmail/libexec/qqrbl and run it via
':allow,QMAILQUEUE="/var/qmail/libexec/qqrbl"' in my tcpserver config
file.

Uses the Mail::RBL module (note that Mail::RBL thinks it requires a
really recent version of Perl, but if you change the 'our $VERSION'
variable to 'use vars qw($VERSION)' and get rid of the 'use
warnings.pm', it runs just fine under 5.005_03.

Real simple script, basically, it groks the IP's out of every
Received: line and runs them through all three RBL's at mail-abuse.org
(easy enough to edit the script to change that) and adds an 'X-RBL:'
header for every match, making filtering down the line easier.

I considered just using a simple bourne shell script with Bruce's
qmail-qfilter and rblcheck, but this seems more elegant. :)

Please post on qmail.org as you see fit.

Thanks.

j.


----Next_Part(Wed_Dec_27_16:52:06_2000_747)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename=qqrbl

#!/usr/bin/perl
#
# Id     : qqrbl
# Author : Jay Soffian <jay@soffian.org>
# Purpose: Runs IP's found in message Received: lines through rblcheck
#          and notes any positive hits by adding X-RBL: headers.
# History: Dec 27, 2000 - Initial.

use strict;
use Mail::RBL;

sub qqrbl {
  my $qmail_queue = "/var/qmail/bin/qmail-queue";
  my %rbls;
  foreach my $rbl (@_) {
    $rbls{$rbl} = new Mail::RBL($rbl);
  }

  # We get our message contents on fd0 from qmail-smtpd or ofmipd.
  open(SMTPEIN, "<&=0") or fail(54, "dup(fd0) failed (#4.3.0) - $!");

  # Create a pipe so we can wedge ourselves between qmail-smtpd/ofmipd and
  # qmail-queue. We pass fd1 (the message envelope) straight through since
  # we don't care about it for purposes of rblchecks.
  pipe (QQEIN, QQEOUT)  or fail(51, "pipe() failed (#4.3.0) - $!");

  my $qq_pid = fork;
  fail(51, "fork() failed (#4.3.0) - $!") unless defined $qq_pid;

  if ($qq_pid == 0) { # child (exec qmail-queue)
    # unset QMAILQUEUE so that we don't get executed again by accident, 
    # causing an infinite loop.
    delete $ENV{QMAILQUEUE}; 
    close QQEOUT;     # don't need this half of the pipe
    # wedge between stdin and the pipe
    open (STDIN, "<&QQEIN") or fail(54, "dup(pipe) failed (#4.3.0) - $!");
    exec $qmail_queue       or fail(51, "exec($qmail_queue) failed (#4.3.0) - $!");
  
  } else { # parent
    $SIG{'PIPE'} = 'IGNORE'; 
    close QQEIN;# don't need this half of the pipe.
    
    my %ips;
    while(<SMTPEIN>) {  
      if (1 .. /^$/) {
        map {$ips{$_} = 1} /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/g if /^Received:/;
        if (/^$/) {
	  foreach my $rbl (sort keys %rbls) {
            foreach my $ip (keys %ips) {
              print QQEOUT "X-RBL: $ip is listed by $rbl\n" if $rbls{$rbl}->check($ip);
            }
          }
        }
      }
      print QQEOUT $_;      # pass message along to qmail-queue
    }
  
    # close everything properly
    close SMTPEIN or fail(54,"close(smtp in) failed (#4.3.0) - $!");
    close QQEOUT  or fail(53,"close(qq out) failed (#4.3.0) - $!");
    
    # make sure qmail-queue exits okay
    waitpid ($qq_pid,0);
    my ($status) = ($? >> 8);
    fail($status, "qmail-queue failed ($status). (#4.3.0)") unless $status == 0;
  }
}
qqrbl(qw(    relays.mail-abuse.org
            dialups.mail-abuse.org
         blackholes.mail-abuse.org
        )
     );
exit 0;

sub fail {
  my ($exitval, $msg) = @_;
  warn $msg,"\n";
  exit($exitval);
}

----Next_Part(Wed_Dec_27_16:52:06_2000_747)----