Querying SSL/TLS capabilities of SMTP servers

[Justin]

This one should work better.  The last one had string comparison
problems.


#!/usr/bin/perl

use IO::Select;
use IO::Socket;
use Net::DNS;

$ehloname = "mail.senate.gov";
$timeout = 15;
$dlevel = 0;

sub debug {
    (my $str, my $mlevel) = @_;
    if ($mlevel <= $dlevel) { print "DEBUG $str"; }
}

sub checkmailtls {
    my ($domain, $mpri, $mrelay) = @_;
    my $proto = "smtp";
    my $hastls = "no-tls";
    my @flags;

    my $mhost = IO::Socket::INET->new (
 	    Proto => "tcp", PeerAddr => $mrelay,
	    PeerPort => "25", Timeout => "10"
    );
    if (! defined $mhost) {
	print "$domain $mpri $mrelay noconnect\n";
	return;
    }

    debug("opened connection to $mrelay\n", 1);

    $sel = IO::Select->new($mhost);
    @readable = $sel->can_read($timeout);   # magic number
    if ($#readable == -1) {
	print "$domain $mpri $mrelay timeout-a\n";
	goto OUT;
    }
    $greeting .= <$mhost>; # there's only one handle; we know which it is.

    debug("greeting: $greeting", 2);
    if ($greeting =~ /[\\*]{8}/) {
	$proto = "smtp";
	push (@flags, "filtered");
    }
    if ($greeting =~ /\b(esmtp|postfix|exim|sendmail)\b/i) {
        debug("setting esmtp (greet)!\n", 1);
	$proto = "esmtp";
    	debug("found esmtp-indicator in greeting\n", 1);
    }

    print $mhost "EHLO $ehloname\r\n";
    print $mhost "QUIT\r\n";

    if (! (@readable = $sel->can_read($timeout))) {
	print "$domain $mpri $mrelay timeout-b\n";
	goto OUT;
    }
    while (<$mhost>) { #$sel->can_read(0)) {
	chomp;
	debug("loop-recv: $_\n", 2);
	if (/^5[0-9]{2}/) {
	    if ($proto =~ /^esmtp/) {
		push(@flags, "lies");
	    	$proto = "smtp";
	    }
	    $hastls = "no-tls";
	    last;
	}
	if (/STARTTLS/) {
	    if ($proto =~ /^smtp/) {
		debug("setting esmtp (stls)!\n", 1);
		$proto = "esmtp";
		push(@flags, "nobproto");
	    }
	    $hastls = "adv-tls";
	    last;
	}
    }
    print "$domain $mpri $mrelay $proto $hastls @flags\n";

    # try again just in case the remote host didn't notice the first one
    print $mhost "QUIT\r\n";
OUT:
    close $mhost;
    debug("closed connection to $mrelay\n", 1);
}

### begin ####
if ($#ARGV >= 0) {
    for ($i = 0; $i <= $#ARGV; $i++) { push (@hostfifo, $ARGV[$i]); }
} else {
    while (<>) { chomp; push (@hostfifo, $_); }
}

while ($domain = shift(@hostfifo)) {
    my @mx = mx($domain);
    if ($#mx == -1) {
	checkmailtls($domain, "A", $domain);
    } else {
	foreach $record (@mx) {
	    my $mrelay = $record->exchange;
	    my $mpri = $record->preference;
	    checkmailtls($domain, $mpri, $mrelay);
	}
    }
}