imap-ssl monitor script

[Dietmar Goldbeck]

   Hello,

i have put together a script to check an ssl imap server.
It needs perl with the Net::SSLeay module.

Please put the script in the contrib area.
Comments welcome,

     Dietmar 

-- 
 Alles Gute / best wishes  
     Dietmar Goldbeck                E-Mail: [EMAIL PROTECTED]
Reporter (to Mahatma Gandhi): Mr Gandhi, what do you think of Western
Civilization?  Gandhi: I think it would be a good idea.

#!/usr/bin/perl

# Check imap SSL Server
# for use with mon 
# Dietmar Goldbeck <[EMAIL PROTECTED]>
# 04.02.2002

use Getopt::Std;
use Socket;
use Net::SSLeay qw(die_now die_if_ssl_error) ;
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();

getopts ("p:t:");
$PORT = $opt_p || 993;
$TIMEOUT = $opt_t || 30;

@failures = ();
@details = ();

foreach $host (@ARGV) {

    if (! &imapsCheck($host, $PORT)) {
        push (@failures, $host);
    }
}

if (@failures == 0) {
    exit 0;
} else {
   print join (" ", sort @failures), "\n";
  print sort @details if(scalar @details) > 0;
  exit 1;
}


sub imapsCheck {
  my($dest_serv, $port) = @_;
  my($ServerOK, $msg);
  #
  $ServerOK = 0;
  
  eval {
    
    local $SIG{ALRM} = sub { die "Timeout exceeded ($TIMEOUT s)\n" };
    alarm $TIMEOUT;
    
    $msg="A1 LOGOUT\r\n";
    
    $port = getservbyname ($port, 'tcp') unless $port =~ /^\d+$/;
    $dest_ip = gethostbyname ($dest_serv);
    $dest_serv_params  = sockaddr_in($port, $dest_ip);
    
    socket  (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
    connect (S, $dest_serv_params)          or die "connect: $!";
    select  (S); $| = 1; select (STDOUT);   # Eliminate STDIO buffering
    
    # The network connection is now open, lets fire up SSL
    
    $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
    Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
        and die_if_ssl_error("ssl ctx set options");
    $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
    Net::SSLeay::set_fd($ssl, fileno(S));   # Must use fileno
    $res = Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect");
    #print "DEBUG Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
    
    # Exchange data
    
    $got = Net::SSLeay::read($ssl);         # Perl returns undef on failure
    #print "DEBUG Server: $got\n";
    if($got !~ /^\* (OK|PREAUTH|BYE)/) {
      alarm 0;
      return 0;
    };
    #print "DEBUG: found OK\n";
    $res = Net::SSLeay::write($ssl, $msg);  # Perl knows how long $msg is           
die_if_ssl_error("ssl write");
    #print "DEBUG: wrote $msg\n";

    while (defined($got = Net::SSLeay::read($ssl))) {
      #print "DEBUG: Server: $got\n";
      if($got =~ /A1 OK/) {
        last;
        $ServerOK=0;
      }
    }
    #$got = Net::SSLeay::read($ssl);
    #print "Server: $got\n";
    $ServerOK=1;
    shutdown S, 1;  # Half close --> No more output, sends EOF to server
    die_if_ssl_error("ssl read");
    
    Net::SSLeay::free ($ssl);               # Tear down connection
    Net::SSLeay::CTX_free ($ctx);
    close S;
    alarm 0;
  };
  
  if($@) {
    push(@details, "$dest_serv: $@\n");
    return 0;
  } else {
    return $ServerOK;
  }
}