summaryrefslogtreecommitdiff
path: root/bin/tls-check
diff options
context:
space:
mode:
Diffstat (limited to 'bin/tls-check')
-rwxr-xr-xbin/tls-check566
1 files changed, 566 insertions, 0 deletions
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] );
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-29 00:46:50 +0000