summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorPeter Palfrader <peter@palfrader.org>2004-11-15 09:20:11 +0000
committerPeter Palfrader <peter@palfrader.org>2004-11-15 09:20:11 +0000
commit5e95090defff64bc8cd7a318a73aa930948fb66d (patch)
treed977ded4207e51914d539b0ecd20b8583d37c8ea /bin
parent6c3e0ba0a82307abf825bf1cde85638464ab1713 (diff)
Initial import
Diffstat (limited to 'bin')
-rwxr-xr-xbin/allpingers-ini2xml159
-rwxr-xr-xbin/guess-uris68
-rwxr-xr-xbin/remailer-states-create57
-rwxr-xr-xbin/remailer-states-make-image30
-rwxr-xr-xbin/remailer-states-make-image-long30
-rwxr-xr-xbin/remailer-states-make-image-long-231
-rwxr-xr-xbin/tls-check566
-rwxr-xr-xbin/tls2html59
8 files changed, 1000 insertions, 0 deletions
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 <peter@palfrader.org>
+# $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<update>
+
+=back
+
+=head1 DESCRIPTION
+
+FIXME
+
+=back
+
+=head1 BUGS
+
+Please report them to the author.
+
+=head1 AUTHOR
+
+Peter Palfrader, E<lt>peter@palfrader.orgE<gt>
+
+=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{<?xml version="1.0"?>\n};
+printf qq{<!-- A L L P I N G E R S' I N D E X -->
+<!-- -->
+<!-- Generated: %-54s -->
+<!-- -->
+<!-- This list can be found on the web on http://www.noreply.org/ -->
+<!-- -->
+<!-- If anything is wrong/broken/missing please mail the maintainer at -->
+<!-- pingers\@palfrader.org -->
+}, scalar gmtime();
+print qq{
+<!DOCTYPE pingers [
+<!ELEMENT pingers (pinger*)>
+<!ATTLIST pingers
+ version CDATA #FIXED "1"
+ generated CDATA #REQUIRED
+ >
+<!ELEMENT pinger (
+ baseurl?,
+ rlist*,
+ mlist*,
+ rchain*,
+ pgpring*,
+ mixring?,
+ type2list?
+ )>
+<!ATTLIST pinger
+ name CDATA #REQUIRED
+ >
+<!ELEMENT baseurl (#PCDATA)>
+<!ELEMENT rlist (#PCDATA)>
+<!ATTLIST rlist
+ version (1|2) "1"
+ format (txt|html) "txt"
+ >
+<!ELEMENT mlist (#PCDATA)>
+<!ATTLIST mlist
+ version (1|2) "1"
+ format (txt|html) "txt"
+ >
+<!ELEMENT rchain (#PCDATA)>
+<!ATTLIST rchain
+ format (txt|html) "txt"
+ >
+<!ELEMENT pgpring (#PCDATA)>
+<!ATTLIST pgpring
+ format (asc|pgp) "asc"
+ keys (rsa|dsa|all) "all
+ ">
+<!ELEMENT mixring (#PCDATA)>
+<!ELEMENT type2list (#PCDATA)>
+]>
+};
+
+my $now = `822-date`;
+chomp $now;
+printf qq{<pingers version="1" generated="%s">\n}, $now;
+for my $pinger (sort keys %pingers) {
+ my $p = $pingers{$pinger};
+ printf qq{\t<pinger name="%s">\n}, $pinger;
+ printf (qq{\t\t<baseurl>%s</baseurl>\n}, $p->{'base'}) and delete $p->{'base'} if defined ($p->{'base'});
+
+ printf (qq{\t\t<rlist version="1" format="txt">%s</rlist>\n}, $p->{'rlist'})and delete $p->{'rlist'} if defined ($p->{'rlist'});
+ printf (qq{\t\t<rlist version="2" format="txt">%s</rlist>\n}, $p->{'rlist2'})and delete $p->{'rlist2'} if defined ($p->{'rlist2'});
+ printf (qq{\t\t<rlist version="1" format="html">%s</rlist>\n}, $p->{'rlist_html'})and delete $p->{'rlist_html'} if defined ($p->{'rlist_html'});
+ printf (qq{\t\t<rlist version="2" format="html">%s</rlist>\n}, $p->{'rlist2_html'})and delete $p->{'rlist2_html'} if defined ($p->{'rlist2_html'});
+
+ printf (qq{\t\t<mlist version="1" format="txt">%s</mlist>\n}, $p->{'mlist'})and delete $p->{'mlist'} if defined ($p->{'mlist'});
+ printf (qq{\t\t<mlist version="2" format="txt">%s</mlist>\n}, $p->{'mlist2'})and delete $p->{'mlist2'} if defined ($p->{'mlist2'});
+ printf (qq{\t\t<mlist version="1" format="html">%s</mlist>\n}, $p->{'mlist_html'})and delete $p->{'mlist_html'} if defined ($p->{'mlist_html'});
+ printf (qq{\t\t<mlist version="2" format="html">%s</mlist>\n}, $p->{'mlist2_html'})and delete $p->{'mlist2_html'} if defined ($p->{'mlist2_html'});
+
+ printf (qq{\t\t<rchain format="txt">%s</rchain>\n}, $p->{'rchain'})and delete $p->{'rchain'} if defined ($p->{'rchain'});
+ printf (qq{\t\t<rchain format="html">%s</rchain>\n}, $p->{'rchain_html'})and delete $p->{'rchain_html'} if defined ($p->{'rchain_html'});
+
+ printf (qq{\t\t<pgpring format="asc" keys="all">%s</pgpring>\n}, $p->{'pgpring'})and delete $p->{'pgpring'} if defined ($p->{'pgpring'});
+ printf (qq{\t\t<pgpring format="asc" keys="rsa">%s</pgpring>\n}, $p->{'pgpring_rsa'})and delete $p->{'pgpring_rsa'} if defined ($p->{'pgpring_rsa'});
+
+ printf (qq{\t\t<mixring>%s</mixring>\n}, $p->{'mixring'})and delete $p->{'mixring'} if defined ($p->{'mixring'});
+ printf (qq{\t\t<type2list>%s</type2list>\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</pinger>\n};
+}
+print qq{</pingers>\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 <rrd_dir> <target_dir>" >&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 <rrd_dir> <target_dir>" >&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 <rrd_dir> <target_dir>" >&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"} = "<remailer@aarg.net> 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;