#!/usr/local/bin/perl

# $Header: /mhub4/sources/imap-tools/imapPing.pl,v 1.2 2009/11/24 23:04:43 rick Exp $

############################################################################
#   Program   imapPing.pl                                                  #
#   Date      20 January 2008                                              #
#                                                                          #
#   Description                                                            #
#                                                                          #
#   This script performs some basic IMAP operations on a user's            #
#   account and displays the time as each one is executed.  The            #
#   operations are:                                                        #
#           1.  Connect to the IMAP server                                 #
#           2.  Log in with the user's name and password                   #
#           3.  Get a list of mailboxes in the user's account              #
#           4.  Select the INBOX                                           #
#           5.  Get a list of messages in the INBOX                        #
#           6.  Log off the server                                         #
#                                                                          #
# Usage: imapPing.pl -h <host> -u <user> -p <password>                     #
#                                                                          #
############################################################################
# Copyright (c) 2008 Rick Sanders <rfs9999@earthlink.net>                  #
#                                                                          #
# Permission to use, copy, modify, and distribute this software for any    #
# purpose with or without fee is hereby granted, provided that the above   #
# copyright notice and this permission notice appear in all copies.        #
#                                                                          #
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES #
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         #
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  #
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   #
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    #
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  #
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           #
############################################################################

use Getopt::Std;
use Socket;
use FileHandle;
use Fcntl;
use IO::Socket;
use IMAP::Utils;

   init();
   ($host,$user,$pwd) = getArgs(); 

   print STDOUT pack( "A35 A10", "Connecting to $host", getTime() );
   connectToHost( $host, \$conn );

   print STDOUT pack( "A35 A10","Logging in as $user", getTime() );
   login( $user,$pwd, $conn );

   print STDOUT pack( "A35 A10","Get list of mailboxes", getTime() );
   getMailboxList( $conn );

   print STDOUT pack( "A35 A10","Selecting the INBOX", getTime() );
   selectMbx( 'INBOX', $conn ) if $rc;

   print STDOUT pack( "A35 A10","Get list of msgs in INBOX", getTime() );
   getMsgList( 'INBOX', $conn );

   print STDOUT pack( "A35 A10","Logging out", getTime() );
   logout( $conn );

   print STDOUT pack( "A35 A10","Done", getTime() );
   
   exit;
   
   exit 1;


sub init {

   #  Determine whether we have SSL support via openSSL and IO::Socket::SSL
   IMAP::Utils::init();
   getTime();
   $debug = 1;
}

sub getTime {

   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
   if ($year < 99) { $yr = 2000; }
   else { $yr = 1900; }
   $date = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d \n",
		$mon+1,$mday,$year+$yr,$hour,$min,$sec);
   $time = sprintf ("%.2d:%.2d:%.2d \n",$hour,$min,$sec);

   return $time;
}

sub getArgs { 

   getopts( "h:u:p:" );
   $host = $opt_h;
   $user = $opt_u;
   $pwd  = $opt_p;
   $showIMAP = 1 if $opt_I;

   if ( $opt_H ) {
	usage();
   }

   unless ( $host and $user and $pwd ) {
	usage();
        exit;
   }


   return ($host,$user,$pwd);   

}

sub usage {

   print STDOUT "\nUsage: iu-ping <args> \n\n";
   print STDOUT "   -h   <hostname>\n";
   print STDOUT "   -u   <user>\n"; 
   print STDOUT "   -p   <password>\n";

   exit;

}


sub selectInbox {

my $mbx  = shift;
my $conn = shift;

   #  Select a mailbox

   sendCommand ($conn, "1 SELECT $mbx");
   while (1) {
	$response = readResponse ($conn);
	if ($response =~ /^1 OK/i) {
	   last;
	}
	elsif ($response !~ /^\*/) {
	   print STDOUT "Unexpected SELECT INBOX response: $response\n";
	   return 0;
	}
   }

}

sub getMailboxList {

my $conn = shift;

   #  Get a list of the user's mailboxes
   
   sendCommand ($conn, "1 LIST \"\" *");
   @response = ();
   while ( 1 ) {
      $response = readResponse ($conn);
      last if $response =~ /^1 OK/i;
	
      if ( $response !~ /^\*/ ) {
	 print STDOUT "unexpected response: $response\n";
         return 0;
      }
   }

   @mbxs = ();
   for $i (0 .. $#response) {
	# print STDERR "$response[$i]\n";
	$response[$i] =~ s/\s+/ /;
	($dmy,$mbx) = split(/"\/"/,$response[$i]);
	$mbx =~ s/^\s+//;  $mbx =~ s/\s+$//;
	$mbx =~ s/"//g;

	if ($mbx =~ /^\#/) {
	   #  Skip public mbxs
	   next;
	}

	if ($mbx ne '') {
	   push(@mbxs,$mbx);
	}
   }

   return 1;
}

sub getMsgList {

my $mailbox = shift;
my $conn    = shift;

   #  Select the mailbox in read-only mode

   sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
   undef @response;
   $empty=0;
   while ( 1 ) {
    	$response = readResponse ($conn);

        last if $response =~ /^1 OK/i;
    	
    	if ( $response !~ /^\*/ ) {
	   print STDOUT "Error: $response\n";
	   return 0;
    	}
   }

   sendCommand ($conn, "1 FETCH 1:* (UID FLAGS)");
   undef @response;
   while ( 1 ) {
	$response = readResponse ($conn);
    	last if $response =~ /^1 OK/i;
        if ( $response !~ /^\*/ ) {
           print STDOUT "Unexpected response: $response\n";
	   return 0;
    	}
   }

   #  Get a list of the msgs in the mailbox
   #
   undef @msgs;
   for $i (0 .. $#response) {
	$_ = $response[$i];
        $_ =~ /\* ([^FETCH]*)/;
	$uid = $1;
	$uid =~ s/\s+$//;
   	if ($response[$i] =~ /\\Seen/) { $seen = 1; }
	if (($uid ne 'OK') && ($uid ne '')) {
		push (@msgs,"$uid $seen");
	}
   }
   return 1;
}
