#!/opt/gnu/bin/perl -w # # rblhosts.pl # # Will Harris (will@harris.ch) # 04.04.2000 # # This script may be freely copied, distributed, and modified as long as # this notice is included intact in any redistributions # use strict; use Socket; my %rblfirst; my %rbllast; my %rssfirst; my %rsslast; my %orbsfirst; my %orbslast; my %dulfirst; my %dullast; my %midfirst; my %midlast; my %iptoname; my $tstamp; my $host; my $rbl; my $orbs; my $rss; my $dul; my $mid; my $htmlfile = '/home/arvo/www/data/HowTo/pp/spammers.html'; &proclog("/usr/qmail/log/qmail/oldcurrent"); &proclog("/usr/qmail/log/qmail/current"); if (@ARGV == 1 && $ARGV[0] eq 'h') { &printhtml; } else { &printlog; } sub resolve { my $ip = shift; my $is = inet_aton($ip); if (defined($is)) { my ($address,$aliases,@junk) = gethostbyaddr($is,AF_INET); if (defined($address)) { return $address; } else { return $ip; } } else { return $ip; } } sub proclog { my $logfile = shift; my @lines; open(LOG,"< $logfile") or die "Can't open tcpserver log $logfile: $!\n"; @lines = ; close(LOG); my @buffer = grep /rblcheck.*?:.:.:.:.\/did/, @lines; while (@buffer) { $_ = shift @buffer; push @lines, $_; m#^(@.*?)\sdelivery.*from_(.*?)_(.):(.):(.):(.):(.)/did.*#; $tstamp = $1; $host = $2; $rbl = $3; $orbs = $4; $rss = $5; $dul = $6; $mid = $7; if ($rbl) { unless (exists $rblfirst{$host}) { $rblfirst{$host} = $tstamp; $rbllast{$host} = $tstamp; } else { $rbllast{$host} = $tstamp; } } if ($orbs) { unless (exists $orbsfirst{$host}) { $orbsfirst{$host} = $tstamp; $orbslast{$host} = $tstamp; } else { $orbslast{$host} = $tstamp; } } if ($rss) { unless (exists $rssfirst{$host}) { $rssfirst{$host} = $tstamp; $rsslast{$host} = $tstamp; } else { $rsslast{$host} = $tstamp; } } if ($dul) { unless (exists $dulfirst{$host}) { $dulfirst{$host} = $tstamp; $dullast{$host} = $tstamp; } else { $dullast{$host} = $tstamp; } } if ($mid) { unless (exists $midfirst{$host}) { $midfirst{$host} = $tstamp; $midlast{$host} = $tstamp; } else { $midlast{$host} = $tstamp; } } unless (exists($iptoname{$host})) { $iptoname{$host} = resolve($host); } } } sub printlog { my $key; print "RBL HOSTS:\n"; foreach $key (sort keys(%rblfirst)) { printf "%-20s", $key; if ($key =~ /(.*?)\.0$/) { $key = $1; } print "$iptoname{$key}\n"; } print "\nORBS HOSTS:\n"; foreach $key (sort keys(%orbsfirst)) { printf "%-20s", $key; if ($key =~ /(.*?)\.0$/) { $key = $1; } print "$iptoname{$key}\n"; } print "\nRSS HOSTS:\n"; foreach $key (sort keys(%rssfirst)) { printf "%-20s", $key; if ($key =~ /(.*?)\.0$/) { $key = $1; } print "$iptoname{$key}\n"; } print "\nDUL HOSTS:\n"; foreach $key (sort keys(%rblfirst)) { printf "%-20s", $key; if ($key =~ /(.*?)\.0$/) { $key = $1; } print "$iptoname{$key}\n"; } print "\nMID HOSTS:\n"; foreach $key (sort keys(%midfirst)) { printf "%-20s", $key; if ($key =~ /(.*?)\.0$/) { $key = $1; } print "$iptoname{$key}\n"; } print "\n". "total rbl: ".scalar(keys %rblfirst)."\n". "total orbs: ".scalar(keys %orbsfirst)."\n". "total rss: ".scalar(keys %rssfirst)."\n". "total dul: ".scalar(keys %dulfirst)."\n". "total mid: ".scalar(keys %midfirst)."\n"; } sub printhtml { my $clr = 0; my @colors = ( "#aaaaaa","#dddddd" ); my $datefmt = `/usr/bin/date "+%T %Y.%m.%d"`; chop $datefmt; open(OUT,"> $htmlfile") or die "Can't open $htmlfile for writing: $!\n"; print OUT "\n\nHosts Flagged Due to Spamming\n". "\n\n

Hosts Flagged Due to Spamming

\n". "

This list represents the past 48hrs of logged entries of hosts who have been ". "marked as spamhosts by the IFI mail server due to being ". "blacklisted for either distributing spam or for allowing their ". "hosts to be used for relaying spam. In addition, many ISPs have chosen to put ". "their dial-up/dynamic IPs on blacklists to hinder these in sending spam ". "directly to their victims, i.e. not via the ISP's mail server. The IFI uses the ". "following blacklists:". "

rbl.maps.vix.com". "
relays.mail-abuse.org". "
relays.orbs.org". "
dul.maps.vix.com". "

All of these hosts have had ". "official complaints lodged against them, and their postmasters have been ". "contacted in order to try to rectify the situation. Click on the IP address ". "for more information about that host's spamming activity.\n". "

In addition, we check the Message-ID header of incoming mail for consistency with ". "RFC 822, the ARPA email specification. ". "Mail with a broken Message-ID will also be marked as spam. ". "

For more information, please refer to ". "www.mail-abuse.org.

\n"; my $key; print OUT "\n". "\n". "\n". "\n". "\n". "\n
\n". "\n"; foreach $key (sort keys(%rblfirst)) { print OUT "". "\n"; if ($key =~ /(.*?)\.0$/) { $key = $1; } $clr = ($clr + 1) % ($#colors + 1); print OUT "\n"; } print OUT "

rbl.maps.vix.com (". scalar(keys %rblfirst). ")

". "${key}$iptoname{$key}
\n". "\n"; $clr = 0; foreach $key (sort keys(%rssfirst)) { print OUT "". "\n"; if ($key =~ /(.*?)\.0$/) { $key = $1; } print OUT "\n"; $clr = ($clr + 1) % ($#colors + 1); } print OUT "

relays.mail-abuse.org (". scalar(keys %rssfirst). ")

". "${key}$iptoname{$key}
\n". "\n"; $clr = 0; foreach $key (sort keys(%orbsfirst)) { print OUT "". "\n"; if ($key =~ /(.*?)\.0$/) { $key = $1; } print OUT "\n"; $clr = ($clr + 1) % ($#colors + 1); } print OUT "

relays.orbs.org (". scalar(keys %orbsfirst). ")

". "${key}$iptoname{$key}
\n". "\n"; $clr = 0; foreach $key (sort keys(%dulfirst)) { print OUT "". "\n"; if ($key =~ /(.*?)\.0$/) { $key = $1; } print OUT "\n"; $clr = ($clr + 1) % ($#colors + 1); } print OUT "

dul.maps.vix.com (". scalar(keys %dulfirst). ")

". "${key}$iptoname{$key}
\n". "\n"; $clr = 0; foreach $key (sort keys(%midfirst)) { print OUT "". "\n"; if ($key =~ /(.*?)\.0$/) { $key = $1; } print OUT "\n"; $clr = ($clr + 1) % ($#colors + 1); } print OUT "

Broken Message-ID (". scalar(keys %midfirst). ")

${key}$iptoname{$key}
\n
\n
\n". "generated $datefmt\nPostie Pat\n". "\n\n"; close(OUT); }