#!/usr/bin/perl -w

# mailtest check module

# Version: $Revision: 1.2 $
# Author: Eric Garrido, Patrick Radtke, and Matt Selsky
# Date: $Date: 2006/01/23 00:33:14 $
#
# Copyright (c) 2006
# The Trustees of Columbia University in the City of New York
# Columbia University Information Technology
# 
# License restrictions apply, see doc/license.html for details. 

use strict;
use FindBin;
use lib "$FindBin::Bin/../common";
use Survivor::Check;
use Mail::Send;
use Mail::IMAPClient;

my %argformat = ('smtphost' => 'string',
		 'imapprot' => 'optional string one(imap,imaps) default(imaps)', 
		 'username' => 'string',
		 'password' => 'password',
		 'wait'     => 'optional number between(0,inf) default(2)',
		 'expunge'  => 'optional boolean default(true)',);

sub MailthroughValidate {
    return(MODEXEC_OK, 0, "Test OK");  
}

sub MailthroughCheck {

    my $self = shift;
    my $host = shift 
	|| return(MODEXEC_MISCONFIG, 0, "no hostname provided");

    if($host eq ""){
	return(MODEXEC_MISCONFIG, 0, "no hostname provided");
    }

    my $username = $self->Arg('username');
    my $password = $self->Arg('password');
    my $smtphost = $self->Arg('smtphost');
    
    if($password eq "" || $username eq "" 
       || $smtphost eq "" || $host eq ""){
	return(MODEXEC_MISCONFIG, 0, "required parameter(s) are missing");
    }

    my $rc = MODEXEC_OK;
    my $err;


    # construct the message headers
    my $msg = new Mail::Send;
    $msg->to("${username}\@${smtphost}");
    my $subject_string = $host . ' ' . localtime();
    $msg->subject($subject_string);   

    # add the message body
    my $fh = $msg->open;
    print $fh "Testing delivery\n";
    
    # send the message
    $fh->close;

    # sleep now, if we should
    if($self->Arg('wait') > 0){
	sleep($self->Arg('wait'));
    }

    my $imap = new Mail::IMAPClient;

    if($self->Arg('imapprot') eq 'imaps') {
	# create an ssl socket and give it to IMAP
	my $ssl_socket = new IO::Socket::SSL("$host:imaps");
	unless(defined $ssl_socket) {
	    return(MODEXEC_PROBLEM, 0, "Cannot create SSL socket: $@");
	}
	$imap->Socket($ssl_socket);
	$imap->State(1);
 
    } else {
	# do a regular connect on the imap server
	$imap->Server($host);
	unless($imap->connect()) {
	    return(MODEXEC_PROBLEM, 0, 'Connection refused for imap protocol');
	}
    }
 
    # login to the imap server
    $imap->User($username);
    $imap->Password($password);
     unless($imap->login()) {
	return(MODEXEC_PROBLEM, 0, "Cannot login as $username");
    } else {
	$err = "Success logging in as $username";
    }

    # select the inbox and search for the recently sent message
    if($imap->select('INBOX')) {
	$err = "Success opening INBOX as $username";
    } else {
	return(MODEXEC_PROBLEM, 0,  "Cannot open INBOX as $username");
    }
    my @messages = $imap->search(qq/SUBJECT "$subject_string"/);

    # if there is one result and the result 
    # does not indicate no messages found
    if (scalar(@messages) == 1 and $messages[0] != 0){
	$err = "exactly one message was returned";
	
	# try to delete the message
	unless($imap->delete_message(@messages) == scalar(@messages)){
	    $rc = MODEXEC_NOTICE;
	    $err = "unable to delete the message";
	}
    }
    else{
	if($messages[0] == 0 && $@ ne ""){ # the search did not succeed
	    $err = "imap search failed: $@";
	}
	elsif($messages[0] == 0 && $@ eq ""){ # the search succeeded, but gave no results
	    $err = "message was not received by the imap server";
	}
	else {
	    $err = "unknown IMAP error";
	}

	return(MODEXEC_PROBLEM, 0, $err);
    }
    
    # try to expunge the message, if desired
    if($self->Arg('expunge') eq 'true'){
	unless($imap->expunge('INBOX')){
	    $rc = MODEXEC_NOTICE;
	    $err = "unable to expunge the inbox";
	}
    }

    unless($imap->logout()) {
	return(MODEXEC_PROBLEM, 0, "Cannot logout as $username");
    }

    if($rc == MODEXEC_OK) {
	return($rc, 1, $err);
    } else {
	return($rc, 0, $err);
    }

}

# begin main block
{

my $sc = new Survivor::Check();

$sc->GetOpt(\%argformat, \&MailthroughValidate);

if($sc->Arg('imapprot') eq 'imaps') {
    require IO::Socket::SSL;
    import IO::Socket::SSL;
}

if($sc->Arg('imapprot') ne 'imap') {
    # Disable threading pending verification that SSL is threadsafe
    $sc->UseThreads(0);
} 

my $result = $sc->Exec(\&MailthroughCheck);

exit($result);

}
