maildir_to_imap.pl

#!/usr/bin/perl

# $Header: /mhub4/sources/imap-tools/maildir_to_imap.pl,v 1.11 2015/12/04 22:56:43 rick Exp $

##########################################################################
#   Program name    maildir_to_imap.pl                                   #
#   Written by      Rick Sanders                                         #
#                                                                        #
#   Description                                                          #
#                                                                        #
#   maildir_to_imap is used to copy the messages in a maildir to a       #
#   user's IMAP mailbox.  maildir_to_imap is executed like this:         #
#                                                                        #
#   ./maildir_to_imap.pl -i <user list> -D <imapserver[:port]>           #
#                                                                        #
#   The user list is a file with one or more entries containing the      #
#   location of the user's maildir and his IMAP username and password.   #
#                                                                        #
#   For example:                                                         #
#         /mhub4/maildirs/rwilson@abc.net,rich.wilson,welcome            #
#         /mhub4/maildirs/jane.eyre@abc.net,jane.eyre,mypass             #
#                                                                        #
#   See usage() for a list of arguments                                  #
##########################################################################

init();
get_user_list( \@users );
migrate_user_list( \@users );

exit;


sub migrate_user_list {

my $users = shift;

  #  Migrate a set of users

  foreach $userinfo ( @$users ) {
     $userinfo =~ s/oauth2:/oauth2---/g;
Log("userinfo $userinfo");
     $usercount++;
     ($user) = split(/\s*,\s*/, $userinfo);
     Log("migrate $user");

     #  Start the migration.  Unless maxChildren has been set to 1
     #  fork off child processes to do the migration in parallel.
 
     if ($maxChildren == 1) {
	migrate ($userinfo, $imaphost);
     } else {
  	Log("There are $children running") if $debug;
  	if ( $children < $maxChildren ) {
   	   Log("   Forking to migrate $user") if $debug;
     	   if ( $pid = fork ) {	# Parent
	      Log ("   Parent $$ forked $pid") if $debug;
     	   } elsif (defined $pid) {	# Child
	      Log ("  Child process $$ processing $sourceUser") if $debug;
              migrate($userinfo, $imaphost);
              Log("   $user is done");
              exit 0;
     	   } else {
              Log("Error forking child to migrate $user");
              next;
     	   }
     	   $children++;
     	   $children{$pid} = $user;
  	} 

  	Log ("I'm PID $$") if $debug;
  	while ( $children >= $maxChildren ) {
     	   Log(" $$ - Max children running.  Waiting...") if $debug;
     	   $foundPid = wait;	# Wait for a child to terminate
	   if ($? != 0) {
	      Log ("ERROR: PID $foundPid exited with status $?");
	   }
	   delete $children{$foundPid};
     	   $children--;
  	}
  	Log("OK to launch another user migration") if $debug;
  }

}
}

sub xxxx {

   if ($maxChildren > 1) {
      Log("All children have been launched, waiting for them to finish");
      foreach $pid ( keys(%children) ) {
         $user = $children{$pid};
         Log("Waiting on process $pid ($user) to finish");
         waitpid($pid, 0);
         if ($? != 0) {
            Log ("ERROR: PID $pid exited with status $?");
         }
      }
   }
}


sub    sum {
summarize();
$elapsed = sprintf("%.2f", (time()-$start)/3600);
Log("Elapsed time  $elapsed hours");
Log("Migration completed");
exit;
}

sub migrate {
  
my $userinfo = shift;
my $imaphost = shift;

   my ($user,$pwd,$userpath) = split(/,/, $userinfo);

   return unless connectToHost($imaphost, \$dst);
   return unless login($user,$pwd, $dst);

   get_maildir_folders( $userpath, \%folders );

   my $messages;
   foreach $maildir_folder ( keys %folders ) {
      $maildir_folder =~ s/\&/&-/;   # Encode the '&' char
      $maildir_folder =~ s/\s+$//;
      $folder_path = $folders{"$maildir_folder"};

      if ( $MAP{uc("$maildir_folder")} ) {
         #  The user wants a different name for the IMAP folder
         Log("Messages from the $maildir_folder folder will be written to $MAP{uc(\"$maildir_folder\")} ");
         $maildir_folder = $MAP{uc("$maildir_folder")};
      }
      createMbx( $maildir_folder, $dst ) unless mbxExists( $maildir_folder, $dst );

      get_maildir_msgs( $folder_path, \@msgs );
      my $msgcount = $#msgs + 1;
      Log("     $maildir_folder ($msgcount msgs) $folder_path");
 
      next if !@msgs;

      $inserted=0;
      foreach $msgfn ( @msgs ) {
         $inserted++ if insert_msg( $msgfn, $maildir_folder, $dst );

         if ( $msgs_per_folder ) {
            #  opt_F allows us to limit number of messages copied per folder
            last if $inserted == $msgs_per_folder;
         }
      }
      Log("     Inserted $inserted messages into $maildir_folder\n");
   }

   $conn_timed_out=0;

}

sub init {

use Getopt::Std;
use Fcntl;
use Socket;
use IO::Socket;
use sigtrap;
use FileHandle;
# require "ctime.pl";
use MIME::Base64 qw( encode_base64 decode_base64 );
   
   $start = time();

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

   getopts('H:i:L:n:ht:M:SLdD:Um:IA:F:M:');

   # usage() if $opt_h;
   #  usage();

   $userlist     = $opt_i;
   $logfile      = $opt_L;
   $maxChildren  = $opt_n;
   $usage        = $opt_h;
   $timeout      = $opt_t;
   $imaphost     = $opt_H;
   $imaphost     = $opt_D;
   $mbxList      = $opt_m;
   $debug=1      if $opt_d;
   $showIMAP=1   if $opt_I;
   $admin_user   = $opt_A;
   $mailbox_map  = $opt_M;
   $msgs_per_folder = $opt_F;

   if ( $imaphost =~ /CRAM-MD5/i ) {
      $method = 'CRAM-MD5';
       $imaphost =~ s/\/CRAM-MD5//i;
   }

   $timeout = 45 unless $timeout;
   $maxChildren = 1 unless $maxChildren;
   $hostname = `hostname`;

   foreach $map ( split(/\s*,\s*/, $mailbox_map ) ) {
      ($maildir_folder,$imap_mbx) = split(/:/, $map );
      $MAP{uc("$maildir_folder")} = $imap_mbx;
   }

   $logfile = "maildir_to_imap.log" unless $logfile;
   open (LOG, ">>$logfile");
   select LOG;
   $| = 1;
   Log("$0 starting");

   #  $date = ctime(time);
   #  chomp($date);

   #  Determine whether we have SSL support via openSSL and IO::Socket::SSL
   $ssl_installed = 1;
   eval 'use IO::Socket::SSL';
   if ( $@ ) {
      $ssl_installed = 0;
   }

}

sub usage {

   print "\nUsage:  maildir_to_imap.pl -i <users> -D imapHost\n\n";
   print "Optional arguments:\n\n";
   print " -i <file of usernames>\n";
   print "-A <admin_user:admin_password>\n";
   print " -n <number of simultaneous migration processes to run>\n";
   print " -m <list of mailboxes> eg Inbox,Drafts,Sent\n";
   print " -M <maildir_folder_name:IMAP_mailbox_name,...,maildir_folder_name:IMAP_mailbox_name>\n";
   print " -L <logfile, default is maildir_to_imap.log>\n";
   print " -t <timeout in seconds>\n";
   print " -d debug mode\n";
   print " -I record IMAP protocol exchanges\n\n";
   print "To login with CRAM-MD5 add CRAM-MD5 like this:  -D imaphost/CRAM-MD5\n";
   exit;

}


sub Log {

my $line = shift;

   if ( LOG ) {
      my @f = localtime( time );
      my $timestamp = sprintf( "%02d-%02d-%04d.%02d:%02d:%02d",
			 (1 + $f[ 4 ]), $f[ 3 ], (1900 + $f[ 5 ]),
			 @f[ 2,1,0 ] );
      printf LOG "%s %s: %s\n", $timestamp, $$, $line;
   }
   #  print STDERR "$line\n";
}

#  Make a connection to an IMAP host

sub format_bytes {

my $bytes = shift;

   #  Format the number nicely

   if ( length($bytes) >= 10 ) {
      $bytes = $bytes/1000000000;
      $tag = 'GB';
   } elsif ( length($bytes) >= 7 ) {
      $bytes = $bytes/1000000;
      $tag = 'MB';
   } else {
      $bytes = $bytes/1000;
      $tag = 'KB';
   }

   # commafy
   $_ = $bytes;
   1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
   $bytes = sprintf("%.2f", $_) . " $tag";

   return $bytes;
}


sub commafy {

my $number = shift;

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

   return $number;
}

#  Reconnect to a server after a timeout error.
#
sub reconnect {

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

   Log("This is reconnect, conn is $conn") if $debug;
   logout( $conn );
   close $conn;
   sleep 5;
   ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint);
   if ( $conn eq $src ) {
      $host = $shost;
      $user = $suser;
      $pwd  = $spwd;
   } else { 
      $host = $dhost;
      $user = $duser;
      $pwd  = $dpwd;
   }
   connectToHost($host,$conn);
   login($user,$pwd,$conn);
   selectMbx( $mbx, $conn );
   createMbx( $mbx, $dst );   # Just in case
   Log("leaving reconnect");
}

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

#  Get the total message count and bytes and write
#  it to the log.  

sub summarize {

   #  Each child appends its totals to /tmp/migrateEmail.sum so
   #  we read the lines and add up the grand totals.

   $totalUsers=$totalMsgs=$totalBytes=0;
   open(SUM, "</tmp/migrateIMAP.sum");
   while ( <SUM> ) {
      chomp;
      ($msgs,$bytes) = split(/\|/, $_);
      $totalUsers++;
      $totalMsgs  += $msgs;
      $totalBytes += $bytes;
   }

   $_ = $totalMsgs;
   1 while s/^([-+]?\d+)(\d{3})/$1,$2/;  #  Commafy the message total
   $totalMsgs = $_;
   $totalBytes = formatBytes( $totalBytes );

   Log("Summary of migration");
   Log("Migrated $totalUsers users, $totalMsgs messages, $totalBytes.");

}

sub isAscii {

my $str = shift;
my $ascii = 1;

   #  Determine whether a string contains non-ASCII characters

   my $test = $str;
   $test=~s/\P{IsASCII}/?/g;
   $ascii = 0 unless $test eq $str;

   return $ascii;

}

sub fix_ts {

my $date = shift;

   #  Make sure the hrs part of the date is 2 digits.  At least
   #  one IMAP server expects this.

   $$date =~ s/^\s+//;
   $$date =~ /(.+) (.+):(.+):(.+) (.+)/;
   my $hrs = $2;
   
   return if length( $hrs ) == 2;

   my $newhrs = '0' . $hrs if length( $hrs ) == 1;
   $$date =~ s/ $hrs/ $newhrs/;

}

sub stats {

   print "\n";
   print "Users migrated   $users\n";
   print "Total messages   $total_msgs\n";
   print "Total bytes      $total_bytes\n";

   $elapsed = time() - $start;
   $minutes = $elapsed/60;
   print "Elapsed time     $minutes minutes\n";

}

#
#  Log
#
#  This subroutine formats and writes a log message to STDERR.
#

sub Log {
 
my $str = shift;

   #  If a logfile has been specified then write the output to it
   #  Otherwise write it to STDOUT

   if ( $logfile ) {
      ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
      if ($year < 99) { $yr = 2000; }
      else { $yr = 1900; }
      $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s\n",
		     $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$str);
      print LOG "$line";
   } 
   print STDOUT "$str\n" unless $quiet_mode;

}


sub usage {

   print STDOUT "usage:\n";
   exit;

}

sub processArgs {

   if ( !getopts( "" ) ) {
      usage();
   }
}


sub isAscii {

my $str = shift;
my $ascii = 1;

   #  Determine whether a string contains non-ASCII characters

   my $test = $str;
   $test=~s/\P{IsASCII}/?/g;
   $ascii = 0 unless $test eq $str;

   return $ascii;

}

#  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 insert_msg {

my $msgfn   = shift;
my $folder  = shift;
my $dst     = shift;

   #  Put a message in the user's folder

   my $flag = 'Unseen';
   if ( $msgfn =~ /,/ ) {
      $flag = '\\Seen' if $msgfn =~ /,S$/;
   }

   if ( !open(MESSAGE, "<$msgfn")) {
      Log( "    Can't open message fn $msgfn: $!" );
      return 0;
   }
   my ($date,$message,$msgid);
   while( <MESSAGE> ) {
       chomp;
       # print STDERR "message line $_\n";
       if ( /^Date: (.+)/ and !$date ) {
          $date = $1;
       }
       if ( /^Message-Id: (.+)/i and !$msgid ) {
          $msgid = $1;
          Log("msgid $msgid") if $debug;
       }
       $message .= "$_\r\n";
   }
   close MESSAGE;

# $date = "9-Dec-2013 10:32:44 +0100";
   fix_date( \$date );

   $status = insert_imap_msg( $dst, $folder, \$message, $flag, $date );

   return $status;

}

sub entry_exists {

my $mail  = shift;
my $ldap  = shift;
my $pwd   = shift;
my $dn;
my $i;

   my $attrs = [ 'mailpassword' ];
   my $base = 'o=site';
   my $filter = "mail=$mail";

   my $result = $ldap->search(
            base   => $base,
            filter => $filter,
            scope  => "subtree",
            attrs  => $attrs
   );

   if ( $result->code ) {
      my $error = $result->code;
      my $errtxt = ldap_error_name( $result->code );
      Log("Error searching for $filter: $errtxt");
      exit;
   }

   my @entries = $result->entries;
   my $i = $#entries + 1;

   $entry = $entries[0];
   $$pwd = $entry->get_value( 'mailpassword' );

   return $i;
}

sub get_user_list {

my $users    = shift;

   #  Build a list of the users and their maildirs

   open(F, "<$userlist") or die "Can't open user list $userlist: $!";
   while( <F> ) {
      chomp;
      s/^\s+//;
      next if /^#/;
      next unless $_;
      my( $maildir,$user,$pwd) = split(/,/, $_);
      push( @$users, "$user,$pwd,$maildir" );
   }
   close F;

}

#  Make a connection to an IMAP host

sub connectToHost {

my $host = shift;
my $conn = shift;

   Log("Connecting to $host");
   
   ($host,$port) = split(/:/, $host);
   $port = 143 unless $port;

   # We know whether to use SSL for ports 143 and 993.  For any
   # other ones we'll have to figure it out.
   $mode = sslmode( $host, $port );

   if ( $mode eq 'SSL' ) {
      unless( $ssl_installed == 1 ) {
         warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
         Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
         exit;
      }
      Log("Attempting an SSL connection") if $debug;
      $$conn = IO::Socket::SSL->new(
         Proto           => "tcp",
         SSL_verify_mode => 0x00,
         PeerAddr        => $host,
         PeerPort        => $port,
         Domain          => AF_INET,
      );

      unless ( $$conn ) {
        $error = IO::Socket::SSL::errstr();
        Log("Error connecting to $host: $error");
        warn("Error connecting to $host: $error");
        exit;
      }
   } else {
      #  Non-SSL connection
      Log("Attempting a non-SSL connection") if $debug;
      $$conn = IO::Socket::INET->new(
         Proto           => "tcp",
         PeerAddr        => $host,
         PeerPort        => $port,
      );

      unless ( $$conn ) {
        Log("Error connecting to $host:$port: $@");
        warn "Error connecting to $host:$port: $@";
        exit;
      }
   } 

}

sub sslmode {

my $host = shift;
my $port = shift;
my $mode;

   #  Determine whether to make an SSL connection
   #  to the host.  Return 'SSL' if so.

   if ( $port == 143 ) {
      #  Standard non-SSL port
      return '';
   } elsif ( $port == 993 ) {
      #  Standard SSL port
      return 'SSL';
   }
      
   unless ( $ssl_installed ) {
      #  We don't have SSL installed on this machine
      return '';
   }

   #  For any other port we need to determine whether it supports SSL

   my $conn = IO::Socket::SSL->new(
         Proto           => "tcp",
         SSL_verify_mode => 0x00,
         PeerAddr        => $host,
         PeerPort        => $port,
    );

    if ( $conn ) {
       close( $conn );
       $mode = 'SSL';
    } else {
       $mode = '';
    }

   return $mode;
}

#  login
#
#  login in at the IMAP host with the user's name and password
#
sub login {

my $user = shift;
my $pwd  = shift;
my $conn = shift;

   if ( uc( $method ) eq 'CRAM-MD5' ) {
      #  A CRAM-MD5 login is requested
      Log("login method $method");
      my $rc = login_cram_md5( $user, $pwd, $conn );
      return $rc;
   }

   if ( $admin_user ) {
      #  Do an AUTH PLAIN login
      ($admin_user,$admin_pwd) = split(/:/, $admin_user);
      login_plain( $user, $admin_user, $admin_pwd, $conn ) or return 0;
      return 1;
   }

   if ( $pwd =~ /^oauth2---(.+)/i ) {
      $token = $1;
      Log("password is an OAUTH2 token");
      $status = login_xoauth2( $user, $token, $conn );
      return $status;
   }

   sendCommand ($conn, "1 LOGIN $user $pwd");
   while (1) {
	readResponse ( $conn );
	if ($response =~ /^1 OK/i) {
		last;
	}
	elsif ($response =~ /^1 NO|^1 BAD/) {
		Log ("$user login failed: unexpected LOGIN response: $response");
		return 0;
	}
   }
   Log("Logged in as $user") if $debug;

   return 1;
}

#  login_plain
#
#  login in at the source host with the user's name and password.  If provided
#  with administrator credential, use them as this eliminates the need for the 
#  user's password.
#
sub login_plain {

my $user      = shift;
my $admin     = shift;
my $pwd       = shift;
my $conn      = shift;

   #  Do an AUTHENTICATE = PLAIN.  If an admin user has been provided then use it.

   if ( !$admin ) {
      # Log in as the user
      $admin = $user
   }

   $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
   $login_str = encode_base64("$login_str", "");
   $len = length( $login_str );

   sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" );

   my $loops;
   while (1) {
        readResponse ( $conn );
        last if $response =~ /^1 OK/;
        if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
           Log ("unexpected LOGIN response: $response");
           return 0;
        }
        $last if $loops++ > 5;
   }

   return 1;

}

#  login_xoauth2
#
#  login in at the source host with the user's name and an XOAUTH2 token.  
#
sub login_xoauth2 {

my $user      = shift;
my $token     = shift;
my $conn      = shift;

   #  Do an AUTHENTICATE = XOAUTH2 login

   $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", '');
   sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" );

   my $loops;
   while (1) {
        readResponse ( $conn );
        if ( $response =~ /^\+ (.+)/ ) {
           $error = decode_base64( $1 );
           Log("XOAUTH authentication as $user failed: $error");
           return 0;
        }
        last if $response =~ /^1 OK/;
        if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
           Log ("unexpected LOGIN response: $response");
           return 0;
        }
        $last if $loops++ > 5;
   }

   Log("login complete") if $debug;

   return 1;

}

sub login_cram_md5 {

my $user = shift;
my $pwd  = shift;
my $conn = shift;

   sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5");
   while (1) {
        readResponse ( $conn );
        last if $response =~ /^\+/;
        if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
           Log ("unexpected LOGIN response: $response");
           return 0;
        }
   }

   my ($challenge) = $response =~ /^\+ (.+)/;

   Log("challenge $challenge") if $debug;
   $response = cram_md5( $challenge, $user, $pwd );
   Log("response $response") if $debug;

   sendCommand ($conn, $response);
   while (1) {
        readResponse ( $conn );

        if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
           #  The destination is an Exchange server
           $exchange = 1;
           Log("The destination is an Exchange server");
        }

        last if $response =~ /^1 OK/i;
        if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
           Log ("unexpected LOGIN response: $response");
           return 0;
        }
   }
   Log("Logged in as $user") if $debug;

   return 1;
}



sub cram_md5 {

my $challenge = shift;
my $user      = shift;
my $password  = shift;

eval 'use Digest::HMAC_MD5 qw(hmac_md5_hex)';
use MIME::Base64 qw(decode_base64 encode_base64);

   # Adapated from script by Paul Makepeace <http://paulm.com>, 2002-10-12
   # Takes user, key, and base-64 encoded challenge and returns base-64
   # encoded CRAM. See,
   # IMAP/POP AUTHorize Extension for Simple Challenge/Response:
   # RFC 2195 http://www.faqs.org/rfcs/rfc2195.html
   # SMTP Service Extension for Authentication:
   # RFC 2554 http://www.faqs.org/rfcs/rfc2554.html
   # Args: tim tanstaaftanstaaf PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+
   # should yield: dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw

   my $challenge_data = decode_base64($challenge);
   my $hmac_digest = hmac_md5_hex($challenge_data, $password);
   my $response = encode_base64("$user $hmac_digest");
   chomp $response;

   if ( $debug ) {
      Log("Challenge: $challenge_data");
      Log("HMAC digest: $hmac_digest");
      Log("CRAM Base64: $response");
   }

   return $response;
}

#
#  readResponse
#
#  This subroutine reads and formats an IMAP protocol response from an
#  IMAP server on a specified connection.
#

sub readResponse {

my $fd = shift;

   exit unless defined $fd;
   $response = <$fd>;
   chop $response;
   $response =~ s/\r//g;
   push (@response,$response);
   Log ("<< *** Connection timeout ***") if $conn_timed_out;
   Log ("<< $response") if $showIMAP;
}

#  sendCommand
#
#  This subroutine formats and sends an IMAP protocol command to an
#  IMAP server on a specified connection.
#
sub sendCommand {

local($fd) = shift @_;
local($cmd) = shift @_;

    print $fd "$cmd\r\n";
    Log (">> $cmd") if $showIMAP;
}

#
#  log out from the host
#
sub logout {

my $conn = shift;

   undef @response;
   sendCommand ($conn, "1 LOGOUT");
   while ( 1 ) {
        readResponse ($conn);
        next if $response =~ /APPEND complete/i;   # Ignore strays
        if ( $response =~ /^1 OK/i ) {
           last;
        } elsif ( $response !~ /^\*/ ) {
           Log("unexpected logout response $response");
           last;
        }
   }
   close $conn;
   return;
}

sub selectMbx {

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

   sendCommand( $conn, "1 SUBSCRIBE \"$mbx\"");
   while ( 1 ) {
      readResponse( $conn );
      if ( $response =~ /^1 OK/i ) {
         Log("Mailbox $mbx has been subscribed") if $debug;
         last;
      } elsif ( $response =~ /^1 NO|^1 BAD|\^* BYE/i ) {
         Log("Unexpected response to subscribe $mbx command: $response");
         last;
      }
   }
   sendCommand ($conn, "1 SELECT \"$mbx\"");
   undef @response;
   $empty=0;
   while ( 1 ) {
        readResponse ( $conn );
        if ( $response =~ /^1 OK/i ) {
           # print STDERR "response $response\n";
           last;
        }
        elsif ( $response !~ /^\*/ ) {
           Log ("unexpected response: $response");
          return 0;
        }
   }

}

sub createMbx {

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

   #  Create a mailbox


   sendCommand ($conn, "1 CREATE \"$mbx\"");
   while ( 1 ) {
      readResponse ($conn);
      last if $response =~ /^1 OK|already exists /i;
      if ( $response !~ /^\*/ ) {
         if (!($response =~ /already exists|reserved mailbox name/i)) {
            # Log ("WARNING: $response");
         }
         last;
      }
   }
}

sub getMailboxList {

my $user = shift;
my $conn = shift;
my @mbxs;
my @mailboxes;

   #  Get a list of the user's mailboxes
   #
  if ( $mbxList ) {
      #  The user has supplied a list of mailboxes so only processes
      #  the ones in that list
      @mbxs = split(/,/, $mbxList);
      foreach $mbx ( @mbxs ) {
         trim( *mbx );
         push( @mailboxes, $mbx );
      }
      return @mailboxes;
   }

   if ($debug) { Log("Get list of user's mailboxes",2); }

   sendCommand ($conn, "1 LIST \"\" *");
   undef @response;
   while ( 1 ) {
	readResponse ($conn);
	if ( $response =~ /^1 OK/i ) {
		last;
	}
	elsif ( $response !~ /^\*/ ) {
		Log ("unexpected response: $response");
		return 0;
	}
   }

   undef @mbxs;

   for $i (0 .. $#response) {
        $response[$i] =~ s/\s+/ /;
        if ( $response[$i] =~ /"$/ ) {
           $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i;
           $mbx = $3;
        } else {
           $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i;
           $mbx = $3;
        }
	$mbx =~ s/^\s+//;  $mbx =~ s/\s+$//;

	if ($response[$i] =~ /NOSELECT/i) {
		if ($debug) { Log("$mbx is set NOSELECT,skip it",2); }
		next;
	}
	if (($mbx =~ /^\#/) && ($user ne 'anonymous')) {
		#  Skip public mbxs unless we are migrating them
		next;
	}
	if ($mbx =~ /^\./) {
		# Skip mailboxes starting with a dot
		next;
	}
	push ( @mbxs, $mbx ) if $mbx ne '';
   }

   if ( $mbxList ) {
      #  The user has supplied a list of mailboxes so only processes
      #  those
      @mbxs = split(/,/, $mbxList);
   }

   return @mbxs;
}

#  getMsgList
#
#  Get a list of the user's messages in the indicated mailbox on
#  the source host
#
sub getMsgList {

my $mailbox = shift;
my $msgs    = shift;
my $conn    = shift;
my $seen;
my $empty;
my $msgnum;
my $from;
my $flags;

   @$msgs  = ();
   trim( *mailbox );
   sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
   undef @response;
   $empty=0;
   while ( 1 ) {
	readResponse ( $conn );
	if ( $response =~ / 0 EXISTS/i ) { $empty=1; }
	if ( $response =~ /^1 OK/i ) {
		# print STDERR "response $response\n";
		last;
	}
	elsif ( $response !~ /^\*/ ) {
		Log ("unexpected response: $response");
		# print STDERR "Error: $response\n";
		return 0;
	}
   }

   if ( $empty ) {
      Log("$mailbox is empty");
      return;
   }

   Log("Fetch the header info") if $debug;

   sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])");
   undef @response;
   while ( 1 ) {
	readResponse ( $conn );
	return if $conn_timed_out;
	if ( $response =~ /^1 OK/i ) {
	   last;
	} elsif ( $response =~ /could not be processed/i ) {
           Log("Error:  response from server: $response");
           return;
        } elsif ( $response =~ /^1 NO|^1 BAD/i ) {
           return;
        }
   }

   $flags = '';
   for $i (0 .. $#response) {
	$seen=0;
	$_ = $response[$i];

	last if /OK FETCH complete/;

        if ($response[$i] =~ /FLAGS/) {
           #  Get the list of flags
           $response[$i] =~ /FLAGS \(([^\)]*)/;
           $flags = $1;
           $flags =~ s/\\Recent//;
        }

        if ( $response[$i] =~ /INTERNALDATE/) {
           $response[$i] =~ /INTERNALDATE (.+) BODY/;
           # $response[$i] =~ /INTERNALDATE "(.+)" BODY/;
           $date = $1;

           $date =~ /"(.+)"/;
           $date = $1;
           $date =~ s/"//g;
        }

        if ( $response[$i] =~ /\* (.+) FETCH/ ) {
           ($msgnum) = split(/\s+/, $1);
        }

        if ( $msgnum && $date ) {
           if ( $unseen ) {
	      push (@$msgs,"$msgnum|$date|$flags") unless $flags =~ /Seen/i;
           } else {
	      push (@$msgs,"$msgnum|$date|$flags");
           }
           $msgnum = $date = '';
        }
   }

}

#  insert_imap_msg
#
#  This routine inserts an RFC822 message into a user's folder
#
sub insert_imap_msg {

my $conn    = shift;
my $mbx     = shift;
my $message = shift;
my $flags   = shift;
my $date    = shift;
my ($lsn,$lenx);

   $lenx = length($$message);
   Log("   Inserting message") if $debug;
   Log("message size $lenx bytes") if $debug;

   $date =~ s/\((.+)\)//;
   $date =~ s/\s+$//g;

   $totalBytes = $totalBytes + $lenx;
   $totalMsgs++;

   #  Create the mailbox unless we have already done so
   # if ($destMbxs{"$mbx"} eq '') {
   #    createMbx( $mbx, $conn );
   # } 
   # $destMbxs{"$mbx"} = '1';

   $flags =~ s/\\Recent//i;
   $flags =~ s/Unseen//i;

   if ( $date ) {
      sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}");
   } else {
      sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \{$lenx\}");
   }
   
   readResponse ($conn);
   if ($conn_timed_out) {
       Log ("unexpected response timeout appending message");
       push(@errors,"Error appending message to $mbx for $user");
       return 0;
   }
	
   if ( $response !~ /^\+/ ) {
       Log ("unexpected APPEND response: >$response<");
       # next;
       push(@errors,"Error appending message to $mbx for $user");
       return 0;
   }

   print $conn "$$message\r\n";

   undef @response;
   while ( 1 ) {
       readResponse ($conn);
       if ( $response =~ /^1 OK/i ) {
	   last;
       }
       elsif ( $response !~ /^\*/ ) {
	   Log ("Unexpected APPEND response: >$response<");
	   # next;
	   return 0;
       }
   }

   return 1;
}

sub mbxExists {

my $mbx  = shift;
my $conn = shift;
my $status = 1;

   #  Determine whether a mailbox exists
   sendCommand ($conn, "1 SELECT \"$mbx\"");
   while (1) {
        readResponse ($conn);
        last if $response =~ /^1 OK/i;
        if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) {
           $status = 0;
           last;
        }
   }

   return $status;
}

sub get_maildir_folders {

my $userpath = shift;
my $folders  = shift;

   #  Get a list of the user's folders 
   
   %$folders = ();

   if ( $mbxList ) {
      #  The user has supplied a list of mailboxes
      foreach $mbx ( split(/,/, $mbxList ) ) {
         $$folders{"$mbx"} = $userpath . '/.' . $mbx;
      }
      return;
   }

   opendir D, $userpath;
   my @files = readdir( D );
   closedir D;

   $$folders{'INBOX'} = $userpath;
   foreach $fn ( @files ) {
      next if $fn eq '.';
      next if $fn eq '..';
      next unless $fn =~ /^\./;
      my $fname = $fn;
      $fname =~ s/\./\//;
      $fname =~ s/^\///;
      $$folders{"$fname"} = "$userpath/$fn";
   }

}

sub get_maildir_msgs {

my $path = shift;
my $msgs = shift;
my @subdirs = qw( tmp cur new );

   @$msgs = ();
   foreach $subdir ( @subdirs ) {
      opendir D, "$path/$subdir";
      my @files = readdir( D );
      closedir D;

      foreach $fn ( @files ) {
         next if $fn =~ /^\./;
         my $msgfn = "$path/$subdir/$fn";
         push( @$msgs, $msgfn );
      }
   }

}

sub imap_message_exists {

my $msgid = shift;
my $conn  = shift;
my $msgnum;
my $loops;

   # Search a mailbox on the server for a message by its msgid.

   Log("   Search for $msgid") if $debug;
   sendCommand ( $conn, "1 SEARCH header Message-Id \"$msgid\"");
   while (1) {
        readResponse ($conn);
        if ( $response =~ /\* SEARCH /i ) {
           ($dmy, $msgnum) = split(/\* SEARCH /i, $response);
           ($msgnum) = split(/ /, $msgnum);
        }

        last if $response =~ /^1 OK|^1 NO|^1 BAD/;
        last if $response =~ /complete/i;

        last if $loops++ > 10;
   }

   if ( $debug ) {
      Log("$msgid was not found") unless $msgnum;
   }

   return $msgnum;
}

sub fix_date {

my $date = shift;
my $dow;

   #  Try to make the date acceptable to IMAP

   return if $$date eq '';
   fix_ts( $date );

   $$date =~ s/\((.+)\)$//;
   $$date =~ s/\s+$//g;

   if ( $$date =~ /\s*,\s*/ ) {
      ($dow,$$date) = split(/\s*,\s*/, $$date);
   }
   $$date =~ s/ /-/;
   $$date =~ s/ /-/;

   ($dom) = split(/-/, $$date );
   if ( length( $dom ) == 1 ) {
      #  Pad the day to two digits (Zimbra requires it)
      $$date = '0' . $$date;
   }

   return;

   #  Obsolete code

   my @terms = split(/\s+/, $$date);

   if ( $terms[0] =~ /(.+),/ ) {
      $dow = $1;
      if ( length( $dow ) > 3 ) {
         #  Day of week can't be more than 3 chars
         my $DOW = substr($dow,0,3);
         $$date =~ s/$dow/$DOW/;
      }
   } 

   if ( $terms[1] =~ /jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec/i ) {
      #  The month and day are swapped.
      my $temp = $terms[1];
      $terms[1] = $terms[2];
      $terms[2] = $temp;
   }

   if ( $terms[5] =~ /\((.+)\)/ ) {
      #  The date is missing the TZ offset
      $terms[5] = "+0000 ($1)";
   }

   if ( $terms[5] =~ /"(.+)"/ ) {
      #  The TZ code has quotes instead of parens
      $terms[5] =~ s/"/\(/;
      $terms[5] =~ s/"/\)/;
      $terms[5] = "+0000 $terms[5]";
   }

   if ( $terms[5] =~ /-[0-9]-[0-9][0-9]/ ) {
      #  Lots of dates are like '-0-500'
      $terms[5] =~ s/-//g;
      $terms[5] = '-' . $terms[5];
   }

   if ( $terms[5] eq '-0-100' ) {
      #  Don't know what this is supposed to mean
      $terms[5] = "+0000";
   }

   if ( $terms[5] eq '00800' ) {
      $terms[5] = "+0800";
   }

   if ( $terms[5] eq '-' ) {
      $terms[5] .= $terms[6];
      $terms[5] =~ s/\s+//g;
      $terms[6] = '';
   }
   if ( $terms[4] =~ /\./ ) {
      $terms[4] =~ s/\./:/g;
   }

   if ( $terms[5] =~ /[a-zA-Z]/ ) {
      $terms[5] = "-0000 ($terms[5])" unless $terms[5] eq 'UT';
   }

   $$date = join( " ", @terms );

}