#!/usr/bin/perl

# $Header: /mhub4/sources/imap-tools/IMAPtoMbox.pl,v 1.13 2015/04/30 12:22:21 rick Exp $

#######################################################################
#   Program name    IMAPtoMbox.pl                                     #
#   Written by      Rick Sanders                                      #
#                                                                     #
#   Description                                                       #
#                                                                     #
#   IMAPtoMbox.pl is a utility for extracting all of the mailboxes    #
#   in an IMAP user's account and writing them to files in the        #
#   Unix mbx format.                                                  #
#                                                                     #
#   The user supplies host/user/password information and the name     #
#   of a directory on the local system.  IMAPtoMbox.pl connects to    #
#   the IMAP server and  extracts each message in the user's IMAP     #
#   mailboxes.  Those messages are written to a file with the same    #
#   name as the IMAP mailbox into the specified directory.            #
#                                                                     #
#   For example:                                                      #
#        ./IMAPtoMbox.pl -i localhost/rfs/mypass -m /var/rfs          #
#                                                                     #
#   Optional arguments:                                               #
#	-d debug                                                      #
#       -L logfile                                                    #
#       -M IMAP mailbox list (dumps the specified mailboxes, see      #
#                        the usage notes for syntax)                  #
#######################################################################

use Socket;
use FileHandle;
use Fcntl;
use Getopt::Std;
use MIME::Base64 qw(encode_base64 decode_base64);
use POSIX qw(strftime);

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

   $dir = init();

   #  Get list of all messages on the source host by Message-Id
   #
   connectToHost($sourceHost, \$dst);
   login($sourceUser,$sourcePwd, $dst);
   namespace($dst, \$prefix, \$delim );

   @mbxs = getMailboxList( $prefix, $dst );
   $number = $#mbxs + 1;
   
   foreach $mbx ( @mbxs ) {
        my $mbxname = $mbx;
        $mbxname =~ s/^$prefix// if $prefix;
        @msgs = ();
        Log("   $mbxname");
	getMsgList( $mbx, \@msgs, $dst ); 

        $mbxname =~ s/\//-/g;    # Don't allow slashes in filename
        $mbxfn = "$dir/$mbxname";
        if ( !open (M, ">>$mbxfn") ) {
           Log("Error opening $mbxfn: $!");
           print STDERR "Error opening $mbxfn\n";
           next;
        }
        $summary{"$mbx"} = 0; 
        next if $#msgs == -1;
        existingMboxMsgs( $mbxfn, \%mbox ) if $no_duplicates;
        $copied=0;
        next unless @msgs;
        foreach $msg ( @msgs ) {
             fetchMsg( $msg, $mbx, $dst, \$message, \$msgid );
             if ( $no_duplicates and ($mbox{"$msgid"}) ) {
                Log("     message $msgid already exists") if $debug;
                next; 
             }
             print M $message;
             print M "\n";
             $copied++;

             if ( $msgs_per_folder ) {
                #  opt_F allows us to limit number of messages copied per folder
                last if $copied == $msgs_per_folder;
             }
        }
        close M;

        `chown $opt_o "$mbxfn"` if $opt_o;   # Set ownership
        
        $summary{"$mbx"} = $copied++; 
   }

   logout( $dst );

   Log("\nSummary of results");
   while (($x,$y) = each(%summary)) {
       $x =~ s/^$prefix// if $prefix;
       $line = pack("A50 A10\n", $x, $y);
       push( @summary, $line );
   }
   @summary = sort @summary;
   foreach $line ( @summary ) {
      Log("$line");
   }

   exit;


sub init {

   $os = $ENV{'OS'};

   $dir = processArgs();

   $timeout = 60 if !$timeout;

   #  Open the logFile
   #
   if ( $logfile ) {
      if ( !open(LOG, ">> $logfile")) {
         print STDOUT "Can't open $logfile: $!\n";
      } 
      select(LOG); $| = 1;
   }
   Log("\n$0 starting");
   Log("arguments i = $opt_i   m = $opt_m");
   Log("Mailfiles will be written to $dir");
#  Determine whether we have SSL support via openSSL and IO::Socket::SSL
   $ssl_installed = 1;
   eval 'use IO::Socket::SSL';
   if ( $@ ) {
      $ssl_installed = 0;
   }

   $installed = 1;
   @date_modules = qw( DateTime Date::Parse POSIX);
   foreach $module ( @date_modules ) {
      eval "use $module";
      if ( $@ ) {
         print STDERR "The Perl module $module is not installed.  Please install it before proceeding.\n";
         $installed = 0;
      }
   } 
   exit if $installed == 0;

   return $dir;
}

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

    if ($showIMAP) { Log (">> $cmd",2); }
}

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

sub readResponse {

local($fd) = shift @_;

    $response = <$fd>;
    chop $response;
    $response =~ s/\r//g;
    push (@response,$response);
    if ($showIMAP) { Log ("<< $response",2); }
}

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

sub Log {
 
my $str = shift;

   ($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 %s\n",
	     $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str);
   print LOG "$line";
   print STDERR "$str\n";

}

#  connectToHost
#
#  Make a connection to a host
# 
sub connectToHost {

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

   Log("Connecting to $host") if $debug;
   
   ($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;
      }
   } 
   Log("Connected to $host on port $port");

   select( $$conn ); $| = 1;
   while (1) {
	readResponse ( $$conn );
	if ( $response =~ /^\* OK/i ) {
	   last;
	}
	else {
 	   Log ("Bad response from host on port $port: $response");
	   return 0;
	}
   }
   Log ("connected to $host") if $debug;

   select( $$conn ); $| = 1;
   return 1;
}

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


#  trim
#
#  remove leading and trailing spaces from a string
sub trim {
 
local (*string) = @_;

   $string =~ s/^\s+//;
   $string =~ s/\s+$//;

   return;
}


#  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 ( $admin_user ) {
      #  An AUTHENTICATE = PLAIN login has been requested
      ($authuser,$authpwd) = split(/:/, $admin_user );
      login_plain( $user, $authuser, $authpwd, $conn ) or exit;
      return 1;
   }

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

   sendCommand ($conn, "1 LOGIN $user \"$pwd\"");
   while (1) {
	readResponse ( $conn );
	if ($response =~ /^1 OK/i) {
	   last;
	}
	elsif ($response =~ /NO/) {
	   Log ("unexpected LOGIN response: $response");
	   exit;
	}
   }
   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" );

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

   sendCommand ($conn, "$login_str" );
   my $loops;
   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");
           exit;
        }
        $last if $loops++ > 5;
   }

   return 1;

}


#  logout
#
#  log out from the host
#
sub logout {

my $conn = shift;

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


#  getMailboxList
#
#  get a list of the user's mailboxes from the source host
#
sub getMailboxList {

my $prefix = shift;
my $conn   = shift;
my @mbxs;

   #  Get a list of the user's mailboxes
   #

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

   if ( $mbxList ) {
      foreach $mbx ( split(/,/, $mbxList) ) {
         $mbx = $prefix . $mbx if $prefix;
         if ( $opt_r ) {
            # Get all submailboxes under the ones specified
            $mbx .= '*';
            @mailboxes = listMailboxes( $mbx, $conn);
            push( @mbxs, @mailboxes );
         } else {
            push( @mbxs, $mbx );
         }
      }
   } else {
      #  Get all mailboxes
      @mbxs = listMailboxes( '*', $conn);
   }

   return @mbxs;
}

#  listMailboxes
#
sub listMailboxes {

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

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

   %nosel_mbxs = ();
   @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+$//;

        next if $response[$i] =~ /NOSELECT/i;
        
        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 '';
   }

   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;

   trim( *mailbox );
   sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
   undef @response;
   $empty=0;
   select($conn);
   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;
	}
   }

   return if $empty;

   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 );
	if ( $response =~ /^1 OK/i ) {
		# print STDERR "response $response\n";
		last;
	}
   }

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

	last if /OK FETCH complete/;

        if ( $response[$i] =~ /^From:\s*(.+)/i ) {
           $from = $1 if !$from;
        }
        
        if ( $response[$i] =~ /^Date: (.+)/ ) {
           # Firstly assume that the date is formatted correctly and split accordingly.
           $origdate = $1;
           $date = $origdate;
           $date =~ s/,//g;
           ($date) = split(/-/, $date);
           ($wkday,$mday,$mon,$yr,$time) = split(/\s+/, $date);
           $mday = '0' . $mday if length($mday) == 1;
           $date = "$wkday $mon $mday $time $yr";

           # Now actually parse the date to check that it is formatted correctly.
           # Assume GMT if timezone is omitted.
           my @parseddate = strptime ($origdate, "GMT");
           # If the number of seconds were omitted then assume 0.
           if ( !defined $parseddate[0] ) {
              $parseddate[0] = 0;
           }
           # If the year was given as 2 digits, assume it can't be less than the UNIX epoch of 1970.
           if ( $parseddate[5] < 70 ) {
              $parseddate[5] += 100;
           }
           # strptime returns the timezone as an offset in seconds. Convert back to +/-HHMM format.
           if ( $parseddate[6] < 0 ) {
              $parseddate[6] = sprintf ("-%02d%02d", int (-$parseddate[6] / 3600), int ((-$parseddate[6] % 3600) / 60));
           } else {
              $parseddate[6] = sprintf ("+%02d%02d", int ($parseddate[6] / 3600), int (($parseddate[6] % 3600) / 60));
           }
           eval '
           $dt = DateTime->new (second => $parseddate[0],
                                   minute => $parseddate[1],
                                   hour => $parseddate[2],
                                   day => $parseddate[3],
                                   month => $parseddate[4] + 1,   # needs to be 1-12 and not 0-11.
                                   year => $parseddate[5] + 1900, # needs to be an absolute year.
                                   time_zone => $parseddate[6]);
            ';

            if ( length( $@ ) != 0 ) {
               #  The date is too badly formatted to fix.  Use today's date instead. 
               Log("The date $date is badly formatted, using today's date instead");
               $date = strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time()));
            } else {
               $newdate = $dt->strftime ("%a %b %d %H:%M:%S %Y");

               # Compare the parsed date with that formed by assuming the date was correctly formatted.
               # Let the user know if they differ so they can judge if the calculated date is correct.
               if ( $date ne $newdate ) {
                  Log ("badly formatted date in message: " . $origdate);
                  Log (" calculated replacement date as: " . $newdate);
                  $date = $newdate;
               }
            }
        }

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

        if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) {
	   push (@$msgs,"$msgnum|$from|$date");
           $msgnum = $date = '';
        }
   }


}

#
##  Fetch a message from the IMAP server
#

sub fetchMsg {

my $msg    = shift;
my $mbx    = shift;
my $conn   = shift;
my $message = shift;
my $msgid  = shift;

   my ($msgnum,$from,$date) = split(/\|/, $msg);
   Log("   Fetching msg $msgnum...") if $debug;
   sendCommand ($conn, "1 EXAMINE \"$mbx\"");
   while (1) {
        readResponse ($conn);
	last if ( $response =~ /^1 OK/i );
   }

   sendCommand( $conn, "1 FETCH $msgnum (rfc822)");
   while (1) {
	readResponse ($conn);
	if ( $response =~ /^1 OK/i ) {
		$size = length($message);
		last;
	} 
        elsif ( $response =~ /^1 NO|^1 BAD/ ) {
                last;
        }
	elsif ($response =~ /message number out of range/i) {
		Log ("Error fetching uid $uid: out of range",2);
		$stat=0;
		last;
	}
	elsif ($response =~ /Bogus sequence in FETCH/i) {
		Log ("Error fetching uid $uid: Bogus sequence in FETCH",2);
		$stat=0;
		last;
	}
	elsif ( $response =~ /message could not be processed/i ) {
		Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
		push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
		$stat=0;
		last;
	}
	elsif 
	   ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) {
		($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i);
		$cc = 0;
		$$message = "";
		while ( $cc < $len ) {
			$n = 0;
			$n = read ($conn, $segment, $len - $cc);
			if ( $n == 0 ) {
			   Log ("unable to read $len bytes");
			   return 0;
			}
			$$message .= $segment;
			$cc += $n;
		}
	}
   }

   $$message =~ s/\r//g;
   if ( $$message !~ /^From / ) {
      $$message = "From $from $date\n$$message";
   }

   #  Some servers don't like single-digit days in the timestamp
   #  in the "From " line
   for $i (0 .. 9 ) {
       $$message =~ s/ $i / 0$i /;
   }

   $$message =~ /Message-ID:\s*\<(.+)\>/i;
   $$msgid = $1 if $1;

}

#
##  Display the usage message
#

sub usage {

   print STDOUT "\nusage:";
   print STDOUT "IMAPtoMbox.pl -i Host/User/Password -m <dir> [-M] [-d] [-I] [-o <user>] \n";
   print STDOUT "\n Optional arguments:\n";
   print STDOUT "    -M IMAP mailbox list (eg \"Inbox, Drafts, Notes\". Default all mailboxes)\n";
   print STDOUT "    -o <user>  sets ownership of mailfile\n";
   print STDOUT "    -A <admin_user:admin_pwd>\n";
   print STDOUT "    -L logfile\n";
   print STDOUT "    -d debug\n";
   print STDOUT "    -I show IMAP protocal exchanges\n";
   print STDOUT "    -n don't copy if message already exists in mbox file\n";
   print STDOUT "    -r include submailboxes when used with -M\n\n";
   exit;

}

#
##  Get command-line arguments
#
sub processArgs {

   if ( !getopts( "di:L:m:hM:Io:nrF:A:" ) ) {
      usage();
   }

   ($sourceHost,$sourceUser,$sourcePwd) = split(/\//, $opt_i);
   $mbxList  = $opt_M;
   $logfile  = $opt_L;
   $dir      = $opt_m;
   $owner    = $opt_o;
   $no_duplicates = 1 if $opt_n;
   $submbxs  = 1 if $opt_r;
   $debug    = 1 if $opt_d;
   $showIMAP = 1 if $opt_I;
   $msgs_per_folder = $opt_F;
   $admin_user = $opt_A;

   if ( !$dir ) {
      print "You must specify the file directory where messages will\n";
      print "be written using the -m argument.\n\n";
      usage();
      exit;
   }

   if ( !-d $dir ) {
      print "Fatal Error: $dir does not exist\n";
      exit;
   }

   usage() if $opt_h;

   return $dir;

}

sub existingMboxMsgs {

my $mbx  = shift;
my $msgs = shift;


   #  Build an index of messages in an mbox by messageID.

   %$msgs = ();
   unless ( open(F, "<$mbx") ) {
      Log("Error opening mbox file $mbox: $!");
      return;
   }

   while ( <F> ) {
       if ( /^Message-ID:\s*\<(.+)\>/i ) {
          $$msgs{"$1"} = 1;
       }
   }
   close F;

}

sub namespace {

my $conn      = shift;
my $prefix    = shift;
my $delimiter = shift;

   #  Query the server with NAMESPACE so we can determine its
   #  mailbox prefix (if any) and hierachy delimiter.

   @response = ();
   sendCommand( $conn, "1 NAMESPACE");
   while ( 1 ) {
      readResponse( $conn );
      if ( $response =~ /^1 OK/i ) {
         last;
      } elsif ( $response =~ /NO|BAD/i ) {
         Log("Unexpected response to NAMESPACE command: $response");
         last;
      }
   }

   foreach $_ ( @response ) {
      if ( /NAMESPACE/i ) {
         my $i = index( $_, '((' );
         my $j = index( $_, '))' );
         my $val = substr($_,$i+2,$j-$i-3);
         ($val) = split(/\)/, $val);
         ($$prefix,$$delimiter) = split( / /, $val );
         $$prefix    =~ s/"//g;
         $$delimiter =~ s/"//g;
         last;
      }
      last if /^NO|^BAD/;
   }
 
   if ( $debug ) {
      Log("prefix  $$prefix");
      Log("delim   $$delimiter");
   }

}

sub mailboxName {

my $mbx    = shift;
my $prefix = shift;
my $delim  = shift;

   #  Adjust the mailbox name if necessary using the mailbox hierarchy
   #  prefix and delimiter.

   $mbx =~ s#^$srcPrefix##;
   $mbx = $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;
}

#  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");
           exit;
        }
        last if $response =~ /^1 OK/;
        if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
           Log ("unexpected LOGIN response: $response");
           exit;
        }
        $last if $loops++ > 5;
   }

   Log("login complete") if $debug;

   return 1;

}