Querying SSL/TLS capabilities of SMTP servers

[Justin]

On 2004-07-09T01:46:26+0200, Thomas Shaddack wrote:
> 
> It fails on hotmail.com; my script has problems there as well (and with 
> couple others, the cure seems to be adding delays between the lines sent 
> to the server; it makes the program slow, but more reliable).

This should work much better, and has some additional keywords that help
to figure out what's going on.  This works on hotmail.

I noticed one host was hanging until I started using \r\n.

It might be worthwhile to ensure nagle is turned off between the EHLO
and the QUIT.


#!/usr/bin/perl

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

$dlevel = 0;

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

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

    my $mhost = IO::Socket::INET->new (
 	    Proto => "tcp",
	    PeerAddr => $mrelay,
	    PeerPort => "25",
	    Timeout => "5"
    );
    if (! defined $mhost) {
	print "$domain $mpri $mrelay noconnect\n";
	return;
    }
    debug("testing $mrelay $mpri\n", 1);
    $greeting = <$mhost>;
    if ($greeting =~ /\*\*\*\*\*\*\*\*/) {
	$proto = "smtp";
	push (@special, "filtered");
    }
    if ($greeting =~ /(esmtp|postfix|sendmail)/i) {
	$proto = "esmtp";
    }
    elsif ($greeting =~ /[^eE][sS][mM][tT][pP]/) {
	$proto = "smtp";
    }
    else { $proto = "smtp"; }

    print $mhost "EHLO I-love-my-country.whitehouse.gov\r\n";
    print $mhost "QUIT\r\n";
    while (<$mhost>) {
	if (/^5[0-9]{2}/) {
	    if ($proto == "esmtp") {
		push(@special, "lies");
	    	$proto = "smtp";
	    }
	    $hastls = "no-tls";
	    last;
	}
	if (/STARTTLS/) {
	    if ($proto == "smtp") {
		$proto = "esmtp";
		push(@special, "stealth");
	    }
	    $hastls = "adv-tls";
	    last;
	}
    }
    print "$domain $mpri $mrelay $proto $hastls @special\n";
    close $mhost;
}


### begin ####

debug("argc: $#ARGV\n", 1);

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

while ($domain = shift(@ipstack)) {
    # $res = Net::DNS::Resolver->new();
    # @mx = mx($res, $domain);
    my @mx = mx($domain);
    if ($#mx == -1) {
	print "no MX!\n";
    }
    foreach $record (@mx) {
        my $mrelay = $record->exchange ;
        my $mpri = $record->preference ;
	checkmailtls($domain, $mpri, $mrelay);
    }
}