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)----