#!/usr/bin/perl

# $Header: /mhub4/sources/imap-tools/list_imap_folders.pl,v 1.1 2012/03/15 15:12:36 rick Exp $

#######################################################################
#   list_imap_folders.pl is called like this:                         #
#      ./list_folders.pl -S host/user/password [-O <output file>]     # 
#                                                                     #
#  If you have mailboxes with non-ASCII characters then to render     #
#  them from the IMAP UTF-7 encoding you must install the Perl Module #
#  Unicode::IMAPUtf7.  It's available from the CPAN web site.         #
#######################################################################

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

#################################################################
#################################################################

   init();

   connectToHost($sourceHost, \$src)   or exit;
   login($sourceUser,$sourcePwd, $src, $srcMethod) or exit;
   namespace( $src, \$srcPrefix, \$srcDelim, $opt_x );
   @mbxs = getMailboxList( $srcPrefix, $src );

   @mbxs = sort @mbxs;

   if ( $output_file ) {
      open(OUT, ">$output_file") or die "Can't open output file $output_file: $!";
   }
   foreach $mbx ( @mbxs ) {
         $mbx =~ s/^$srcPrefix//;
         $mbx =~ s/[$srcDelim]/\//g;
         if ( $utf ) {
            $mbx = Unicode::IMAPUtf7::imap_utf7_decode( $mbx );
         }
         if ( $output_file ) {
            print OUT "$mbx\n";
         } else {
            print STDOUT "$mbx\n";
         }
   }
   close OUT;
   print STDOUT "Wrote list of mailboxes to $output_file\n" if $output_file;

   logout( $src );

   exit;


sub init {

   $os = $ENV{'OS'};

   processArgs();

   if ($timeout eq '') { $timeout = 60; }

   IMAP::Utils::init();
   #  Open the logFile
   #
   if ( $logfile ) {
      openLog($logfile);
   }

   $utf = 1;
   eval 'use Unicode::IMAPUtf7';
   if ( $@ ) {
      $utf = 0;
   }

   #  Set up signal handling
   $SIG{'ALRM'} = 'signalHandler';
   $SIG{'HUP'}  = 'signalHandler';
   $SIG{'INT'}  = 'signalHandler';
   $SIG{'TERM'} = 'signalHandler';
   $SIG{'URG'}  = 'signalHandler';

}

sub processArgs {

   if ( !getopts( "dS:L:O:uhH" ) ) {
      usage();
   }
   if ( $opt_S =~ /\\/ ) {
      ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\\/, $opt_S);
   } else {
      ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\//, $opt_S);
   }
   $showIMAP = 1 if $opt_I;
   $utf = 1 if $opt_u;
   $timeout = 45 unless $timeout;
   $output_file = $opt_O;

   if ( $opt_h or $opt_H ) {
      usage();
   }
   unless( $sourceUser and $sourcePwd and $sourceHost ) {
      usage();
   }

}

sub mailboxName {

my $srcmbx    = shift;
my $srcPrefix = shift;
my $srcDelim  = shift;
my $dstPrefix = shift;
my $dstDelim  = shift;
my $dstmbx;
my $substChar = '_';

   if ( $public_mbxs ) {
      my ($public_src,$public_dst) = split(/:/, $public_mbxs );
      #  If the mailbox starts with the public mailbox prefix then
      #  map it to the public mailbox destination prefix

      if ( $srcmbx =~ /^$public_src/ ) {
         Log("src: $srcmbx is a public mailbox") if $debug;
         $dstmbx = $srcmbx;
         $dstmbx =~ s/$public_src/$public_dst/;
         Log("dst: $dstmbx") if $debug;
         return $dstmbx;
      }
   }

   #  Change the mailbox name if the user has supplied mapping rules.

   if ( $mbx_map{"$srcmbx"} ) {
      $srcmbx = $mbx_map{"$srcmbx"} 
   }

   #  Adjust the mailbox name if the source and destination server
   #  have different mailbox prefixes or hierarchy delimiters.

   if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) {
      #  The mailbox name has a character that is used on the destination
      #  as a mailbox hierarchy delimiter.  We have to replace it.
      $srcmbx =~ s^[$dstDelim]^$substChar^g;
   }

   if ( $debug ) {
      Log("src mbx      $srcmbx");
      Log("src prefix   $srcPrefix");
      Log("src delim    $srcDelim");
      Log("dst prefix   $dstPrefix");
      Log("dst delim    $dstDelim");
   }

   $srcmbx =~ s/^$srcPrefix//;
   $srcmbx =~ s/\\$srcDelim/\//g;
 
   if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) {
      #  No adjustments necessary
      # $dstmbx = $srcmbx;
      if ( lc( $srcmbx ) eq 'inbox' ) {
         $dstmbx = $srcmbx;
      } else {
         $dstmbx = $srcPrefix . $srcmbx;
      }
      if ( $root_mbx ) {
         #  Put folders under a 'root' folder on the dst
         $dstmbx =~ s/^$dstPrefix//;
         $dstDelim =~ s/\./\\./g;
         $dstmbx =~ s/^$dstDelim//;
         $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx;
         if ( uc($srcmbx) eq 'INBOX' ) {
            #  Special case for the INBOX
            $dstmbx =~ s/INBOX$//i;
            $dstmbx =~ s/$dstDelim$//;
         }
         $dstmbx =~ s/\\//g;
      }
      return $dstmbx;
   }

   $srcmbx =~ s#^$srcPrefix##;
   $dstmbx = $srcmbx;

   if ( $srcDelim ne $dstDelim ) {
       #  Need to substitute the dst's hierarchy delimiter for the src's one
       $srcDelim = '\\' . $srcDelim if $srcDelim eq '.';
       $dstDelim = "\\" . $dstDelim if $dstDelim eq '.';
       $dstmbx =~ s#$srcDelim#$dstDelim#g;
       $dstmbx =~ s/\\//g;
   }
   if ( $srcPrefix ne $dstPrefix ) {
       #  Replace the source prefix with the dest prefix
       $dstmbx =~ s#^$srcPrefix## if $srcPrefix;
       if ( $dstPrefix ) {
          $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX';
       }
       $dstDelim = "\\$dstDelim" if $dstDelim eq '.';
       $dstmbx =~ s#^$dstDelim##;
   } 
      
   if ( $root_mbx ) {
      #  Put folders under a 'root' folder on the dst
      $dstDelim =~ s/\./\\./g;
      $dstmbx =~ s/^$dstPrefix//;
      $dstmbx =~ s/^$dstDelim//;
      $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx;
      if ( uc($srcmbx) eq 'INBOX' ) {
         #  Special case for the INBOX
         $dstmbx =~ s/INBOX$//i;
         $dstmbx =~ s/$dstDelim$//;
      }
      $dstmbx =~ s/\\//g;
   }

   return $dstmbx;
}

#  Reconnect to the servers after a timeout error.
#
sub reconnect {

my $checkpoint = shift;
my $conn = shift;

   Log("Attempting to reconnect");

   my ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint);

   close $src;
   close $dst;

   connectToHost($shost,\$src);
   login($suser,$spwd,$src);

   connectToHost($dhost,\$dst);
   login($duser,$dpwd,$dst);

   selectMbx( $mbx, $src );
   createMbx( $mbx, $dst );   # Just in case

}

#  Handle signals

sub signalHandler {

my $sig = shift;

   if ( $sig eq 'ALRM' ) {
      Log("Caught a SIG$sig signal, timeout error");
      $conn_timed_out = 1;
   } else {
      Log("Caught a SIG$sig signal, shutting down");
      exit;
   }
   Log("Resuming");
}

sub usage {

   print STDOUT "Usage: iu-listimapfolders -S <host>/<user>/<password> [-O <output file>]\n";
   exit;

}
