#!/usr/bin/perl

# $Header: /mhub4/sources/imap-tools/imapcopy.pl,v 1.47 2012/03/29 15:11:05 rick Exp $

#######################################################################
#   Program name    imapcopy.pl                                       #
#   Written by      Rick Sanders                                      #
#                                                                     #
#   Description                                                       #
#                                                                     #
#   imapcopy is a utility for copying a user's messages from one      #
#   IMAP server to another.                                           #
#                                                                     #
#   imapcopy is called like this:                                     #
#      ./imapcopy -S host1/user1/password1 -D host2/user2/password2   # 
#                                                                     #
#   Optional arguments:                                               #
#	-d debug                                                      #
#       -I show IMAP protocol exchanges                               #
#       -L logfile                                                    #
#       -m mailbox list (copy only certain mailboxes,see usage notes) #
#       -r reset the \DELETE flag on copied messages                  #
#       -p <root mailbox> put copied mailboxes under a root mbx       #
#       -M <file> mailbox mapping (eg, src:inbox -> dst:inbox_copied) #
#       -i initialize mailbox (remove existing msgs first)            #
#       -U run in "update" mode
#       -f forcibly copy messages with no IDs
#   Run imapcopy.pl -h to see complete set of arguments.              #
#######################################################################

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

#################################################################
#            Main program.                                      #
#################################################################

   init();

   #  Get list of all messages on the source host
   #
   connectToHost($sourceHost, \$src)   or exit;
   login($sourceUser,$sourcePwd, $src, $srcMethod) or exit;
   namespace( $src, \$srcPrefix, \$srcDelim, $opt_x );

   connectToHost( $destHost, \$dst ) or exit;
   login( $destUser,$destPwd, $dst, $dstMethod ) or exit;
   namespace( $dst, \$dstPrefix, \$dstDelim, $opt_y );

   @mbxs = getMailboxList( $srcPrefix, $src, $mbxList, $submbxs);

   #  Exclude certain mbxs if that's what the user wants
   exclude_mbxs( \@mbxs ) if $excludeMbxs;

   map_mbx_names( \%mbx_map, $srcDelim, $dstDelim );

   if ( $archive_mbx ) {
      #  Create an archive mbx on the source to receive copies of messsages
      createMbx( $archive_mbx, $src ) unless mbxExists( $archive_mbx, $src);
   }

   $total=$mbxs_processed = 0;
   my $delete_msg_list;
   $num_mbxs = $#mbxs + 1;
   Log("Number of mailboxes to process: $num_mbxs");
   foreach $srcmbx ( @mbxs ) {
        ###  encode( \$srcmbx );
        next if $srcmbx eq $archive_mbx;
        $archived=0;
        $mbxs_processed++;
        if ( $verbose ) {
           $line = "Processing $srcmbx " . '(' . $mbxs_processed . '/' . $num_mbxs . ')';
           Log("$line");
        }
        $dstmbx = mailboxName( $srcmbx,$srcPrefix,$srcDelim,$dstPrefix,$dstDelim );
        $dstmbx =~ s/\s+$//g;

        #  Special for issue with Exchange IMAP which doesn't like
        #  trailing spaces in mailbox names.
        $dstmbx =~ s/\s+\//\//g;

        $LAST = "$dstmbx";
        createMbx( $dstmbx, $dst ) unless mbxExists( $dstmbx, $dst);

        if ( $include_nosel_mbxs ) {
           #  If a mailbox was 'Noselect' on the src but the user wants
           #  it created as a regular folder on the dst then do so.  They
           #  don't hold any messages so after creating them we don't need
           #  to do anything else.
           next if $nosel_mbxs{"$srcmbx"};
        }

        selectMbx( $dstmbx, $dst );

        if ( $update ) {
           Log("Get msgids on the destination") if $debug;
           getMsgIdList( $dstmbx, \%DST_MSGS, $dst );
        }

        init_mbx( $dstmbx, $dst ) if $init_mbx;

        $checkpoint  = "$srcmbx|$sourceHost|$sourceUser|$sourcePwd|";
        $checkpoint .= "$destHost|$destUser|$destPwd";

        if ( $sent_after and $sent_before ) {
           getDatedMsgList( $srcmbx, 'SINCE',  $sent_after,  \@msgs_since, $src );
           getDatedMsgList( $srcmbx, 'BEFORE', $sent_before, \@msgs_before, $src );
           date_in_range( \@msgs_since, \@msgs_before, \@msgs);
        } elsif ( $sent_after  ) {
           getDatedMsgList( $srcmbx, 'SINCE',  $sent_after,  \@msgs, $src );
        } elsif ( $sent_before  ) {
           getDatedMsgList( $srcmbx, 'BEFORE', $sent_before, \@msgs, $src );
        } else {
           getMsgList( $srcmbx, \@msgs, $src, 'EXAMINE', $force );
        }

        my $msgcount = $#msgs + 1;
        if ( $sent_after and $sent_before ) {
           Log("There are $msgcount messages between those dates");
        }
        Log("   Copying $msgcount messages in $srcmbx mailbox") if $verbose;
        if ( $msgcount == 0 ) {
           Log("   $srcmbx mailbox is empty");
           next;
        }

        $copied=0;
        foreach $_ ( @msgs ) {
           alarm $timeout;
           ($msgnum,$date,$flags,$msgid) = split(/\|/, $_);

           Log("msgnum=$msgnum,msgid=$msgid") if $debug;

           if ( $update ) {
              #  Don't insert the message if it already exists
              next if $DST_MSGS{"$msgid"};
              Log("$msgid does not exist on the destination") if $debug;
           }

           #  Strip off TZ offset if it exists
           $date =~ s/\((.+)\)$//;
           $date =~ s/\s+$//g;

           $LAST = "$dstmbx|$msgnum";
           next unless fetchMsg( $msgnum, $src, \$message);

           # $message =~ /Message-Id: (.+)/i;
           # Log("message has msgid = $1");
           alarm 0;

           if ( $conn_timed_out ) {
              Log("$sourceHost timed out");
              reconnect( $checkpoint, $src );
              $conn_timed_out = 0;
              next;
           }
           next unless $message;

           alarm $timeout;

           $copied++ if insertMsg( $dst, $dstmbx, *message, $flags, $date );

           if ( $archive_mbx ) {
              #  Put a copy of the message in it too
              if ( insertMsg( $src, $archive_mbx, *message, $flags, $date ) ) {
                 $archived++;
                 if ( $rem_src_msgs ) {
                    $delete_msg_list .= "$msgnum ";
                 }
              }
           }

           if ( $copied/100 == int($copied/100)) {
              Log("   Copied $copied messages so far") if $verbose;
           }

           alarm 0;

           if ( $conn_timed_out ) {
              Log("$destHost timed out");
              reconnect( $checkpoint, $dst );
              $conn_timed_out = 0;
              next;
           }

        }
        $total += $copied;
        if ( $use_utf7 ) {
           $dstmbx = Unicode::IMAPUtf7::imap_utf7_decode( $dstmbx );
        }
        if ( $verbose ) {
           $line = "   Copied $copied messages to $dstmbx ";
           $line .=  '(' . $mbxs_processed . '/' . $num_mbxs . ')';
           Log( "$line ");
        } else {
           Log("   Copied $copied messages to $dstmbx");
        }

        if ( $archive_mbx ) {
           Log("   Copied $archived messages to $archive_mbx mailbox");
           if ( $rem_src_msgs ) {
              #  Remove the messages from the source mailbox
              Log("Removing messages from $srcmbx on source");
              delete_msg_list( $delete_msg_list, $srcmbx, $src );
              expungeMbx( $srcmbx, $src );
           }
        }
   }

   Log("Copied $total total messages");
   logout( $src );
   logout( $dst );

   exit;


sub init {

   $os = $ENV{'OS'};

   processArgs();

   IMAP::Utils::init();
   #  Open the logFile
   #
   if ( $logfile ) {
      &openLog($logfile);
   }
   Log("$0 starting");

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

}

#  getDatedMsgList
#
#  Get a list of the user's messages in a mailbox on
#  the host which were sent after the specified date
#

sub getDatedMsgList {

my $mailbox = shift;
my $operator = shift;
my $cutoff_date = shift;
my $msgs    = shift;
my $conn    = shift;
my ($seen, $empty, @list,$msgid);

    #  Get a list of messages sent after the specified date

    Log("Searching for messages $operator $cutoff_date");

    @list  = ();
    @$msgs = ();

    sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
    while ( 1 ) {
        $response = readResponse ($conn);
        if ( $response =~ / EXISTS/i) {
            $response =~ /\* ([^EXISTS]*)/;
            # Log("     There are $1 messages in $mailbox");
        } elsif ( $response =~ /^1 OK/i ) {
            last;
        } elsif ( $response =~ /^1 NO/i ) {
            Log ("unexpected response: $response");
            return 0;
        } elsif ( $response !~ /^\*/ ) {
            Log ("unexpected response: $response");
            return 0;
        }
    }

    my ($date,$ts) = split(/\s+/, $cutoff_date);

    #
    #  Get list of messages sent before/after the reference date
    #
    Log("Get messages sent $operator $date") if $debug;
    $nums = "";
    sendCommand ($conn, "1 SEARCH $operator \"$date\"");
    while ( 1 ) {
	$response = readResponse ($conn);
	if ( $response =~ /^1 OK/i ) {
	    last;
	}
	elsif ( $response =~ /^\*\s+SEARCH/i ) {
	    ($nums) = ($response =~ /^\*\s+SEARCH\s+(.*)/i);
	}
	elsif ( $response !~ /^\*/ ) {
	    Log ("unexpected SEARCH response: $response");
	    return;
	}
    }
    Log("$nums") if $debug;
    if ( $nums eq "" ) {
	Log ("     $mailbox has no messages sent before $date") if $debug;
	return;
    }
    my @number = split(/\s+/, $nums);
    $n = $#number + 1;

    $nums =~ s/\s+/ /g;
    @msgList = ();
    @msgList = split(/ /, $nums);

    if ($#msgList == -1) {
	#  No msgs in this mailbox
	return 1;
    }

@$msgs  = ();
for $num (@msgList) {

     sendCommand ( $conn, "1 FETCH $num (uid flags internaldate body[header.fields (Message-Id Date)])");
     
     undef @response;
     while ( 1 ) {
	$response = readResponse   ( $conn );
	if   ( $response =~ /^1 OK/i ) {
		last;
	}   
        last if $response =~ /^1 NO|^1 BAD|^\* BYE/;
     }

     $flags = '';
     my $msgid;
     foreach $_ ( @response ) {
	last   if /^1 OK FETCH complete/i;
          if ( /FLAGS/ ) {
             #  Get the list of flags
             /FLAGS \(([^\)]*)/;
             $flags = $1;
             $flags =~ s/\\Recent//;
          }
   
          if ( /Message-Id:\s*(.+)/i ) {
             $msgid = $1;
          }

          if ( /INTERNALDATE/) {
             /INTERNALDATE (.+) BODY/i;
             $date = $1;
             $date =~ /"(.+)"/;
             $date = $1;
             $date =~ s/"//g;
             ####  next if check_cutoff_date( $date, $cutoff_date );
          }

          if ( /\* (.+) FETCH/ ) {
             ($msgnum) = split(/\s+/, $1);
          }

          if ( $msgnum and $date and $msgid ) {
             push (@$msgs,"$msgnum|$date|$flags|$msgid");
             $msgnum=$msgid=$date=$flags='';
          }
      }
   }

   foreach $_ ( @$msgs ) {
      Log("getDated found $_") if $debug;
   }

   return 1;
}

sub date_in_range {

my $list1 = shift;
my $list2 = shift;
my $newlist = shift;
my %MSGNUMS;

   #  Return a list of msgnums common to both lists passed
   #  to us.

   @$newlist = ();

   foreach $_ ( @$list1 ) {
      my ($msgnum) = split(/\|/, $_);
      $MSGNUMS{$msgnum} = $_;
   }

   foreach $_ ( @$list2 ) {
      my ($msgnum) = split(/\|/, $_);
      push( @$newlist, $_ ) if $MSGNUMS{$msgnum};
   }
      
}

sub usage {

   print STDOUT "usage:\n";
   print STDOUT " iu-copy  -S sourceHost/sourceUser/sourcePassword [/CRAM-MD5]\n";
   print STDOUT "          -D destHost/destUser/destPassword [/CRAM-MD5]\n";
   print STDOUT "          -d debug\n";
   print STDOUT "          -I show IMAP protocol exchanges\n";
   print STDOUT "          -L logfile\n";
   print STDOUT "          -m mailbox list (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n";
   print STDOUT "          -R include submailboxes when used with -m\n\n";
   print STDOUT "          -e exclude mailbox list\n";
   print STDOUT "          -r remove msgs from source mbx after copying\n";
   print STDOUT "          -p <mailbox> put copied mailboxes under a root mailbox\n";
   print STDOUT "          -A <mailbox> copy to local mailbox from scrmbx\n";
   print STDOUT "          -x <mbx delimiter [mbx prefix]>  source (eg, -x '. INBOX.'\n";
   print STDOUT "          -y <mbx delimiter [mbx prefix]>  destination\n";
   print STDOUT "          -i initialize mailbox (remove existing messages first\n";
   print STDOUT "          -M <file> mailbox map file. Maps src mbxs to dst mbxs. ";
   print STDOUT "Each line in the file should be 'src mbx:dst mbx'\n";
   print STDOUT "          -q quiet mode (still writes to the logfile)\n";
   print STDOUT "          -t <timeout in seconds>\n";
   print STDOUT "          -T copy custom flags (eg, \$Label1,\$MDNSent,etc)\n";
   print STDOUT "          -a <DD-MMM-YYYY> copy only messages after this date\n";
   print STDOUT "          -b <DD-MMM-YYYY> copy only messages before this date\n";
   print STDOUT "          -X <megabytes> Skip any message exceeding this size\n";
   print STDOUT "          -U update mode, don't copy messages that already exist\n";
   print STDOUT "          -B <msgnum>  Starting point for message fetch\n";
   print STDOUT "          -E <msgnum>  Ending point for message fetch\n";
   print STDOUT "          -f forcibly copy messages with no IDs\n";
   exit;

}

sub processArgs {

   if ( !getopts( "dS:D:L:m:hIp:M:rqx:y:e:Rt:Tia:b:X:vP:A:UB:E:f" ) ) {
      usage();
      exit 0;
   }
   if (! $opt_S or ! $opt_D) {
      usage();
      exit 0;
   }
   if ( $opt_S =~ /\\/ ) {
      ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\\/, $opt_S);
   } else {
      ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\//, $opt_S);
   }
   if ( $opt_D =~ /\\/ ) {
      ($destHost, $destUser, $destPwd,$dstMethod)     = split(/\\/, $opt_D);
   } else {
      ($destHost, $destUser, $destPwd,$dstMethod)     = split(/\//, $opt_D);
   }

   $mbxList  = $opt_m;
   $logfile  = $opt_L;
   $root_mbx = $opt_p;
   $timeout  = $opt_t;
   $tags     = $opt_T;
   $debug    = 1 if $opt_d;
   $verbose  = 1 if $opt_v;
   $showIMAP = 1 if $opt_I;
   $submbxs  = 1 if $opt_R;
   $init_mbx = 1 if $opt_i;
   $quiet_mode  = 1 if $opt_q;
   $update   = 1 if $opt_U;
   $include_nosel_mbxs = 1 if $opt_s;
   $rem_src_msgs = 1 if $opt_r;
   $mbx_map_fn  = $opt_M;
   $excludeMbxs = $opt_e;
   $sent_after  = $opt_a;
   $sent_before = $opt_b;
   $max_size    = $opt_X;
   $public_mbxs = $opt_P;
   $archive_mbx = $opt_A;
   $start_fetch = $opt_B;
   $end_fetch   = $opt_E;
   $force   = $opt_f;
   $timeout = 300 unless $timeout;

   Log("Running in update mode") if $update;

   validate_date( $sent_after )  if $sent_after;
   validate_date( $sent_before ) if $sent_before;
   usage() if $opt_h;

}

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;
}

sub flags {

my $flags = shift;
my @newflags;
my $newflags;

   #  Make sure the flags list contains standard 
   #  IMAP flags and optionally custom tags

   return unless $flags;

   $flags =~ s/\\Recent//i;
   foreach $_ ( split(/\s+/, $flags) ) {
      push( @newflags, $_ ) if substr($_,0,1) eq '\\';
      if ( $opt_T ) {
         #  Include user-defined flags
         push( @newflags, $_ ) if substr($_,0,1) eq '$';
      }
   }

   $newflags = join( ' ', @newflags );

   $newflags =~ s/\\Deleted//ig if $opt_r;
   $newflags =~ s/^\s+|\s+$//g;

   return $newflags;
}

sub map_mbx_names {

my $mbx_map = shift;
my $srcDelim = shift;
my $dstDelim = shift;

   #  The -M <file> argument causes imapcopy to read the
   #  contents of a file with mappings between source and
   #  destination mailbox names. This permits the user to
   #  to change the name of a mailbox when copying messages.
   #
   #  The lines in the file should be formatted as:
   #       <source mailbox name>: <destination mailbox name>
   #  For example:
   #       Drafts/2008/Save:  Draft_Messages/2008/Save
   #       Action Items: Inbox
   #
   #  Note that if the names contain non-ASCII characters such
   #  as accents or diacritical marks then the Perl module
   #  Unicode::IMAPUtf7 module must be installed.

   return unless $mbx_map_fn;

   unless ( open(MAP, "<$mbx_map_fn") ) {
      Log("Error opening mbx map file $mbx_map_fn: $!");
      exit;
   }
   $use_utf7 = 0;
   while( <MAP> ) {
      chomp;
      s/[\r\n]$//;   # In case we're on Windows
      s/^\s+//;
      next if /^#/;
      next unless $_;
      ($srcmbx,$dstmbx) = split(/\s*:\s*/, $_);

      #  Unless the mailbox name is entirely ASCII we'll have to use
      #  the Modified UTF-7 character set.
      $use_utf7 = 1 unless isAscii( $srcmbx );
      $use_utf7 = 1 unless isAscii( $dstmbx );

      $srcmbx =~ s/\//$srcDelim/g;
      $dstmbx =~ s/\//$dstDelim/g;

      $$mbx_map{"$srcmbx"} = $dstmbx;

   }
   close MAP;

   if ( $use_utf7 ) {
      eval 'use Unicode::IMAPUtf7';
      if ( $@ ) {
         Log("At least one mailbox map contains non-ASCII characters.  This means you");
         Log("have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox ");
         Log("names between the source and destination servers.");
         print "At least one mailbox map contains non-ASCII characters.  This means you\n";
         print "have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox\n";
         print "names between the source and destination servers.\n";
         exit;
      }
   }

   my %temp;
   foreach $srcmbx ( keys %$mbx_map ) {
      $dstmbx = $$mbx_map{"$srcmbx"};
      Log("Mapping src:$srcmbx to dst:$dstmbx");
      if ( $use_utf7 ){
         #  Encode the name in Modified UTF-7 charset
         $srcmbx = Unicode::IMAPUtf7::imap_utf7_encode( $srcmbx );
         $dstmbx = Unicode::IMAPUtf7::imap_utf7_encode( $dstmbx );
      }
      $temp{"$srcmbx"} = $dstmbx;
   }
   %$mbx_map = %temp;
   %temp = ();

}

#  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

}

sub init_mbx {

my $mbx  = shift;
my $conn = shift;
my @msgs;

   #  Remove all messages from a mailbox

   Log("Initializing mailbox $mbx");
   getMsgList( $mbx, \@msgs, $conn, 'SELECT', $force);
   my $msgcount = $#msgs + 1;
   Log("$mbx has $msgcount messages");

   return if $msgcount == 0;   #  No messages to delete

   foreach my $msgnum ( @msgs ) {
      ($msgnum) = split(/\|/, $msgnum);
      deleteMsg( $msgnum, $conn );
   }
   expungeMbx( $mbx, $conn );

}

sub delete_msg_list {

my $msgnums = shift;
my $mbx     = shift;
my $conn    = shift;
my $rc;

   #  Mark a set of messages for deletion

   selectMbx( $mbx, $conn );

   foreach my $msgnum ( split(/\s+/, $msgnums ) ) {
      sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)");
      while (1) {
         $response = readResponse ($conn);
         if ( $response =~ /^1 OK/i ) {
  	    $rc = 1;
	    Log("      Marked msg number $msgnum for delete") if $debug;
	    last;
	 }

	 if ( $response =~ /^1 BAD|^1 NO/i ) {
	    Log("Error setting \Deleted flag for msg $msgnum: $response");
	    $rc = 0;
	    last;
	 }
      }
   }

   return $rc;

}

sub commafy {

my $number = shift;

   $_ = $$number;
   1 while s/^([-+]?\d+)(\d{3})/$1,$2/;

   $$number = $_;

}

sub resume {
   my $LAST = shift;

   my $src = shift;
   my $dst = shift;

   my $sourceHost = shift;
   my $sourceUser = shift;
   my $sourcePwd = shift;
   my $srcMethod = shift;

   my $destHost = shift;
   my $destUser = shift;
   my $destPwd = shift;
   my $dstMethod = shift;

   #  Disconnect, re-connect, and log back in.

   Log("Fatal error, lost connection to either the source or destination");
   # Log("checkpoint $checkpoint");
   Log("LAST $LAST");
   my ($mbx,$msgnum) = split(/\|/, $LAST);
   Log("mbx $mbx");
   Log("Disconnect from the source and destination servers");

   close $src;
   close $dst;
 
   Log("Sleeping 15 seconds before reconnecting");
   sleep 15;

   Log("Reconnect to source server and log back in");
   connectToHost($sourceHost, \$src)   or exit;
   login($sourceUser,$sourcePwd, $src, $srcMethod) or exit;
   selectMbx( $mbx, $src );

   Log("Reconnect to destination server and log back in");
   connectToHost( $destHost, \$dst ) or exit;
   login( $destUser,$destPwd, $dst, $dstMethod ) or exit;
   Log("Resuming");

   #  Just in case we were creating a mailbox when the connection
   #  was lost check and recreate it if necessary

   Log("does $mbx exist?");
   createMbx( $mbx, $dst ) unless mbxExists( $mbx, $dst );

   return;

}

sub encode_ampersand {

my $mbx = shift;

   #  The IMAP RFC requires mailbox names with '&' be 
   #  encoded as '&-'

   #  The problem with this routine is a mailbox name may be
   #  encoded in Mod UTF7 which uses the '&' character for its
   #  own purposes, eg r&AOk-pertoire_XXX.  We have to leave it
   #  alone.  Anyway, this code was inserted because of an IMAP
   #  server which did not do its job so the usefulness of this
   #  conversion is limited.  

   if ( $$mbx =~ /\&/ ) {
      if ( $$mbx !~ /\&-/ ) {
         #  Need to encode the '&' as '&-'
         $$mbx =~ s/\&/\&-/g;
         Log("Encoded $$mbx");
      }
   }

}
