Imported Upstream version 1.14
This commit is contained in:
parent
b5012c41b3
commit
2357dc9ae5
9 changed files with 1178 additions and 202 deletions
160
tools/postfwd-client.pl
Executable file
160
tools/postfwd-client.pl
Executable file
|
|
@ -0,0 +1,160 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
## MODULES
|
||||
#use strict;
|
||||
use warnings;
|
||||
use IO::Socket;
|
||||
use IO::Pipe;
|
||||
use Getopt::Long 2.25 qw(:config no_ignore_case bundling);
|
||||
BEGIN {
|
||||
eval { require Time::HiRes };
|
||||
if ($@) {
|
||||
warn "$@";
|
||||
warn "Failed to include optional module Time::HiRes.";
|
||||
} else {
|
||||
Time::HiRes->import( qw(time) );
|
||||
};
|
||||
};
|
||||
|
||||
|
||||
## PARAMETERS
|
||||
my $syntax = "USAGE: client.pl [ OPTIONS ] <addr>:<port>";
|
||||
my $sendstr = 'ccert_fingerprint=
|
||||
size=64063
|
||||
helo_name=english-breakfast.cloud9.net
|
||||
reverse_client_name=english-breakfast.cloud9.net
|
||||
queue_id=
|
||||
encryption_cipher=
|
||||
encryption_protocol=
|
||||
etrn_domain=
|
||||
ccert_subject=
|
||||
request=smtpd_access_policy
|
||||
protocol_state=RCPT
|
||||
recipient=someone@domain.local
|
||||
instance=6748.46adf3f8.62156.0
|
||||
protocol_name=ESMTP
|
||||
encryption_keysize=0
|
||||
recipient_count=0
|
||||
ccert_issuer=
|
||||
sender=owner-postfix-users@postfix.org
|
||||
client_name=english-breakfast.cloud9.net
|
||||
client_address=168.100.1.7
|
||||
|
||||
';
|
||||
my $delay = 0.5;
|
||||
our $pipe = new IO::Pipe;
|
||||
use vars qw( %options %kinder $kind $wait );
|
||||
|
||||
## COMMAND LINE
|
||||
GetOptions( \%options,
|
||||
'verbose|v+',
|
||||
'quiet|q+',
|
||||
'process|p=i',
|
||||
'count|c=i',
|
||||
'timeout|t=i',
|
||||
'file|f=s',
|
||||
) or die "$syntax\n";
|
||||
die "$syntax\n" unless $ARGV[0];
|
||||
map { $options{$_} ||= 1 } qw(count process);
|
||||
$options{verbose} ||= 0;
|
||||
$options{timeout} ||= 3;
|
||||
if (defined $options{file}) {
|
||||
(-f $options{file}) || die "can not find file '".$options{file}."'\n";
|
||||
open (REQUEST, "<".$options{file}) || die "can not open file '".$options{file}."'\n";
|
||||
$sendstr = join "", <REQUEST>;
|
||||
close (REQUEST);
|
||||
};
|
||||
|
||||
## FORK
|
||||
$| = 1;
|
||||
my $starttime = time();
|
||||
FORK: for (my $i=0;$i<$options{process};$i++) {
|
||||
$kind = fork();
|
||||
last FORK unless $kind;
|
||||
$kinder{$kind} = 1;
|
||||
};
|
||||
|
||||
## WHO AM I?
|
||||
($kind) ? parent_process() : child_process() ;
|
||||
die "should never see me\n";
|
||||
exit(1);
|
||||
|
||||
## PARENT CODE
|
||||
sub parent_process {
|
||||
$pipe->reader();
|
||||
use POSIX ":sys_wait_h";
|
||||
undef my @status;
|
||||
# wait until children have finished
|
||||
print ("parent process waiting for ".(scalar keys %kinder)." pids ".(join ' ', (keys %kinder))."\n") unless $options{quiet};
|
||||
PARENT: do {
|
||||
# check pipe for finished children
|
||||
push @status, <$pipe>;
|
||||
# check children
|
||||
CHILD: foreach (keys %kinder) {
|
||||
$wait = waitpid($_,&WNOHANG);
|
||||
last CHILD unless ($wait == -1);
|
||||
delete $kinder{$_};
|
||||
};
|
||||
# sleep a while to reduce cpu usage
|
||||
select(undef, undef, undef, $delay);
|
||||
print ("parent process waiting for ".(scalar keys %kinder)." pids ".(join ' ', (keys %kinder))."\n") if ($options{verbose} > 1);
|
||||
} until (($wait == -1) or (($#status + 1) >= $options{process}));
|
||||
printf ("parent process finished after %.2f seconds.\n", (time() - $starttime)) unless $options{quiet};
|
||||
# display results
|
||||
my $parent_requests = my $parent_errors = my $parent_valid = my $parent_invalid = my $parent_time = 0;
|
||||
foreach (@status) {
|
||||
my($child_requests,$child_errors,$child_valid,$child_invalid,$child_time) = split ';', $_;
|
||||
$parent_requests += $child_requests;
|
||||
$parent_errors += $child_errors;
|
||||
$parent_valid += $child_valid;
|
||||
$parent_invalid += $child_invalid;
|
||||
$parent_time = $child_time if ($child_time > $parent_time);
|
||||
};
|
||||
$parent_time = $parent_time - $starttime;
|
||||
my $parent_rps = ($parent_time) ? ($parent_requests / $parent_time) : 0;
|
||||
printf "%d requests, %d errors, %d valid, %d invalid, %.2fs total time, %.2f requests per second\n",
|
||||
$parent_requests,$parent_errors,$parent_valid,$parent_invalid,$parent_time,$parent_rps;
|
||||
exit (0);
|
||||
};
|
||||
|
||||
## CHILD CODE
|
||||
sub child_process {
|
||||
$pipe->writer();
|
||||
my $ok = my $nok = 0;
|
||||
undef my $getstr;
|
||||
# open socket
|
||||
my($addr,$port) = split ':', $ARGV[0];
|
||||
if ( ($addr and $port) and my $socket = new IO::Socket::INET (
|
||||
PeerAddr => $addr,
|
||||
PeerPort => $port,
|
||||
Proto => 'tcp',
|
||||
Timeout => $options{timeout},
|
||||
Type => SOCK_STREAM ) ) {
|
||||
# submit requests
|
||||
for (my $i=0; $i<$options{count}; $i++) {
|
||||
printf ("CHILD-$$: asking service $addr:$port\n") if $options{verbose};
|
||||
print $socket "$sendstr";
|
||||
$getstr = <$socket>; <$socket>;
|
||||
chomp($getstr);
|
||||
printf ("CHILD-$$: answer from $addr:$port -> '$getstr'\n") if $options{verbose};
|
||||
$getstr =~ s/^(action=)//;
|
||||
# check answer
|
||||
if ($1 and $getstr) {
|
||||
$ok++;
|
||||
printf ("CHILD-$$: OK: answer from $addr:$port -> '$getstr'\n") unless ( $options{quiet} or (($options{count} * $options{process}) > 50) );
|
||||
} else {
|
||||
$nok++;
|
||||
warn ("CHILD-$$: FAIL: invalid answer from $addr:$port -> '$getstr'\n");
|
||||
};
|
||||
};
|
||||
} else {
|
||||
warn ("CHILD-$$: can not open socket to $addr:$port\n");
|
||||
};
|
||||
# create summary
|
||||
my $summary = $options{count}.';'.($options{count} - ($ok + $nok)).';'.$ok.';'.$nok.';'.time()."\n";
|
||||
print ("CHILD-$$: child summary: $summary") if ($options{verbose} > 1);
|
||||
# send summary to parent
|
||||
print $pipe "$summary";
|
||||
exit (0);
|
||||
};
|
||||
|
||||
297
tools/rblcheck.pl
Executable file
297
tools/rblcheck.pl
Executable file
|
|
@ -0,0 +1,297 @@
|
|||
#!/usr/bin/perl -T -w
|
||||
|
||||
# includes
|
||||
use strict;
|
||||
use warnings;
|
||||
use Getopt::Long 2.25 qw(:config no_ignore_case bundling);
|
||||
use Net::DNS;
|
||||
# include Time::HiRes if available
|
||||
BEGIN {
|
||||
eval { require Time::HiRes };
|
||||
Time::HiRes->import( qw(time) ) unless $@;
|
||||
};
|
||||
|
||||
# RBLs (ip based)
|
||||
our @rbls = qw(
|
||||
zz.countries.nerd.dk
|
||||
query.bondedsender.org
|
||||
exemptions.ahbl.org
|
||||
spf.trusted-forwarder.org
|
||||
list.dnswl.org
|
||||
zen.spamhaus.org
|
||||
b.barracudacentral.org
|
||||
bl.spamcop.net
|
||||
list.dsbl.org
|
||||
multihop.dsbl.org
|
||||
unconfirmed.dsbl.org
|
||||
combined.njabl.org
|
||||
dnsbl.sorbs.net
|
||||
dnsbl.ahbl.org
|
||||
ix.dnsbl.manitu.net
|
||||
dnsbl-1.uceprotect.net
|
||||
dnsbl-2.uceprotect.net
|
||||
dnsbl-3.uceprotect.net
|
||||
ips.backscatterer.org
|
||||
sorbs.dnsbl.net.au
|
||||
t1.dnsbl.net.au
|
||||
korea.services.net
|
||||
blackholes.five-ten-sg.com
|
||||
cbl.anti-spam.org.cn
|
||||
cblplus.anti-spam.org.cn
|
||||
cblless.anti-spam.org.cn
|
||||
bogons.cymru.com
|
||||
dynamic.tqmrbl.com
|
||||
relays.tqmrbl.com
|
||||
clients.tqmrbl.com
|
||||
hostkarma.junkemailfilter.com
|
||||
sip.invaluement.com
|
||||
);
|
||||
|
||||
# RHSBLs (domain based)
|
||||
our @rhsbls = qw(
|
||||
rhsbl.sorbs.net
|
||||
rhsbl.ahbl.org
|
||||
multi.surbl.org
|
||||
dsn.rfc-ignorant.org
|
||||
abuse.rfc-ignorant.org
|
||||
whois.rfc-ignorant.org
|
||||
bogusmx.rfc-ignorant.org
|
||||
blackhole.securitysage.com
|
||||
ex.dnsbl.org
|
||||
rddn.dnsbl.net.au
|
||||
block.rhs.mailpolice.com
|
||||
dynamic.rhs.mailpolice.com
|
||||
dnsbl.cyberlogic.net
|
||||
hostkarma.junkemailfilter.com
|
||||
);
|
||||
|
||||
# commandline syntax
|
||||
our $syntax = <<__SYNTAX__;
|
||||
Usage: rblcheck3.pl [OPTIONS] <objects>
|
||||
|
||||
-h, --help manual
|
||||
-s, --short short output
|
||||
-v, --verbose show dns nxdomain answers (not listed)
|
||||
-n, --noerror do not show dns query timeouts
|
||||
-t, --timeout=10 dns query timeout setting in seconds
|
||||
--dnsstats show dns statistics
|
||||
--rbls=<list> override builtin rbls with <list>
|
||||
--rhsbls=<list> override builtin rhsbls with <list>
|
||||
|
||||
<objects> list of ips, hostnames and e-mail addresses
|
||||
__SYNTAX__
|
||||
|
||||
# manual
|
||||
our $examples = <<__EXAMPLES__;
|
||||
Examples:
|
||||
|
||||
# check builtin rbls for 192.168.0.1 and rhsbls for host.example.com
|
||||
rblcheck3.pl 192.168.0.1 host.example.com
|
||||
|
||||
# same as above
|
||||
rblcheck3.pl host.example.com[192.168.0.1]
|
||||
|
||||
# check builtin rhsbls for the domain part "example.com",
|
||||
# set dns timeout to 15 seconds
|
||||
rblcheck3.pl -t 15 john.doe\@example.com
|
||||
|
||||
# check spamhaus and spamcop for 192.168.0.1
|
||||
# short output without dns timeout information
|
||||
rblcheck3.pl -ns --rbls=zen.spamhaus.org,bl.spamcop.net 192.168.0.1
|
||||
__EXAMPLES__
|
||||
|
||||
# save current time
|
||||
our $starttime = time();
|
||||
|
||||
# variables
|
||||
use vars qw(
|
||||
%dnshits %dnscache %options
|
||||
@queries @lookups @timedout
|
||||
);
|
||||
|
||||
# parse commandline switches
|
||||
GetOptions( \%options,
|
||||
"timeout|t=i",
|
||||
"noerror|n",
|
||||
"verbose|v",
|
||||
"short|s+",
|
||||
"dnsstats",
|
||||
"rbls|rbl=s" => sub { push @{$options{rbls}}, (split /[,\s]+/, $_[1]) },
|
||||
"rhsbls|rhsbl=s" => sub { push @{$options{rhsbls}}, (split /[,\s]+/, $_[1]) },
|
||||
"help|h" => sub { print "\n$syntax\n$examples\n"; exit(1) },
|
||||
) or die "\n$syntax\n";
|
||||
|
||||
# unbuffered output
|
||||
#select STDERR; $| = 1;
|
||||
#select STDOUT; $| = 1;
|
||||
|
||||
# optional: override dnsbl lists
|
||||
@rbls = @{$options{rbls}} if defined $options{rbls};
|
||||
@rhsbls = @{$options{rhsbls}} if defined $options{rhsbls};
|
||||
|
||||
# split client[ip] in two queries
|
||||
map { push @queries, (/^([^\]]+)\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]$/) ? ($1, $2) : $_ } @ARGV;
|
||||
|
||||
# parse queries and create lookup list
|
||||
foreach my $query (@queries) {
|
||||
undef my $addr;
|
||||
|
||||
# prepare rbls
|
||||
if ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
|
||||
$addr = join ".", reverse split /\./, $query;
|
||||
foreach my $rbl (@rbls) {
|
||||
$dnscache{$addr.".".$rbl}{type} = 'RBL';
|
||||
$dnscache{$addr.".".$rbl}{query} = $query;
|
||||
$dnscache{$addr.".".$rbl}{list} = $rbl;
|
||||
push @lookups, $addr.".".$rbl;
|
||||
};
|
||||
# prepare rhsbls
|
||||
} else {
|
||||
# remove localpart if email address
|
||||
$addr = ($query =~ /@([^@]+)$/) ? $1 : $query;
|
||||
foreach my $rbl (@rhsbls) {
|
||||
$dnscache{$addr.".".$rbl}{type} = 'RHSBL';
|
||||
$dnscache{$addr.".".$rbl}{query} = $query;
|
||||
$dnscache{$addr.".".$rbl}{list} = $rbl;
|
||||
push @lookups, $addr.".".$rbl;
|
||||
};
|
||||
};
|
||||
};
|
||||
|
||||
# main: process lookups
|
||||
if ( @lookups ) {
|
||||
my $ownres = Net::DNS::Resolver->new;
|
||||
my $ownsel = IO::Select->new;
|
||||
my %ownsock = ();
|
||||
my @ownready = ();
|
||||
my $bgsock = undef;
|
||||
|
||||
# send queries
|
||||
QUERY: foreach my $query (@lookups) {
|
||||
next QUERY unless $query;
|
||||
# send A query
|
||||
$dnscache{$query}{start} = time();
|
||||
$bgsock = $ownres->bgsend($query, 'A');
|
||||
$ownsel->add($bgsock);
|
||||
$ownsock{$bgsock} = 'A:'.$query;
|
||||
# send TXT query
|
||||
$bgsock = $ownres->bgsend($query, 'TXT');
|
||||
$ownsel->add($bgsock);
|
||||
$ownsock{$bgsock} = 'TXT:'.$query;
|
||||
};
|
||||
|
||||
# get answers
|
||||
while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($options{timeout} || 10))) {
|
||||
foreach my $sock (@ownready) {
|
||||
if (defined $ownsock{$sock}) {
|
||||
my $packet = $ownres->bgread($sock);
|
||||
rbl_read_dns ($packet);
|
||||
delete $ownsock{$sock};
|
||||
} else {
|
||||
$ownsel->remove($sock);
|
||||
$sock = undef;
|
||||
};
|
||||
};
|
||||
};
|
||||
|
||||
# timeout handling
|
||||
my $now = time();
|
||||
map { push @timedout, (split ':', $ownsock{$_})[1] } (keys %ownsock);
|
||||
map { @{$dnscache{$_}{A}} = '**timeout**'; $dnscache{$_}{end} = $now; delete $dnscache{$_}{log} } (sort @timedout) if @timedout;
|
||||
|
||||
# print results
|
||||
map { # timeout
|
||||
unless (defined $dnscache{$_}{log}) {
|
||||
$dnshits{timeouts}{$dnscache{$_}{list}}++;
|
||||
show_dns ($_) unless $options{noerror};
|
||||
# a-record
|
||||
} elsif ($dnscache{$_}{log}) {
|
||||
$dnshits{hits}{$dnscache{$_}{list}}++;
|
||||
show_dns ($_);
|
||||
# nxdomain
|
||||
} else {
|
||||
$dnshits{nxdomain}{$dnscache{$_}{list}}++;
|
||||
show_dns ($_) if $options{verbose};
|
||||
};
|
||||
} @lookups;
|
||||
printf STDOUT "\n # Finished %d lookups (%d items, %d rbls, %d rhsbls, %.1f%% timeouts) after %.2f seconds\n",
|
||||
($#lookups + 1),
|
||||
($#queries + 1),
|
||||
($#rbls + 1), ($#rhsbls + 1),
|
||||
(($#timedout + 1) / (($#lookups + 1) * 2)) * 100,
|
||||
(time() - $starttime) unless defined $options{short};
|
||||
if ($options{verbose} or $options{dnsstats}) {
|
||||
printf "\n # DNS statistics\n";
|
||||
if (defined $dnshits{hits}) {
|
||||
print " #\n";
|
||||
map { printf STDOUT " # ".$dnshits{hits}{$_}." hits for $_\n" } (sort {($dnshits{hits}{$b} || 0) <=> ($dnshits{hits}{$a} || 0)} keys %{$dnshits{hits}});
|
||||
};
|
||||
if (defined $dnshits{timeouts}) {
|
||||
print " #\n";
|
||||
map { printf STDOUT " # ".$dnshits{timeouts}{$_}." timeouts for $_\n" } (sort {($dnshits{timeouts}{$b} || 0) <=> ($dnshits{timeouts}{$a} || 0)} keys %{$dnshits{timeouts}});
|
||||
};
|
||||
};
|
||||
print "\n";
|
||||
};
|
||||
exit(0);
|
||||
|
||||
# prints DNS result
|
||||
sub show_dns {
|
||||
my $que = shift;
|
||||
my $out = "";
|
||||
if (defined $options{short}) {
|
||||
$out .= $dnscache{$que}{query}
|
||||
."; ".$dnscache{$que}{list}
|
||||
."; ".(join ', ', @{$dnscache{$que}{A}});
|
||||
$out .= "; ".(join '. ', @{$dnscache{$que}{TXT}}) if defined $dnscache{$que}{TXT} and ($options{verbose} or ($options{short} < 2));
|
||||
} else {
|
||||
$out .= "\n ".sprintf ("%15s", $dnscache{$que}{query})." ".$dnscache{$que}{type}.": ".$dnscache{$que}{list};
|
||||
$out .= " (cname: ".(join ', ', (keys %{$dnscache{$que}{CNAME}})).")" if defined $dnscache{$que}{CNAME};
|
||||
$out .= "\n ".sprintf ("%15s", $dnscache{$que}{query})." ".(join ', ', @{$dnscache{$que}{A}});
|
||||
$out .= " (time: ".sprintf ("%.1fs)", ($dnscache{$que}{end} - $dnscache{$que}{start}));
|
||||
$out .= " (ttl: ".$dnscache{$que}{ttl}."s)" if defined $dnscache{$que}{ttl};
|
||||
$out .= "\n ".sprintf ("%15s", $dnscache{$que}{query})." ".(join '. ', @{$dnscache{$que}{TXT}}) if defined $dnscache{$que}{TXT};
|
||||
};
|
||||
print STDOUT "$out\n";
|
||||
};
|
||||
|
||||
# reads DNS answer
|
||||
sub rbl_read_dns {
|
||||
my($myresult) = shift;
|
||||
my($now) = time();
|
||||
my($que,$typ) = undef;
|
||||
|
||||
if ( defined $myresult ) {
|
||||
# read question, for dns cache id
|
||||
foreach ($myresult->question) {
|
||||
$typ = ($_->qtype || '') unless $typ;
|
||||
$que = ($_->qname || '') unless $que;
|
||||
};
|
||||
# not listed
|
||||
unless ($myresult->answer) {
|
||||
@{$dnscache{$que}{A}} = '<nxdomain>';
|
||||
$dnscache{$que}{end} = $now;
|
||||
$dnscache{$que}{log} = 0;
|
||||
# parse answers
|
||||
} else {
|
||||
foreach ($myresult->answer) {
|
||||
if ($_->type =~ /^(A|CNAME|TXT)$/) {
|
||||
if ($_->type eq 'A') {
|
||||
push @{$dnscache{$que}{A}}, ($_->address || '');
|
||||
} elsif ($_->type eq 'TXT') {
|
||||
my $res = (join(' ', $_->char_str_list()) || '');
|
||||
push @{$dnscache{$que}{TXT}}, $res if $res;
|
||||
} elsif ($_->type eq 'CNAME') {
|
||||
$dnscache{$que}{CNAME}{$_->cname} = 1 if $_->cname;
|
||||
};
|
||||
$dnscache{$que}{ttl} = ($_->ttl || 0) unless defined $dnscache{$que}{ttl};
|
||||
$dnscache{$que}{end} = $now;
|
||||
$dnscache{$que}{log} = 1;
|
||||
} else {
|
||||
print STDERR "IGNORING query: $que, TYPE: '".($_->type || '')."'\n";
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue