Re: 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);
        }
    }
}