#!/usr/bin/perl -w

# $Id: checkmail.pl,v 1.1.1.1 2002/09/30 14:55:22 xi Exp $

use strict;
use Mail::RBL;

# This script checks, whether any of the 'Received:'-headers contains
# IP addresses of open relays.
#
# If they do, the mail is bounced. If not, the mail is handed over to
# procmail for further processing.

my $procmail = '/usr/bin/procmail';
my $sendmail = '/usr/sbin/sendmail';
my $max_bounce_size = 500000;
my $logfile = '/home/xi/log/checkmail';

my $headers = '';
my $body = '';
my $returnpath;

my @relays = ();

logmsg ("Starting processing of mail.");

while (<STDIN>) {
    last if /^$/;

    $headers .= $_;

    if (/^Received:\s+from\s.*\[(\d{1,3}(\.\d{1,3}){3})\]/i) {
	push @relays, $1;
    } elsif (/^Received:\s+from\s.*\((\d{1,3}(\.\d{1,3}){3})\)/i) {
	push @relays, $1;
    } elsif (/^Return-Path: (.*)$/i) {
	$returnpath = $1;
    }
}

$body = join ('', <STDIN>);

# Do the relay check

my $rbl1 = new Mail::RBL('relays.ordb.org');
my $rbl2 = new Mail::RBL('bl.borderworlds.dk');

my $is_relay = 0;
my ($ip, $url);

foreach my $relay (@relays) {
    if ($rbl1->check($relay)) {
	$is_relay = 1;
	$ip = $relay;
	$url = "http://ordb.org/lookup/?host=$relay";
    } elsif ($rbl2->check($relay)) {
	$is_relay = 1;
	$ip = $relay;
	$url = "http://borderworlds.dk/bl.html";
    }
}

if ($is_relay) {
    logmsg("Mail was relayed through open relay, going to bounce.");
    bounce();
} else {
    logmsg("Mail seems to be ok, handing over to procmail");
    open (PIPE, "|$procmail") or die "Couldn't spawn procmail: $!";
    print PIPE $headers, "\n", $body;
    close PIPE;
}

#############################
# Function to bounce a mail #
#############################

sub bounce {
    if (defined $returnpath) {
	my $hostname = `/bin/hostname -f`;
	chomp $hostname;

	my $mimeseperator = rand()."/$hostname";

	$body = substr($body,0,$max_bounce_size);

	my $bounce = <<EOT;
From: MAILER-DAEMON\@$hostname (Mail Delivery System)
Subject: Undelivered Mail Returned to Sender
To: $returnpath
MIME-Version: 1.0
Content-Type: multipart/report; report-type=delivery-status;
	boundary="$mimeseperator"

This is a MIME-encapsulated message.

--$mimeseperator
Content-Description: Notification
Content-Type: text/plain

This is the relay check program at host $hostname.

I'm sorry to have to inform you that the message returned
below could not be delivered to one or more destinations.

For further assistance, please send mail to <postmaster>

If you do so, please include this problem report. You can
delete your own text from the message returned below.

The mail server $ip, through which your mail was sent is
an open relay.

For further details refer to the following url:

$url

                                  The relay check program

--$mimeseperator
Content-Description: Undelivered Message
Content-Type: message/rfc822

$headers
$body
--$mimeseperator--

EOT

        open (PIPE, "|$sendmail") or die "Couldn't spawn sendmail";
        print PIPE $bounce;
        close PIPE;

        logmsg ("Mail bounced to $returnpath");
    } else {
	logmsg ("No Return-Path in mail, cannot bounce");
    }
}

sub logmsg {
    my ($msg) = @_;

    open (LOGFILE, ">>$logfile") or die "Unable to open logfile: $!";
    print LOGFILE scalar(localtime), " [$$]: $msg\n";
    close LOGFILE;

    return 1;
}