1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
#!/usr/bin/perl
# rbl.monitor - check RBL blacklists for an IP address. Uses asynch I/O
# to send all the requests simultaneously
# Copyright (c) 2007, 2008 by Ed Ravin <eravin@panix.com>. License is GNU.
# Available to the public courtesy of Public Access Networks http://panix.com
my $usage="\
Usage: rbl.monitor [options] hostname [...]
Options [and default values]:
--listfile <list of RBL domains> [preset list, see script]
--rbllist <comma separated list of RBL domains>
--timeout <master timeout> [60 seconds]
--debug [off]
";
use strict;
use Net::DNS;
use IO::Select;
use Getopt::Long;
my %opt;
GetOptions(\%opt,
"listfile=s",
"rbllist=s",
"timeout=i",
"debug",
) or die $usage;
my $listfile= $opt{listfile} || "";
my $rbllist= $opt{rbllist} || "";
my $selecttimeout = 5;
my $timeout= ($opt{timeout} || 60) + ($selecttimeout * 2);
my $debug= $opt{debug} || 0;
# Default RBLs to check - just a few of the lists most likely to block mail
# Sites with specific needs should customize via the command line
my @rbls2check=(
"bl.spamcop.net",
"relays.mail-abuse.org",
"zen.spamhaus.org",
"dnsbl.sorbs.net",
"dnsbl-1.uceprotect.net",
);
if ($listfile) {
open(LIST, "< $listfile") ||
die "$0: cannot open list file \"$listfile\": $!\n";
@rbls2check= grep !/^\s*#/, <LIST>;
@rbls2check= grep !/^\s*$/, @rbls2check;
map {chomp} @rbls2check;
close LIST;
die "$0: no RBL names found in \"$listfile\"\n" unless @rbls2check;
}
if ($rbllist) {
@rbls2check= split(',', $rbllist);
}
print "*** checking these RBLs:\n " . join("\n ", @rbls2check) . "\n"
if $debug;
my (@summary, @detail);
my @sockets;
my $res = Net::DNS::Resolver->new;
my $sel = IO::Select->new();
my $starttime= time;
my %revip2host;
# gethostbyname is non-reentrant, so parse the hostnames to test up front
foreach my $host (@ARGV) {
my $hostdata= gethostbyname($host);
if (!defined($hostdata)) {
push @summary, $host;
push @detail, "$host: bad hostname";
next;
}
my $revip= join(".", reverse(unpack("C4", $hostdata)));
$revip2host{$revip}= $host;
}
# start all the queries
foreach my $revip (keys %revip2host) {
foreach my $rbl (@rbls2check) {
my $dnssock= $res->bgsend(join(".", $revip, $rbl));
die "$0: Net::DNS::Resolver::bgsend returns undef - too many open files?\n"
unless defined($dnssock);
push @sockets, $dnssock;
$sel->add($dnssock);
}
}
MAINLOOP:
while ($sel->handles > 0) {
my @ready = $sel->can_read($selecttimeout);
if ( (time - $starttime) > $timeout) { # waited too long?
push @detail, "TIMEOUT: " . scalar($sel->handles) . " responses still pending";
last MAINLOOP;
}
foreach my $sock (@ready) {
my ($authority, $ipaddress, $revip, $forwardip, $host);
my $packet = $res->bgread($sock);
foreach my $rr ($packet->answer) {
if ($rr->type eq "A") {
$ipaddress= $rr->address;
$authority= $rr->name;
my $q= \$packet->question;
my @qquads= split('\.',${$$q}{qname});
splice(@qquads, 4);
$revip= join('.', @qquads);
$forwardip= join('.', reverse(@qquads));
$host= $revip2host{$revip} || $forwardip;
push @summary, $host
unless grep /^$host$/, @summary;
push @detail, "$host: $authority: " . $rr->address;
}
}
$sel->remove($sock);
}
}
print join(" ", (sort @summary)) if (@summary);
print "\n";
print join("\n", (sort @detail)), "\n" if @detail;
exit 1 if @summary;
exit 0;
|
