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
# 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() {
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)----