From jay@loudcloud.com Thu Dec 28 00:55:02 2000 X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil] ["3764" "Wed" "27" "December" "2000" "16:52:06" "-0800" "jay@soffian.org" "jay@soffian.org" nil "119" "qqrbl" "^From:" nil nil "12" nil nil nil nil nil] nil) Return-Path: Delivered-To: nelson@desk.crynwr.com Received: (qmail 26980 invoked from network); 28 Dec 2000 00:55:02 -0000 Received: from ns1.crynwr.com (HELO ns.crynwr.com) (192.203.178.14) by desk.crynwr.com with SMTP; 28 Dec 2000 00:55:02 -0000 Received: (qmail 20495 invoked by uid 500); 28 Dec 2000 00:52:41 -0000 Delivered-To: nelson@ns.crynwr.com Received: (qmail 20492 invoked by alias); 28 Dec 2000 00:52:40 -0000 Delivered-To: alias-qmail-nelson@qmail.org Received: (qmail 20489 invoked from network); 28 Dec 2000 00:52:40 -0000 Received: from olly.loudcloud.com (HELO listproc.corp.loudcloud.com) (208.50.142.100) by www.qmail.org with SMTP; 28 Dec 2000 00:52:40 -0000 Received: from redshift.loudcloud.com (redshift.geek.loudcloud.com [192.168.0.152]) by listproc.corp.loudcloud.com (8.10.1/8.10.1) with ESMTP id eBS0q6E12871 for ; Wed, 27 Dec 2000 16:52:06 -0800 (PST) Received: (qmail 26253 invoked from network); 28 Dec 2000 00:52:06 -0000 Received: from localhost (127.0.0.1) by localhost with SMTP; 28 Dec 2000 00:52:06 -0000 X-Mailer: Mew version 1.95b3 on XEmacs 20.4 (Emerald) Mime-Version: 1.0 Content-Type: Multipart/Mixed; boundary="--Next_Part(Wed_Dec_27_16:52:06_2000_747)--" Content-Transfer-Encoding: 7bit Message-Id: <20001227165206N.jay@loudcloud.com> X-Dispatcher: imput version 20000113(IM136) Lines: 119 From: jay@soffian.org Sender: Jay Soffian 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)----