1 #! /usr/bin/perl

     2 # up-to-date source is at:

     3 # https://keller.schlittermann.de/hg/check-smtp-auth

     4 

     5 use strict;

     6 use warnings;

     7 use Sys::Hostname;

     8 use IO::Socket::INET;

     9 use IO::Socket::SSL;

    10 use Pod::Usage;

    11 use Getopt::Long;

    12 

    13 my $HOSTNAME = hostname();

    14 

    15 my $opt_ssl   = 0;

    16 my $opt_debug = 0;

    17 

    18 sub check_auth($$);

    19 

    20 MAIN: {

    21 

    22     GetOptions(

    23         "d|debug" => \$opt_debug,

    24         "s|ssl"   => \$opt_ssl,

    25 	"m|man"   => sub { pod2usage(-exitval => 0, -verbose => 2) },

    26 	"h|help"   => sub { pod2usage(-exitval => 0, -verbose => 1) },

    27     ) or pod2usage();

    28 

    29     my $remote = shift or pod2usage;

    30     $remote .= $opt_ssl ? ":smtps" : ":smtp" if not $remote =~ /:/;

    31 

    32     warn "connecting to $remote\n" if $opt_debug;

    33     my $s =

    34       $opt_ssl

    35       ? new IO::Socket::SSL($remote)

    36       : new IO::Socket::INET($remote)

    37       or die "Can't open socket to $remote\n";

    38 

    39     # Get the greeting and even expect continuation lines

    40     # I do not know if they may appear in the greeting, probably not,

    41     # because it's feature of ESMTP and the server doesn't know if the

    42     # client would understand it)

    43 

    44     while (<$s>) { last if /^\d{3}\s/ }

    45 

    46     # Do not continue on any error

    47     /^2/ or die "expected 2xx\n";

    48 

    49     # Do not continue if the server does not speak ESMTP

    50     /ESMTP/ or die "expected ESMTP";

    51 

    52     # first attempt plain (or SSL)

    53     print map { "$_\n" } check_auth($s, $HOSTNAME);

    54 

    55     # if still not closed we should try STARTTLS

    56     if ($s->connected) {

    57         warn "trying STARTTLS\n" if $opt_debug;

    58 

    59         print {$s} "STARTTLS\r\n";

    60         while (<$s>) { last if /^\d{3}\s/ }

    61         /^2.. TLS/ or die "can't start TLS: $_";

    62 

    63         IO::Socket::SSL->start_SSL($s);

    64         print map { "$_\n" } check_auth($s, $HOSTNAME);

    65     }

    66 

    67 }

    68 

    69 sub check_auth($$) {

    70     my ($socket, $hostname, $tls) = @_;

    71     my $close = 1;

    72     my @auth;

    73 

    74     print {$socket} "EHLO $HOSTNAME\r\n";

    75 

    76     my $prefix = ref($socket) =~ /::SSL$/ ? "ssl" : "plain";

    77 

    78     # Parse the response to the EHLO

    79     while (<$socket>) {

    80         print STDERR if $opt_debug;

    81         /STARTTLS/ and $close = 0;

    82         push @auth, map { "$prefix $_" } split if s/^.*AUTH\s+//;

    83         last if /^\d{3}\s/;    # last line

    84     }

    85 

    86     if ($close) {

    87         print {$socket} "QUIT\r\n";

    88         $socket->close;

    89     }

    90 

    91     return @auth;

    92 }

    93 

    94 __END__

    95 

    96 =head1 NAME

    97 

    98  check-smtp-auth - checks the auth capabilities of a remote SMTP server

    99 

   100 =head1 SYNOPSIS

   101 

   102  check-smtp-auth [-d|--debug] [-s|--ssl] server[:port]

   103  check-smtp-auth [-m|--man] [-h|--help]

   104 

   105 =head1 DESCRIPTION

   106 

   107 This tools checks the AUTH capabilities of a SMTP server. It connects, 

   108 issues an "EHLO" command and tries to parse the output.

   109 

   110 If in the server output "STARTTLS" appears, it retries to get this

   111 information after issuing "STARTTLS".

   112 

   113 The output is line by line one AUTH method, prefixed with "plain"

   114 or "ssl", depending on the type of the connection.

   115 

   116 =head1 OPTIONS

   117 

   118 =over

   119 

   120 =item [-s|--ssl]

   121 

   122 Connect via a SSL socket. This option changes the default port

   123 to connect to "smtps" instead of "smtp". (default: 0)

   124 

   125 =item [-d|--debug]

   126 

   127 Issue some debugging information to STDERR. (default: 0)

   128 

   129 =back

   130 

   131 =head1 AUTHOR

   132 

   133 Heiko Schlittermann <hs@schlittermann.de>

   134 See L<https://keller.schlittermann.de/hg/check-smtp-auth> for

   135 the current version.

   136 

   137 =cut