#!/usr/bin/perl

use Time::HiRes qw(gettimeofday tv_interval);

@skip = (
    "127.0.0.1",       # localhost
    # Tutaj należy dopisać serwery, które odbierają dla nas pocztę.
    # Sprawdzony zostanie adres z pierwszego nagłówka Received za nimi.
);

$uceprotect = "$ENV{HOME}/uceprotect";

$whitelist = qr/
    ^10\.|
    ^212\.126\.20\.|     # *.go2.pl (dsbl, kropka, njabl, spamcop)
    ^212\.77\.101\.160$| # smtp.wp.pl (psbl, spamcop)
    ^66\.218\.6[67]\.|   # *.grp.scd.yahoo.com (reynolds)
    ^66\.35\.250\.206$|  # lists.sourceforge.net (reynolds)
    ^217\.11\.133\.22$|  # software.com.pl (reynolds)
    ^217\.96\.227\.177$| # pah177.warszawa.sdi.tpnet.pl. (ordb)
    ^208\.31\.42\.42$|   # xuxa.iecc.com (wytnij)
    ^213\.180\.130\.(2[89]|3[0-6])$| # smtp*.poczta.onet.pl (wytnij)
    ^217\.74\.65\.138$|  # eri.interia.pl (wytnij)
    ^212\.244\.46\.40$   # tytan.lm.pl (njabl)
/x;

%blacklists = (
    'net.au'     => "t1.dnsbl.net.au",
    sorbs        => "dnsbl.sorbs.net",
    spews        => "l1.spews.dnsbl.sorbs.net",
    easynet      => "blackholes.easynet.nl",
    dyn_easynet  => "dynablock.easynet.nl",
    prox_easynet => "proxies.blackholes.easynet.nl",
    njabl        => "dnsbl.njabl.org",
    psbl         => "psbl.surriel.com",
    dsbl         => "list.dsbl.org",
    cbl          => "cbl.abuseat.org",
    spamcop      => "bl.spamcop.net",
    spamhaus     => "sbl.spamhaus.org",
    blitzed      => "opm.blitzed.org",
    wytnij       => "spam.wytnij.to",
    ordb         => "relays.ordb.org",
    kropka       => "all.rbl.kropka.net",
    rangers      => "dnsbl.rangers.eu.org",
    wsff         => "will-spam-for-food.eu.org",
    echelon      => "rbl.echelon.pl",
    bogons       => "bogons.dnsiplists.completewhois.com",
    hijacked     => "hijacked.dnsiplists.completewhois.com",
);

$skip = join("|", map {"\Q$_\E"} @skip);
$skip = qr/^$skip$/;

@headers = ();
@received = ();
$in_received = 0;
$has_body = 0;

sub check_uceprotect($) {
    defined $uceprotect or return 0;
    open UCEPROTECT, $uceprotect or return 0;
    while (<UCEPROTECT>) {
        next if /^#/;
        /^(\S+) / or next;
        if ($ip eq $1) {
            close UCEPROTECT;
            return 1;
        }
    }
    close UCEPROTECT;
    return 0;
}

sub check_ip($$) {
    my ($ip, $verbose) = @_;
    unless ($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
        return "Bad IP ($ip)";
    }
    my $reverse_ip = "$4.$3.$2.$1";
    my @found = ();
    foreach $bl (sort keys %blacklists) {
        my $t0;
        if ($verbose) {$t0 = [gettimeofday]}
        ($name, $aliases, $addrtype, $length, @addrs) =
          gethostbyname("$reverse_ip.$blacklists{$bl}.");
        if ($verbose) {
            my $time = tv_interval($t0, [gettimeofday]);
            printf "%-12s - %-3s (%.2f)\n", $bl, (@addrs ? 'Yes' : 'No'), $time;
        }
        if (@addrs) {push @found, $bl}
    }
    if (check_uceprotect($ip)) {push @found, "uceprotect"}
    if (@found) {
        return "Yes ($ip listed by " . join(", ", @found) . ")";
    } else {
        return "No ($ip)";
    }
}

if (@ARGV) {
    $verbose = 0;
    if ($ARGV[0] eq "-v") {
        $verbose = 1;
        shift @ARGV;
    }
    $ip = $ARGV[0];
    $descr = check_ip $ip, $verbose;
    print "$descr\n";
    exit;
}

while (<>) {
    s/\r$//;
    if ($_ eq "\n") {$has_body = 1; last}
    push @headers, $_;
    if (/^[ \t]/) {
        if ($in_received) {
            s/\n$//;
            s/^[ \t]*//;
            $received .= " $_";
        }
    } else {
        if ($in_received) {
            push @received, $received;
            $in_received = 0;
        }
        if (/^Received:/i) {
            s/\n$//;
            $received = $_;
            $in_received = 1;
        }
    }
}

if ($in_received) {
    push @received, $received;
    $in_received = 0;
}

$received = "";
$descr = "No";
foreach (@received) {
    if (/^Received: from [^[]*\[(?:::ffff:)?(\d+\.\d+\.\d+\.\d+)\]/) {
        $received = $_;
        $ip = $1;
        next if $ip =~ $skip;
        if ($ip =~ $whitelist) {
            $descr = "No ($ip whitelisted)";
            last;
        }
        $descr = check_ip $ip, 0;
        last;
    }
}

open LOG, ">>$ENV{HOME}/.mail-blacklists.log";
print LOG "$descr; $received\n";
close LOG;
print @headers, "X-Blacklisted: $descr\n";
if ($has_body) {
    print "\n";
    print while <>;
}