#!/usr/bin/perl

#  $Header: /mhub4/sources/imap-tools/imapCapability.pl,v 1.5 2012/03/11 12:40:14 rick Exp $

###########################################################################
#  Program name  imapCapability.pl                                        #
#  Written by    Rick Sanders                                             #
#  Date          23 December 2007                                         #
#                                                                         #
#  Description                                                            #
#                                                                         #
#  imapCapability.pl is a simple program for querying an IMAP             #
#  server for a list of the IMAP features it supports.                    #
#                                                                         #
#  Description                                                            #
#                                                                         #
#  imapCapability is used to discover what services an IMAP               #
#  server supports.                                                       #
#                                                                         #
#  Usage: imapCapability.pl -h <host> -u <user> -p <password>             #
#  Optional arguments: -d (debug) -m (list folders)                       #             
#                                                                         #
#  Sample output:                                                         #
#  The server supports the following IMAP capabilities:                   #
#                                                                         #
#  IMAP4 IMAP4REV1 ACL NAMESPACE UIDPLUS IDLE LITERAL+ QUOTA              #
#  ID MULTIAPPEND LISTEXT CHILDREN BINARY LOGIN-REFERRALS                 #
#  UNSELECT STARTTLS AUTH=LOGIN AUTH=PLAIN AUTH=CRAM-MD5                  # 
#  AUTH=DIGEST-MD5 AUTH=GSSAPI AUTH=MSN AUTH=NTLM                         #
###########################################################################

############################################################################
# Copyright (c) 2012 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 Socket;
use FileHandle;
use Fcntl;
use Getopt::Std;
use IO::Socket;
use IMAP::Utils;
eval 'use Unicode::IMAPUtf7';

#################################################################
#            Main program.                                      #
#################################################################
  
   ($host,$user,$pwd) = getArgs();
   
   unless ( $host and $user and $pwd ) {
      print "Host:Port   > ";
      chomp($host = <>);
      print "Username    > ";
      chomp($user = <>);
      print "Password    > ";
      chomp($pwd = <>);
   }

   unless ( $host and $user and $pwd ) {
      print "Please supply host, username, and password\n";
      exit;
   }

   init();

   connectToHost($host, \$conn)    or exit;
   login($user,$pwd, $conn) or exit;
   capability( $conn );

   if ( $list_mbxs ) {
      print STDOUT "\nList of mailboxes for $user:\n\n";
      @mbxs = listMailboxes('*', $conn );

      foreach $mbx ( @mbxs ) {
         $mbx1 = Unicode::IMAPUtf7::imap_utf7_decode( $mbx );
         if ( $mbx eq $mbx1 ) {
            print STDOUT "   $mbx\n";
         } elsif( $utf7_installed ) {
            print STDOUT "   $mbx  ($mbx1)\n";
         } else {
            print STDOUT "   $mbx\n";
         }
      }   
   }
   logout( $conn );

sub init {

   IMAP::Utils::init();
}

sub getArgs {

   getopts( "h:u:p:dm" );
   $host = $opt_h;
   $user = $opt_u;
   $pwd  = $opt_p;
   $debug = $opt_d;
   $list_mbxs = 1 if $opt_m;

   if ( $opt_H ) {
      usage();
   }

   if ( !$host or !$user or !$pwd ) {
      usage();
   }

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

}

sub usage {

   print STDOUT "usage: iu-capabilities -h <host> -u <user> -p <password>\n";
   print STDOUT "     Option argument:  -m  (list mailboxes)\n";
   exit;

}

sub capability {

my $conn = shift;
my @response;
my $capability;

   sendCommand ($conn, "1 CAPABILITY");
   while (1) {
        $response = readResponse ( $conn );
        $capability = $response if $response =~ /\* CAPABILITY/i;
        last if $response =~ /^1 OK/i;
        if ($response =~ /^1 NO|^1 BAD/i) {
           print "Unexpected response: $response\n";
           return 0;
        }
   }

   print STDOUT "\nThe server supports the following IMAP capabilities:\n\n";
   $capability =~ s/^\* CAPABILITY //;
   print "$capability\n";

}
