Made the usage of IO::Socket::SSL conditinal. default tip
authorHeiko Schlittermann <hs@schlittermann.de>
Tue, 27 Jan 2009 15:02:39 +0100
changeset 2 58196aa33732
parent 1 6f3d1d1f856a
Made the usage of IO::Socket::SSL conditinal.
check-smtp-auth
--- a/check-smtp-auth	Mon Jan 26 21:33:59 2009 +0100
+++ b/check-smtp-auth	Tue Jan 27 15:02:39 2009 +0100
@@ -1,20 +1,40 @@
 #! /usr/bin/perl
-# up-to-date source is at:
+# Up-to-date source can be found:
 # https://keller.schlittermann.de/hg/check-smtp-auth
 
+#    Check the availability of SMTP AUTH options on a remote server
+#    Copyright (C) 2009  Heiko Schlittermann
+#
+#    This program is free software: you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation, either version 3 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#
+#    Heiko Schlittermann <hs@schlittermann.de>
+
 use strict;
 use warnings;
 use Sys::Hostname;
 use IO::Socket::INET;
-use IO::Socket::SSL;
 use Pod::Usage;
 use Getopt::Long;
+use File::Basename;
 
+my $ME       = basename $0;
 my $HOSTNAME = hostname();
 
 my $opt_ssl   = 0;
 my $opt_debug = 0;
 
+sub load_ssl();
 sub check_auth($$);
 
 MAIN: {
@@ -29,12 +49,15 @@
     my $remote = shift or pod2usage;
     $remote .= $opt_ssl ? ":smtps" : ":smtp" if not $remote =~ /:/;
 
+    load_ssl() or die "$ME: Can't load SSL support: $@\n"
+      if $opt_ssl;
+
     warn "connecting to $remote\n" if $opt_debug;
     my $s =
       $opt_ssl
       ? new IO::Socket::SSL($remote)
       : new IO::Socket::INET($remote)
-      or die "Can't open socket to $remote\n";
+      or die "$ME: Can't open socket to $remote\n";
 
     # Get the greeting and even expect continuation lines
     # I do not know if they may appear in the greeting, probably not,
@@ -44,21 +67,28 @@
     while (<$s>) { last if /^\d{3}\s/ }
 
     # Do not continue on any error
-    /^2/ or die "expected 2xx\n";
+    /^2/ or die "$ME: expected 2xx\n";
 
     # Do not continue if the server does not speak ESMTP
-    /ESMTP/ or die "expected ESMTP";
+    /ESMTP/ or die "$ME: expected ESMTP";
 
     # first attempt plain (or SSL)
     print map { "$_\n" } check_auth($s, $HOSTNAME);
 
     # if still not closed we should try STARTTLS
     if ($s->connected) {
+
+        if (not load_ssl()) {
+            $s->close;
+            die "$ME: Server advertised STARTTLS, "
+              . "but I can't load SSL support: $@\n";
+        }
+
         warn "trying STARTTLS\n" if $opt_debug;
 
         print {$s} "STARTTLS\r\n";
         while (<$s>) { last if /^\d{3}\s/ }
-        /^2.. TLS/ or die "can't start TLS: $_";
+        /^2.. TLS/ or die "$ME: can't start TLS: $_";
 
         IO::Socket::SSL->start_SSL($s);
         print map { "$_\n" } check_auth($s, $HOSTNAME);
@@ -91,6 +121,14 @@
     return @auth;
 }
 
+sub load_ssl() {
+    eval {
+        require IO::Socket::SSL;
+        IO::Socket::SSL->import();
+    };
+    return $@ ? 0 : 1;
+}
+
 __END__
 
 =head1 NAME