From 5e95090defff64bc8cd7a318a73aa930948fb66d Mon Sep 17 00:00:00 2001 From: Peter Palfrader Date: Mon, 15 Nov 2004 09:20:11 +0000 Subject: Initial import --- bin/allpingers-ini2xml | 159 ++++++++++ bin/guess-uris | 68 ++++ bin/remailer-states-create | 57 ++++ bin/remailer-states-make-image | 30 ++ bin/remailer-states-make-image-long | 30 ++ bin/remailer-states-make-image-long-2 | 31 ++ bin/tls-check | 566 ++++++++++++++++++++++++++++++++++ bin/tls2html | 59 ++++ 8 files changed, 1000 insertions(+) create mode 100755 bin/allpingers-ini2xml create mode 100755 bin/guess-uris create mode 100755 bin/remailer-states-create create mode 100755 bin/remailer-states-make-image create mode 100755 bin/remailer-states-make-image-long create mode 100755 bin/remailer-states-make-image-long-2 create mode 100755 bin/tls-check create mode 100755 bin/tls2html (limited to 'bin') diff --git a/bin/allpingers-ini2xml b/bin/allpingers-ini2xml new file mode 100755 index 0000000..9add8ae --- /dev/null +++ b/bin/allpingers-ini2xml @@ -0,0 +1,159 @@ +#!/usr/bin/perl -wT + +# ini2xml: (c) 2002 Peter Palfrader +# $Id$ +# +# This program is free software. you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +=pod + +=head1 NAME + +ini2xml convert pingers ini file to xml + +=over + +=head1 SYNOPSIS + +=item B + +=back + +=head1 DESCRIPTION + +FIXME + +=back + +=head1 BUGS + +Please report them to the author. + +=head1 AUTHOR + +Peter Palfrader, Epeter@palfrader.orgE + +=cut + +use strict; +use Getopt::Long; +use English; +use FindBin qw{ $Bin }; + +($Bin) = $Bin =~ m/^(.*)$/; +chdir($Bin); + +$ENV{'PATH'} = '/bin:/usr/bin'; +delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; + +my %pingers; +{ + my $source; + while(<>) { + s/\s*(.*)\s*/$1/; + next if (/^\s*#/); + $source = $1, next if (/^\[(.*)\]$/); + if (/(.+?)\s*=\s*(.+)/) { + $pingers{$source}->{$1} = $2 if defined $source; + }; + }; +}; + +print qq{\n}; +printf qq{ + + + + + + + +}, scalar gmtime(); +print qq{ + + + + + + + + + + + + + + + +]> +}; + +my $now = `822-date`; +chomp $now; +printf qq{\n}, $now; +for my $pinger (sort keys %pingers) { + my $p = $pingers{$pinger}; + printf qq{\t\n}, $pinger; + printf (qq{\t\t%s\n}, $p->{'base'}) and delete $p->{'base'} if defined ($p->{'base'}); + + printf (qq{\t\t%s\n}, $p->{'rlist'})and delete $p->{'rlist'} if defined ($p->{'rlist'}); + printf (qq{\t\t%s\n}, $p->{'rlist2'})and delete $p->{'rlist2'} if defined ($p->{'rlist2'}); + printf (qq{\t\t%s\n}, $p->{'rlist_html'})and delete $p->{'rlist_html'} if defined ($p->{'rlist_html'}); + printf (qq{\t\t%s\n}, $p->{'rlist2_html'})and delete $p->{'rlist2_html'} if defined ($p->{'rlist2_html'}); + + printf (qq{\t\t%s\n}, $p->{'mlist'})and delete $p->{'mlist'} if defined ($p->{'mlist'}); + printf (qq{\t\t%s\n}, $p->{'mlist2'})and delete $p->{'mlist2'} if defined ($p->{'mlist2'}); + printf (qq{\t\t%s\n}, $p->{'mlist_html'})and delete $p->{'mlist_html'} if defined ($p->{'mlist_html'}); + printf (qq{\t\t%s\n}, $p->{'mlist2_html'})and delete $p->{'mlist2_html'} if defined ($p->{'mlist2_html'}); + + printf (qq{\t\t%s\n}, $p->{'rchain'})and delete $p->{'rchain'} if defined ($p->{'rchain'}); + printf (qq{\t\t%s\n}, $p->{'rchain_html'})and delete $p->{'rchain_html'} if defined ($p->{'rchain_html'}); + + printf (qq{\t\t%s\n}, $p->{'pgpring'})and delete $p->{'pgpring'} if defined ($p->{'pgpring'}); + printf (qq{\t\t%s\n}, $p->{'pgpring_rsa'})and delete $p->{'pgpring_rsa'} if defined ($p->{'pgpring_rsa'}); + + printf (qq{\t\t%s\n}, $p->{'mixring'})and delete $p->{'mixring'} if defined ($p->{'mixring'}); + printf (qq{\t\t%s\n}, $p->{'type2list'})and delete $p->{'type2list'} if defined ($p->{'type2list'}); + for my $k (sort keys %$p) { + warn("Unused key $k in $p\n"); + }; + printf qq{\t\n}; +} +print qq{\n}; diff --git a/bin/guess-uris b/bin/guess-uris new file mode 100755 index 0000000..9b858d7 --- /dev/null +++ b/bin/guess-uris @@ -0,0 +1,68 @@ +#!/usr/bin/perl -w + +use strict; +use LWP::UserAgent; +use English; + +my $user_agent = + LWP::UserAgent->new(env_proxy => 1, + keep_alive => 1, + timeout => 30 ); + +for my $arg (@ARGV) { + my $uri = URI->new($arg); + if ($user_agent->is_protocol_supported( $uri )) { + my $response = $user_agent->get($arg); + unless ($response->is_success) { + warn ("$PROGRAM_NAME: Get failed for $arg (".$response->code()." ".$response->message().")\n"); + next; + } + my $content = $response->content; + my @uris = $content =~ m/href = "? (.*?) (?:"|>)/xig; + my $base = $arg; + $base =~ s,/[^/]*$,,; + @uris = map { $_ = /:/ ? $_ : $base.'/'.$_; s,i(?<=[^:])//,/,g; s,/[^/]*?/../,/,; $_; } @uris; + + my $workaround_echolot = $content =~ m,palfrader.org/echolot,; + + my %resources; + for (@uris) { + $resources{'rlist'} = $_ if (/rlist1?(?:\.txt)?$|MyCypSta1\.txt$/i); + $resources{'mlist'} = $_ if (/mlist1?(?:\.txt)?$|mixlist(?:\.txt)?$|MyMixSta1\.txt$/i); + $resources{'rlist_html'} = $_ if (/rlist1?\.[sp]?html$|MyCypSta1\.[sp]?html$|remailer-list\.[sp]?html$/i); + $resources{'mlist_html'} = $_ if (/mlist1?\.[sp]?html$|mixlist\.[sp]?html$|MyMixSta1\.[sp]?html$|mixmaster-list\.[sp]?html$/i); + $resources{'rlist2'} = $_ if (/rlist2(?:\.txt)?$|MyCypSta2\.txt$/i); + $resources{'mlist2'} = $_ if (/mlist2(?:\.txt)?$|mixlist2(?:\.txt)?$|MyMixSta2\.txt$/i); + $resources{'rlist2_html'} = $_ if (/rlist2\.[sp]?html$|MyCypSta2\.[sp]?html$/i); + $resources{'mlist2_html'} = $_ if (/mlist2\.[sp]?html$|mixlist2\.[sp]?html$|MyMixSta2\.[sp]?html$/i); + $resources{'rchain'} = $_ if (/rchain(?:\.txt)?$|MyRChain\.txt$/i); + $resources{'rchain_html'} = $_ if (/rchain\.[sp]?html$|MyRChain\.[sp]?html$/i); + + $resources{'pgpring'} = $_ if (/pubring(-all)?\.asc$|pgp-all.asc$|rsa-dss\.asc$|rsa\+dss.asc/i); + $resources{'pgpring_rsa'} = $_ if (/pubring-?rsa\.asc$|pgp-rsa\.asc$|rsa-only\.asc$|rsakeys\.asc|rsa.asc/i); + $resources{'mixring'} = $_ if (/pubring\.mix$/i); + $resources{'type2list'} = $_ if (/type2\.list?$/i); + } + if ($workaround_echolot) { + my $warned = 0; + for my $file (qw{rlist mlist rlist2 mlist2}) { + unless (defined ($resources{$file})) { + warn("Guessing echolot stats\n"), $warned++ unless ($warned); + $resources{$file} = $resources{$file.'_html'}; + $resources{$file} =~ s/\.html$/.txt/; + } + } + }; + + printf ("%-12s= %s\n", 'base', $arg); + for my $key (qw{rlist mlist rlist2 mlist2 rlist_html mlist_html rlist2_html mlist2_html rchain rchain_html pgpring pgpring_rsa mixring type2list}) { + printf ("%-12s= %s\n", $key, $resources{$key}) if defined $resources{$key}; + } + + } else { + warn ("$PROGRAM_NAME: Protocoll for '$arg' not supported\n"); + }; +} + +# vim:set ts=2: +# vim:set shiftwidth=2: diff --git a/bin/remailer-states-create b/bin/remailer-states-create new file mode 100755 index 0000000..d2c37dc --- /dev/null +++ b/bin/remailer-states-create @@ -0,0 +1,57 @@ +#!/usr/bin/perl -Tw + +# $Id: rrd-create,v 1.2 2001/06/29 07:59:51 statkeep Exp $ + +use strict; +use RRDs; +use Getopt::Long; +#use FindBin qw{ $Bin }; + +my $RRDTOOL = 'rrdtool'; +my $RRD = 'data/remailer-states.rrd'; +my $DIR = '.'; + +my $shorthelp = "Usage: $0 [--verbose] [--force]\n"; + +my $verbose = 0; +my $force = 0; +Getopt::Long::config('bundling'); +unless ( GetOptions( + "--verbose" , \$verbose, + "-v" , \$verbose, + "--force" , \$force, + "-f" , \$force + ) ) { + print STDERR $shorthelp; + exit 1; +}; + + +chdir($DIR) || die ("Cannot change to $DIR: $!\n"); + +die ("$RRD already exists - not creating.\n") if ( -e $RRD && !$force ); + +my @params = ($RRD); +push @params, qw{ --step 1800 + DS:state1OK:GAUGE:28800:0:U + DS:state1Warning:GAUGE:28800:0:U + DS:state1Critical:GAUGE:28800:0:U + DS:state2OK:GAUGE:28800:0:U + DS:state2Warning:GAUGE:28800:0:U + DS:state2Critical:GAUGE:28800:0:U + + RRA:AVERAGE:0.5:1:2880 + RRA:AVERAGE:0.5:48:8760 + RRA:AVERAGE:0.5:192:8760 +}; + +# Keep 30 minute data for 60 days +# Keep 1 day data for 1 year +# Keep 4 day data for 4 years +print "Creating rrd: $RRD...\n" if $verbose; +RRDs::create @params; +my $ERR=RRDs::error; +die "ERROR while creating squid.rrd: $ERR\n" if $ERR; +print "done.\n" if $verbose; + +# vim:set ts=2: diff --git a/bin/remailer-states-make-image b/bin/remailer-states-make-image new file mode 100755 index 0000000..1fa993f --- /dev/null +++ b/bin/remailer-states-make-image @@ -0,0 +1,30 @@ +#! /bin/sh + +set -e + +RRD_DIR=$1 +TARGETDIR=$2 + +if [ -z "$TARGETDIR" ] ; then + echo "Usage: $0 " >&2 + exit 1 +fi + +rrdtool graph $TARGETDIR/remailer-states.png \ + --start `date --date='1 month ago' +%s` \ + --title 'Number of Remailers/Mixmasters' \ + --vertical-label '#' \ + --lower-limit 0 \ + --height 150 \ + DEF:ok1=$RRD_DIR/remailer-states.rrd:state1OK:AVERAGE \ + DEF:warn1=$RRD_DIR/remailer-states.rrd:state1Warning:AVERAGE \ + DEF:crit1=$RRD_DIR/remailer-states.rrd:state1Critical:AVERAGE \ + DEF:ok2=$RRD_DIR/remailer-states.rrd:state2OK:AVERAGE \ + DEF:warn2=$RRD_DIR/remailer-states.rrd:state2Warning:AVERAGE \ + DEF:crit2=$RRD_DIR/remailer-states.rrd:state2Critical:AVERAGE \ + "AREA:ok2#00FF00:in OK (Mix; area)" \ + "STACK:warn2#FFFF00:in Warning (Mix)" \ + "STACK:crit2#FF0000:in Critical (Mix)" \ + "LINE3:ok1#0000FF:in OK (CPunk; line)" \ + "STACK:warn1#00FFFF:in Warning (CPunk)" \ + "STACK:crit1#FF00FF:in Critical (CPunk)" >/dev/null diff --git a/bin/remailer-states-make-image-long b/bin/remailer-states-make-image-long new file mode 100755 index 0000000..e233d12 --- /dev/null +++ b/bin/remailer-states-make-image-long @@ -0,0 +1,30 @@ +#! /bin/sh + +set -e + +RRD_DIR=$1 +TARGETDIR=$2 + +if [ -z "$TARGETDIR" ] ; then + echo "Usage: $0 " >&2 + exit 1 +fi + +rrdtool graph $TARGETDIR/remailer-states-long.png \ + --start `date --date='12 month ago' +%s` \ + --title 'Number of Remailers/Mixmasters' \ + --vertical-label '#' \ + --lower-limit 0 \ + --height 150 \ + DEF:ok1=$RRD_DIR/remailer-states.rrd:state1OK:AVERAGE \ + DEF:warn1=$RRD_DIR/remailer-states.rrd:state1Warning:AVERAGE \ + DEF:crit1=$RRD_DIR/remailer-states.rrd:state1Critical:AVERAGE \ + DEF:ok2=$RRD_DIR/remailer-states.rrd:state2OK:AVERAGE \ + DEF:warn2=$RRD_DIR/remailer-states.rrd:state2Warning:AVERAGE \ + DEF:crit2=$RRD_DIR/remailer-states.rrd:state2Critical:AVERAGE \ + "AREA:ok2#00FF00:in OK (Mix; area)" \ + "STACK:warn2#FFFF00:in Warning (Mix)" \ + "STACK:crit2#FF0000:in Critical (Mix)" \ + "LINE3:ok1#0000FF:in OK (CPunk; line)" \ + "STACK:warn1#00FFFF:in Warning (CPunk)" \ + "STACK:crit1#FF00FF:in Critical (CPunk)" >/dev/null diff --git a/bin/remailer-states-make-image-long-2 b/bin/remailer-states-make-image-long-2 new file mode 100755 index 0000000..e655770 --- /dev/null +++ b/bin/remailer-states-make-image-long-2 @@ -0,0 +1,31 @@ +#! /bin/sh + +set -e + +RRD_DIR=$1 +TARGETDIR=$2 + +if [ -z "$TARGETDIR" ] ; then + echo "Usage: $0 " >&2 + exit 1 +fi + +rrdtool graph $TARGETDIR/remailer-states-long-2.png \ + --start `date --date='24 month ago' +%s` \ + --title 'Number of Remailers/Mixmasters' \ + --vertical-label '#' \ + --lower-limit 0 \ + --height 150 \ + --width 640 \ + DEF:ok1=$RRD_DIR/remailer-states.rrd:state1OK:AVERAGE \ + DEF:warn1=$RRD_DIR/remailer-states.rrd:state1Warning:AVERAGE \ + DEF:crit1=$RRD_DIR/remailer-states.rrd:state1Critical:AVERAGE \ + DEF:ok2=$RRD_DIR/remailer-states.rrd:state2OK:AVERAGE \ + DEF:warn2=$RRD_DIR/remailer-states.rrd:state2Warning:AVERAGE \ + DEF:crit2=$RRD_DIR/remailer-states.rrd:state2Critical:AVERAGE \ + "AREA:ok2#00FF00:in OK (Mix; area)" \ + "STACK:warn2#FFFF00:in Warning (Mix)" \ + "STACK:crit2#FF0000:in Critical (Mix)" \ + "LINE3:ok1#0000FF:in OK (CPunk; line)" \ + "STACK:warn1#00FFFF:in Warning (CPunk)" \ + "STACK:crit1#FF00FF:in Critical (CPunk)" >/dev/null diff --git a/bin/tls-check b/bin/tls-check new file mode 100755 index 0000000..db06c32 --- /dev/null +++ b/bin/tls-check @@ -0,0 +1,566 @@ +#!/usr/bin/perl -w + +use strict; +use Net::DNS; +use Net::IPv4Addr qw( :all ); +use POSIX ":sys_wait_h"; +use IO::File; +use IO::Socket::INET; +use IO::Select; +use Fcntl; +use IPC::Open3; +use Data::Dumper; +use English; +use POSIX qw(:errno_h); + +$| = 1; +my $hostname = "opium.multi24.com"; +my $VERBOSE = 0; + +my $AFTER_SSL_SLEEP = 2; +my $OPENSSL_TIMEOUT = 45; +my $CHECK_LISTENS_TIMEOUT = 15; # 50 # done 3 times +my $CHECK_TLS_TIMEOUT = 15; # 50 # done 3 times +my $GET_MX_TIMEOUT = 5; +my $WAIT_AFTER_QUIT = 2; + +$SIG{'CHLD'} = 'IGNORE'; + +sub parse_reply($) { + my ($fh) = @_; + + my $code = undef; + my $text = ''; + while (1) { + my $line = <$fh>; + next unless defined $line; + my ($thiscode, $thistext); + if (($thiscode, $thistext) = $line =~ /^(\d\d\d)-(.*)$/s) { + $thistext =~ s/\r\n/\n/; + $text .= $thistext; + next; + } elsif (($thiscode, $thistext) = $line =~ /^(\d\d\d)\s+(.*)$/s) { + $thistext =~ s/\r\n/\n/; + $text .= $thistext; + $code = $thiscode; + last; + } else { + die ("Cannot parse $line\n"); + }; + }; + return ($code, $text); +} + +sub quit($) { + my ($peer) = @_; + print $peer "QUIT\r\n"; + sleep ($WAIT_AFTER_QUIT); + close $peer; +}; + +sub do_ssl($) { + my ($peer) = @_; + + my $listen = IO::Socket::INET->new( + Listen => 1, + Proto => 'tcp', + ); + my $port = $listen->sockport(); + + my $p_pid = fork(); + unless ($p_pid) { + my $socket = $listen->accept(); + my $pid; + my @children; + $pid = fork(); + push @children, $pid; + unless ($pid) { + close STDOUT; + my $d; + while (read($socket, $d, 1)) { + print $peer $d; + $peer->flush(); + } + exit(0); + }; + $pid = fork(); + push @children, $pid; + unless ($pid) { + close STDOUT; + my $d; + while (read($peer, $d, 1)) { + print $socket $d; + $socket->flush(); + }; + exit(0); + }; + #while (@children) { + # for (@children) { + # my $child = waitpid($_,WNOHANG); + # if ($child == $_) { + # @children = grep { $_ != $child } @children; + # }; + # }; + #}; + + exit(0); + }; + + my($wtr, $rdr, $err); + my $pid = open3($wtr, $rdr, $err, "timeout $OPENSSL_TIMEOUT openssl s_client -showcerts -connect localhost:$port"); + #waitpid($p_pid,0); + + return ($wtr, $rdr, $err); +}; + +sub check_listens($$$) { + my ($peer_host, $port, $do_ssl) = @_; + + my ($result, $warning, $error) = (undef,undef,undef,undef); + my $tls_text = ""; + + eval { + while (1) { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm($CHECK_LISTENS_TIMEOUT); + + my $peer = IO::Socket::INET->new( + PeerAddr => $peer_host, + PeerPort => $port, + Protocol => 'tcp', + Timeout => 5, + ) or $result = 0, $error = ("Cannot connect: $!"), last; + + + alarm($CHECK_LISTENS_TIMEOUT); + my ($wtr, $rdr, $err); + if ($do_ssl) { + print STDERR "Checking SSL for $peer_host ... do ssl\n" if ($VERBOSE >= 3); + ($wtr, $rdr, $err) = do_ssl($peer); + print STDERR "Checking SSL for $peer_host ... ssl done\n" if ($VERBOSE >= 3); + sleep ($AFTER_SSL_SLEEP); + } else { + ($wtr, $rdr) = ($peer, $peer); + }; + + alarm($CHECK_LISTENS_TIMEOUT); + + my ($code, $comment); + while (my $line = readline($rdr)) { + my ($thiscode, $thiscomment); + if (($thiscode, $thiscomment) = $line =~ /^(\d\d\d)-(.*)$/s) { + $thiscomment =~ s/\r\n/\n/; + $comment .= $thiscomment; + next; + } elsif (($thiscode, $thiscomment) = $line =~ /^(\d\d\d)\s+(.*)$/s) { + $thiscomment =~ s/\r\n/\n/; + $comment .= $thiscomment; + $code = $thiscode; + last; + } else { + $tls_text .= $line; + next; + }; + }; + + if (defined $code && defined $comment) { + $error = "Code is $code and not 220 ($comment)" unless ($code == 220); + #$error .= "'$comment' does not include SMTP magic string" unless $comment =~ /SMTP/; + $result = 1 unless defined $error; + quit($wtr); + } else { + close($wtr); + }; + close($rdr); + last; + }; + alarm(0); + }; + if ($@) { + die $@ unless $@ eq "alarm\n"; + $error = "alarm - timeout"; + }; + if (defined $error) { + $error =~ s/Operation now in progress$/Timeout/; + }; + return ($result, $warning, $error, $tls_text); +}; + +sub check_tls($) { + my ($peer_host) = @_; + my ($result, $warning, $error, $tls_text) = (undef,undef,undef,undef,undef); + print STDERR "Checking TLS for $peer_host\n" if ($VERBOSE >= 2); + + eval { + while(1) { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm($CHECK_TLS_TIMEOUT); + + print STDERR "Checking TLS for $peer_host ... connet to port 25\n" if ($VERBOSE >= 3); + my $peer = IO::Socket::INET->new( + PeerAddr => $peer_host, + PeerPort => 'smtp', + Protocol => 'tcp', + Timeout => 5, + ) or $error = ("Cannot connect: $!"), last; + + alarm($CHECK_TLS_TIMEOUT); + + my ($code, $comment) = parse_reply($peer); + $error = "Code is $code and not 220 ($comment)", quit($peer), last unless ($code == 220); + #$error = "'$comment' does not include SMTP magic string", quit($peer), last unless $comment =~ /SMTP/; + $result = 0, quit($peer), last unless $comment =~ /ESMTP/; + + print STDERR "Checking TLS for $peer_host ... send EHLO\n" if ($VERBOSE >= 3); + print $peer "EHLO $hostname\r\n"; + ($code, $comment) = parse_reply($peer); + $error = "Code is $code and not 250 ($comment)", quit($peer), last unless ($code == 250); + my $tls = $comment =~ m/^STARTTLS$/im ? 1 : 0; + $result = 0, quit($peer), last unless $tls; + + print STDERR "Checking TLS for $peer_host ... send STARTTLS\n" if ($VERBOSE >= 3); + $result = 1; + print $peer "STARTTLS\r\n"; + ($code, $comment) = parse_reply($peer); + $warning = "STARTTLS return code is $code and not 220 ($comment)", quit($peer), last unless ($code == 220); + + alarm($CHECK_TLS_TIMEOUT); + print STDERR "Checking TLS for $peer_host ... do ssl\n" if ($VERBOSE >= 3); + my ($wtr, $rdr, $err) = do_ssl($peer); + print STDERR "Checking TLS for $peer_host ... ssl done\n" if ($VERBOSE >= 3); + + sleep $AFTER_SSL_SLEEP; + print STDERR "Checking TLS for $peer_host ... quit\n" if ($VERBOSE >= 3); + quit($wtr); + my $r = join '', <$rdr>; + close $rdr; + $tls_text = $r; + + last; + }; + alarm(0); + }; + if ($@) { + die $@ unless $@ eq "alarm\n"; + $error = "alarm - timeout"; + }; + if (defined $error) { + $error =~ s/Operation now in progress$/Timeout/; + }; + print STDERR "Checking TLS for $peer_host ... done\n" if ($VERBOSE >= 3); + return ($result, $warning, $error, $tls_text); +}; + + +sub get_mx($) { + my ($domain) = @_; + + my @result; + my @mx = mx($domain); + if (scalar @mx) { + @result = map { { preference => $_->preference, exchange => $_->exchange } } @mx; + } else { + @result = ( { preference => 0, exchange => $domain } ); + }; + return @result; +}; + +sub check_mx($) { + my ($host) = @_; + my $error = undef; + my $result = undef; + my $warning = undef; + my $tls = undef; + + my $query; + my $address; + my $res; + eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm($GET_MX_TIMEOUT); + $res = Net::DNS::Resolver->new; + $query = $res->search($host); + alarm(0); + }; + if ($@) { + die $@ unless $@ eq "alarm\n"; + $error = "DNS query timed out."; + }; + + if ($query) { + foreach my $rr ($query->answer) { + next unless $rr->type eq "A"; + if (defined $address) { + $warning = "$host has round robin A records"; + next; + }; + $address = $rr->address; + } + $error = "does not resolve to an ipv4 address" unless defined $address; + } else { + $error = "query failed: ".$res->errorstring + } + + # 0.0.0.0 /8 Reserved + # 10.0.0.0 /8 RFC 1918 Private + # 14.0.0.0 /8 Public Data Network1 + # 127.0.0.0 /8 Loopback + # 169.254.0.0 /16 Link-local + # 172.16.0.0 /12 RFC 1918 Private + # 192.0.2.0 /24 Example network + # 192.168.0.0 /16 RFC 1918 Private + # 224.0.0.0 /4 Multicast (Class D) + # 240.0.0.0 /4 Unspecified (Class >D) + if (defined $address && + (ipv4_in_network("0.0.0.0/8", $address) || + ipv4_in_network("10.0.0.0/8", $address) || + ipv4_in_network("127.0.0.1/8", $address) || + ipv4_in_network("169.254.0.0/16", $address) || + ipv4_in_network("172.16.0.0/12", $address) || + ipv4_in_network("192.0.2.0/24", $address) || + ipv4_in_network("192.168.0.0/16", $address) || + ipv4_in_network("224.0.0.0/4", $address) || + ipv4_in_network("240.0.0.0/4", $address))) { + $error = "stupid admin sets A record to special address space ($address)" + }; + + my $return; + $return->{'smtp'} = { + error => $error, + warning => $warning, + }; + unless (defined $error) { + my ($r, $w, $e, $t); + print STDERR $host." tls1\n" if ($VERBOSE >= 2); + ($r, $w, $e, $t) = check_tls($host); + $result .= $r if defined $r; + $warning .= $w if defined $w; + $error .= $e if defined $e; + $tls = $t if defined $t; + + $return->{'smtp'} = { + error => $error, + warning => $warning, + result => $result, + tls => $t + }; + print STDERR $host." sub\n" if ($VERBOSE >= 2); + ($r, $w, $e, $t) = check_listens($host, '587', 0); + $return->{'submission'} = { + error => $e, + warning => $w, + result => $r, + tls => $t + }; + print STDERR $host." smtps\n" if ($VERBOSE >= 2); + ($r, $w, $e, $t) = check_listens($host, 'smtps', 1); + $return->{'smtps'} = { + error => $e, + warning => $w, + result => $r, + tls => $t + }; + print STDERR $host." 2525\n" if ($VERBOSE >= 2); + ($r, $w, $e, $t) = check_listens($host, '2525', 0); + $return->{'2525'} = { + error => $e, + warning => $w, + result => $r, + tls => $t + }; + #print STDERR $host." 25000\n" if ($VERBOSE >= 2); + #($r, $w, $e, $t) = check_listens($host, '25000', 0); + #$return->{'25000'} = { + # error => $e, + # warning => $w, + # result => $r, + # tls => $t + #}; + #print STDERR $host." 22222\n" if ($VERBOSE >= 2); + #($r, $w, $e, $t) = check_listens($host, '22222', 0); + #$return->{'22222'} = { + # error => $e, + # warning => $w, + # result => $r, + # tls => $t + #}; + print STDERR $host." checkmx DONE\n" if ($VERBOSE >= 2); + }; + + return $return; +}; + +sub do_address($) { + my ($address) = @_; + + my ($localpart, $domain) = split (/@/, $address); + + my @mx = get_mx($domain); + my @result; + for my $mx (@mx) { + my $res = check_mx($mx->{exchange}); + push @result, { + mx => $mx->{exchange}, + pri => $mx->{preference}, + res => $res, + }; + }; + return \@result; +}; + + + +my @addresses; +my %NICKS; +while (<>) { + # $remailer{"aarg"} = " cpunk + if (/remailer\{"(\S+)"\}.*<([a-zA-Z0-9._-]+@[a-zA-Z0-9._-]+)>/) { + push @addresses, $2; + $NICKS{$2} = $1; + } elsif (/<([a-zA-Z0-9._-]+@[a-zA-Z0-9._-]+)>/) { + push @addresses, $1; + }; +}; + +my %unique; +@addresses = sort { $a cmp $b } @addresses; +@addresses = grep { !$unique{$_}++ } @addresses; + +my %FH; +my @PIDs; +for my $address (@addresses) { + $FH{$address} = new IO::File; + my $pid = $FH{$address}->open("-|"); + unless (defined $pid) { + die ("Could not fork: $!"); + }; + unless ($pid) { # child + my $result = do_address($address); + my $dump = Data::Dumper->Dump( [$result] ); + print STDERR "printing data for $address\n" if ($VERBOSE >= 2); + print $dump; + print STDERR "printed: $dump\n" if ($VERBOSE >= 6); + print STDERR "exiting child for $address\n" if ($VERBOSE >= 2); + exit(0); + }; + push @PIDs, $pid; + fcntl($FH{$address}, F_SETFL, O_NONBLOCK) or die "can't set non blocking: $!"; +}; + + + + +my $result; +my $END = time + 600; +my $last_notice = 0; +while ($END > time) { + my $s = IO::Select->new(); + for my $address (@addresses) { + $s->add($FH{$address}) if exists $FH{$address}; + }; + last if $s->count() == 0; + + if ($VERBOSE && $last_notice < time - 3) { + print STDERR ("Still waiting for ".join(", ", grep {exists $FH{$_}} @addresses)."\n"); + $last_notice = time; + }; + my $timeout = 3; + print STDERR "Calling can_read\n" if ($VERBOSE >= 3); + my @ready = $s->can_read($timeout); + + my $forced = 0; + if (scalar @ready == 0) { + print STDERR "no ready handles, read them all\n" if $VERBOSE; + @ready = $s->handles(); + $forced = 1; + }; + + for my $fh (@ready) { + print STDERR "$fh is ready".($forced ? " (not really)" : "")."\n" if ($VERBOSE >= 3); + my $addr; + for my $address (@addresses) { + next unless exists $FH{$address}; + if ($fh->fileno() == $FH{$address}->fileno()) { + $addr = $address; + last; + }; + }; + die ("No address for $fh\n"), next unless defined $addr; + + print STDERR "reading fh for $addr\n" if ($VERBOSE >= 2); + + my $buf; + + my $res = sysread($fh, $buf, 100000); + my $error = $ERRNO; + print STDERR "$fh read $res bytes\n" if (defined $res && $VERBOSE); + if (!defined $res) { + printf STDERR ("got error $ERRNO, again: %d, wouldb: %d\n", EAGAIN, EWOULDBLOCK) if ($VERBOSE > 5); + printf STDERR ("got error $ERRNO\n") if ($ERRNO != EWOULDBLOCK); + } elsif ($res > 0) { + $result->{$addr} .= $buf; + } else { + $fh->close; + delete $FH{$addr}; + print STDERR "$addr reading DONE\n" if $VERBOSE; + }; + }; +}; +print STDERR "DONE\n" if $VERBOSE; + +for my $address (@addresses) { + if (exists $FH{$address}) { + delete $result->{$address}; + warn ("$address failed\n"); + }; +}; +for my $key (keys %$result) { + my $VAR1; + my $fo = eval ($result->{$key}); + $VAR1 = undef; + $result->{$key}= $fo; +}; + +=pod +print STDERR "FOOOOO\n"; +my $result; + for my $address (@addresses) { +eval { + alarm(200); + print STDERR "waiting for $address.\n" if $VERBOSE; + my $fh = $FH{$address}; + undef $/; + my $res = <$fh>; + $FH{$address}->close; + + my $VAR1; + my $fo = eval ($res); + $result->{$address} = $fo; + $VAR1 = undef; + print STDERR "$address READ.\n" if $VERBOSE; +}; + }; + alarm(0); +if ($@) { + die $@ unless $@ eq "alarm\n"; +}; + +=cut + + +#my $kid; +#do { +# $kid = waitpid(-1,WNOHANG); +#} until $kid == -1; + + +my $data; +for my $remailer (keys %$result) { + my $d; + $d->{'address'} = $remailer; + $d->{'nick'} = $NICKS{$remailer} || 'N/A'; + $d->{'mx'} = $result->{$remailer}; + push @{$data}, $d; +}; + +print Data::Dumper->Dump( [$data] ); diff --git a/bin/tls2html b/bin/tls2html new file mode 100755 index 0000000..050bdb8 --- /dev/null +++ b/bin/tls2html @@ -0,0 +1,59 @@ +#!/usr/bin/perl + +use HTML::Template; + +undef $/; +my $VAR1; +my $code = <>; +my $tls_data = eval $code; + + +my $data; +for my $remailer (sort {$a->{'nick'} cmp $b->{'nick'}} @$tls_data) { + for my $mx (@{$remailer->{'mx'}}) { + for my $key (keys %{$mx->{'res'}->{'smtp'}}) { + $mx->{$key} = $mx->{'res'}->{'smtp'}->{$key}; + }; + for my $type (qw{submission smtps 2525}) { + #for my $type (qw{submission smtps 2525 25000}) { + #for my $type (qw{submission smtps 2525 22222}) { + $mx->{$type} = $mx->{'res'}->{$type}->{'result'}; + }; + $mx->{'ssl'} = $mx->{'res'}->{'smtps'}->{'tls'}; + if ($mx->{'tls'}) { + my $basename = $mx->{'mx'}; + $basename =~ s/[^A-Za-z0-9\.-]//g; + $basename =~ s/\.\././; + $basename = 'cert-' . $basename . '.txt'; + open (F, '>'.$basename) or die ("Cannot open $basename: $!\n"); + print F $mx->{'tls'}; + close (F); + $mx->{'cert_url'} = $basename; + ($mx->{'tls-cipher'}) = $mx->{'tls'} =~ /Cipher is (.*)$/m; + }; + if ($mx->{'ssl'}) { + my $basename = $mx->{'mx'}; + $basename =~ s/[^A-Za-z0-9\.-]//g; + $basename =~ s/\.\././; + $basename = 'cert-' . $basename . '.ssl.txt'; + open (F, '>'.$basename) or die ("Cannot open $basename: $!\n"); + print F $mx->{'ssl'}; + close (F); + $mx->{'ssl_url'} = $basename; + ($mx->{'ssl-cipher'}) = $mx->{'ssl'} =~ /Cipher is (.*)$/m; + }; + $mx->{'result-defined'} = defined $mx->{'result'}; + }; + push @{$data->{'remailer'}}, $remailer; +}; + +$data->{'now'} = gmtime(); + +#require Data::Dumper; +#print Data::Dumper->Dump([$tls_data]); + +my $template = HTML::Template->new(filename => 'template.tmpl', die_on_bad_params => 0); +$template->param( $data ); +my $out = $template->output; + +print $out; -- cgit v1.2.3