# HG changeset patch # User Heiko Schlittermann # Date 1233064959 -3600 # Node ID 58196aa337321fc709253908643562f43fedb4eb # Parent 6f3d1d1f856a0a0bd1335ca273f5358acfbb2f47 Made the usage of IO::Socket::SSL conditinal. diff -r 6f3d1d1f856a -r 58196aa33732 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 . +# +# Heiko Schlittermann + 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