#!/usr/bin/perl -w

=head1 NAME 

imapsync - IMAP synchronization, copy or migration
tool. Synchronize mailboxes between two imap servers. Good
at IMAP migration.

$Revision: 1.156 $

=head1 INSTALL

 imapsync works fine under any Unix OS.
 imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl

 Get imapsync at
 http://www.linux-france.org/prj/imapsync/dist/

 You'll find a compressed tarball called imapsync-x.xx.tgz
 where x.xx is the version number. Untar the tarball where
 you want :

 tar xzvf  imapsync-x.xx.tgz

 Go into the directory imapsync-x.xx and read the INSTALL
 file.

 The freshmeat record is http://freshmeat.net/projects/imapsync/

=head1 SYNOPSIS

  imapsync [options]

  imapsync --help
  imapsync

  imapsync [--host1 server1]  [--port1 <num>]
           [--user1 <string>] [--passfile1 <string>]
           [--host2 server2]  [--port2 <num>]
           [--user2 <string>] [--passfile2 <string>]
           [--noauthmd5]
           [--folder <string> --folder <string> ...]
           [--include <regex>] [--exclude <regex>]
           [--prefix2 <string>] [--prefix1 <string>] 
           [--regextrans2 <regex> --regextrans2 <regex> ...]
           [--sep1 <char>]
           [--sep2 <char>]
           [--justfolders] [--justfoldersizes] [--justconnect]
           [--syncinternaldates]
           [--buffersize  <int>]
           [--syncacls]
           [--regexmess <regex>] [--regexmess <regex>]
           [--maxsize <int>]
           [--maxage <int>]
           [--minage <int>]
           [--skipheader <regex>]
           [--useheader <string>] [--useheader <string>]
           [--skipsize]
           [--delete] [--expunge] [--expunge1] [--expunge2]
           [--subscribed] [--subscribe]
           [--nofoldersizes]
           [--dry]
           [--debug] [--debugimap]
           [--timeout <int>] [--fast]
           [--version] [--help]
  
=cut
# comment
=pod

=head1 DESCRIPTION

The command imapsync is a tool allowing incremental and recursive
imap transfer from one mailbox to another.

We sometimes need to transfer mailboxes from one imap server to
another. This is called migration.

imapsync is the adequate tool because it reduces the amount
of data transfered by not transfering a given message if it
is already on both sides. Same headers, same message size
and the transfert is done only once. All flags are
preserved, unread will stay unread, read will stay read,
deleted will stay deleted. You can stop the transfert at any
time and restart it later, imapsync is adapted to a bad
connection.

You can decide to delete the messages from the source mailbox
after a successful transfert (it is a good feature when migrating).
In that case, use the --delete --expunge1 options.

You can also just synchronize a mailbox A from another mailbox B
in case you just want to keep a "live" copy of B in A.

=head1 OPTIONS

Invoke: imapsync --help

=head1 HISTORY

I wrote imapsync because an enterprise (basystemes) paid me to install
a new imap server without loosing huge old mailboxes located on a far
away remote imap server accessible by a low bandwith link. The tool
imapcp (written in python) could not help me because I had to verify
every mailbox was well transfered and delete it after a good
transfert. imapsync started its life being a copy_folder.pl patch.
The tool copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl
module tarball source (in the examples/ directory of the tarball).

=head1 EXAMPLE

While working on imapsync parameters please run imapsync in
dry mode (no modification induced) with the --dry
option. Nothing bad can be done this way.

To synchronize the imap account "buddy" on host
"imap.src.fr" to the imap account "max" on host
"imap.dest.fr" (the passwords are located in too files
"/etc/secret1" for "buddy", "/etc/secret2" for "max") :

 imapsync --host1 imap.src.fr  --user1 buddy --passfile1 /etc/secret1 \
          --host2 imap.dest.fr --user2 max   --passfile2 /etc/secret2

Then, you will have buddy's mailbox updated from max's
mailbox.

=head1 SECURITY

You can use --password1 instead of --passfile1 to give the
password but it is dangerous because any user on your host
can see the password by using the 'ps auxwwww'
command. Using a variable (like $PASSWORD1) is also
dangerous because of the 'ps auxwwwwe' command. So, saving
the password in a well protected file (600 or rw-------) is
the best solution.

imasync is not protected against sniffers on the network so
the passwords are in plain text.

=head1 EXIT STATUS

imapsync will exit with a 0 status (return code) if everything went good.
Otherwise, it exits with a non-zero status.

So if you have a buggy internet connection, you can use this loop 
in a Bourne shell:

        while ! imapsync ...; do 
              echo imapsync not complete
        done

=head1 AUTHOR

Gilles LAMIRAL <lamiral@linux-france.org>

Feedback good or bad is always welcome. The first you send
me an email you will receive a confirmation request before I
really read your message.

The newsgroup comp.mail.imap is a good place to talk about
imapsync. I read it when imapsync is concerned.

=head1 LICENSE

imapsync is free, gratis and open source software cover by
the GNU General Public License. See the GPL file included in
the distribution or the web site
http://www.gnu.org/licenses/licenses.html

=head1 BUGS

No known serious bug.

Multiple copies: Multiple copies of the emails on the
destination server. Some IMAP servers (Domino for example)
add some headers for each message transfered. The message is
transfered again and again each time you run imapsync. This
is bad of course. The explanation is that imapsync considers
the message is not the same since headers have changed (one
line added) and size too (the header part). You can look at
the headers found by imapsync by using the --debug option
(and search for the message on both part). The way to avoid
this problem is by using options --skipheader and
--skipsize, like this (avoid headers beginning whith X-):

 imapsync ... --skipheader '^X-' --skipsize

You can use --skipheader only one time; if you need to skip
several different headers use the "or" perl regex caracter
which is "|". Example:

 imapsync ... --skipheader '^X-|^Status|^Bcc'

Flags : with some IMAP servers the flags are not very well
copied the first time.  Run imapsync twice if you want the
flags set correctly.  (fixed since 1.28 release but wait for
a time before removing those lines)

Report any bugs to the author.

=head1 IMAP SERVERS

Failure stories reported with the following imap servers :

 - MailEnable 1.54 (Proprietary) http://www.mailenable.com/
 - DBMail 2.0.7 (GPL). But DBMail 1.2.1 works.
   Patient and confident testers are welcome.

Success stories reported with the following imap servers 
(softwares names are in alphabetic order) : 

 - BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
 - CommunicatePro server (Redhat 8.0)
 - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1 (GPL) 
   (http://www.courier-mta.org/)
 - Critical Path (7.0.020)
 - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18 
   2.2.1, 2.2.2-BETA, 2.2.10, 2.2.12, 2.3-alpha (OSI Approved)
   (http://asg.web.cmu.edu/cyrus/)
 - DBMail 1.2.1 (GPL) (http://www.dbmail.org/). 2.0.7 seems buggy.
 - Dovecot 0.99.10.4  0.99.14 (LGPL) (http://www.dovecot.org/)
 - Domino (Notes) 6.5, 5.0.6, 5.0.7
 - Groupwise IMAP (Novell). Buggy so see the FAQ.
 - iPlanet Messaging server 4.15, 5.1
 - IMail 7.15 (Ipswitch/Win2003), 8.12
 - MDaemon 7.0.1, 8.1
 - MS Exchange Server 5.5
 - Netscape Mail Server 3.6 (Wintel !)
 - Netscape Messaging Server 4.15 Patch 7
 - OpenWave
 - Qualcomm Worldmail (NT)
 - Samsung Contact IMAP server 8.5.0
 - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System)
 - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287
   (RedHat uses UW like 2003.338rh) (OSI Approved) 
   (http://www.washington.edu/imap/)
 - UW - QMail v2.1

Please report to the author any success or bad story with
imapsync and don't forget to mention the IMAP server
software names and version on both sides. This will help
future users. To help the author maintaining this section
report the two lines at the begining of the output if they
are useful to know the softwares. Example:

 From software :* OK louloutte Cyrus IMAP4 v1.5.19 server ready
 To   software :* OK Courier-IMAP ready

You can use option --justconnect to get those lines.
Example :

  imapsync --host1 imap.troc.org --host2 imap.trac.org --justconnect

And please rate imapsync at http://freshmeat.net/projects/imapsync/

=head1 HUGE MIGRATION


Have a special attention on options 
--subscribed
--subscribe
--delete
--expunge
--expunge1
--expunge2
--maxage
--minage
--maxsize
--useheader

If you have many mailboxes to migrate think about a little
shell program. Write a file called file.csv (for example)
containing users and passwords.
The separator used in this example is ';'

The file.csv file content is :

user0001;password0001;user0002;password0002
user0011;password0011;user0012;password0012
...

And the shell program is just :

 { while IFS=';' read  u1 p1 u2 p2; do 
	imapsync --user1 "$u1" --password1 "$p1" --user2 "$u2" --password2 "$p2" ...
 done ; } < file.csv

Welcome in shell programming !

=head1 Hacking

Feel free to hack imapsync as the GPL Licence permits it.

=head1 Links

Entries for imapsync:
  http://www.imap.org/products/showall.php


=head1 SIMILAR SOFTWARES

  imap_tools  : http://www.athensfbc.com/imap_tools
  offlineimap : http://gopher.quux.org:70/devel/offlineimap/
  mailsync    : http://mailsync.sourceforge.net/
  imapxfer    : http://www.washington.edu/imap/
                part of the imap-utils from UW.
  mailutil    : replace imapxfer in 
                part of the imap-utils from UW.
		http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil
  imaprepl    : http://www.bl0rg.net/software/
                http://freshmeat.net/projects/imap-repl/
  imap_migrate: http://freshmeat.net/projects/imapmigration/
  imapcopy    : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
  migrationtool http://sourceforge.net/projects/migrationtool/
  pop2imap    : http://www.linux-france.org/prj/pop2imap/

Feedback (good or bad) will be always welcome.

=head1 AUTHOR

Gilles LAMIRAL earn his living writing, installing,
configuring and teaching free open and gratis
softwares. Don't hesitate to pay him for that services.

$Id: imapsync,v 1.156 2006/03/02 03:14:12 gilles Exp gilles $

=cut


++$|;
use strict;
use Getopt::Long;
use Mail::IMAPClient;
use Digest::MD5  qw(md5_base64);
use Term::ReadKey;
#use Digest::HMAC_MD5;

eval { require 'usr/include/sysexits.ph' };


my(
        $rcs, $debug, $debugimap, $error,
	$host1, $host2, $port1, $port2,
	$user1, $user2, $password1, $password2, $passfile1, $passfile2,
        @folder, $include, $exclude, 
        $prefix1, $prefix2, 
        @regextrans2, @regexmess,
        $sep1, $sep2,
	$syncinternaldates, $syncacls,
        $fastio1, $fastio2, 
	$maxsize, $maxage, $minage, 
        $skipheader, @useheader,
        $skipsize, $foldersizes, $buffersize,
	$delete, $expunge, $expunge1, $expunge2, $dry,
        $justfoldersizes,
        $authmd5,
        $subscribed, $subscribe,
	$version, $VERSION, $help, 
        $justconnect, $justfolders,
        $fast,
        $mess_size_total_trans,
        $mess_size_total_skipped,
        $mess_size_total_error,
        $mess_trans, $mess_skipped,
        $timeout,   # whr (ESS/PRW)
	$timestart, $timeend, $timediff,
        $timesize, $timebefore,
);

use vars qw ($opt_G); # missing code for this will be option.


$rcs = ' $Id: imapsync,v 1.156 2006/03/02 03:14:12 gilles Exp gilles $ ';
$rcs =~ m/,v (\d+\.\d+)/;
$VERSION = ($1) ? $1 : "UNKNOWN";

my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION;

check_lib_version() or 
  die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n";


$mess_size_total_trans   = 0;
$mess_size_total_skipped = 0;
$mess_size_total_error   = 0;
$mess_trans = $mess_skipped = 0;


sub check_lib_version {
	# I know this is ugly, I should write a sort function
	if ($VERSION_IMAPClient =~ m/(\d+)\.(\d+)\.(\d+)/) {
		$debug and print "VERSION_IMAPClient $1 $2 $3\n";
		my($major,$minor,$sub) = ($1, $2, $3);
		
		return(1) if($major >=3);
		return(0) if($major <=1);
		return(1) if($minor >=3);
		return(0) if($minor <=1);
		return(1) if($sub >=8);
		return(0) if($sub <=7);
	}else{
		return 0; # don't match regex => bad
	}
}

$error=0;

my $banner = join("", 
		  '$RCSfile: imapsync,v $ ',
		  '$Revision: 1.156 $ ',
		  '$Date: 2006/03/02 03:14:12 $ ',
		  "\n",
		  "Mail::IMAPClient version used here is ",
		  $VERSION_IMAPClient,"\n"
		 );

unless(defined(&_SYSEXITS_H)) {
	# 64 on my linux box.
	eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE);
}

get_options();
print $banner;

sub missing_option {
	my ($option) = @_;
	die "$option option must be used, run $0 --help for help\n";
}

$host1 || missing_option("--host1") ;
$port1 = (defined($port1)) ? $port1 : 143;

$host2 || missing_option("--host2") ;
$port2 = (defined($port2)) ? $port2 : 143;

sub connect_imap {
	my($host, $port, $debugimap) = @_;
	my $imap = Mail::IMAPClient->new();
	$imap->Server($host);
	$imap->Port($port);
	$imap->Debug($debugimap);
	$imap->connect()
	  or die "Can not open imap connection on [$host] : $@\n";	
}

if ($justconnect) {
	my $from = ();
	my $to = ();
	
	$from = connect_imap($host1, $port1);
	print "From software : ", ($from->Report())[0];
	print "From capability : ", join(" ", $from->capability()), "\n";
	$to   = connect_imap($host2, $port2);
	print "To   software : ", ($to->Report())[0];
	print "To   capability : ", join(" ", $to->capability()), "\n";
	$from->logout();
	$to->logout();
	exit(0);
}
	

$user1 || missing_option("--user1");
$user2 || missing_option("--user2");

$authmd5 = (defined($authmd5)) ? $authmd5 : 1;

$syncacls = (defined($syncacls)) ? $syncacls : 0;
$foldersizes = (defined($foldersizes)) ? $foldersizes : 1;

$fastio1 = (defined($fastio1)) ? $fastio1 : 1;
$fastio2 = (defined($fastio2)) ? $fastio2 : 1;


@useheader = ("ALL") unless (@useheader);

print "From imap server [$host1] port [$port1] user [$user1]\n";
print "To   imap server [$host2] port [$port2] user [$user2]\n";

$password1 || $passfile1 || do {
	print "What's the password for $user1\@$host1? ";
	ReadMode 2;
	$password1 = <>; chop $password1;
	printf "\n"; ReadMode 0;
};

$password1 = (defined($passfile1)) ? firstline ($passfile1) : $password1;

$password2 || $passfile2 || do {
	print "What's the password for $user2\@$host2? ";
	ReadMode 2;
	$password2 = <>; chop $password2;
	printf "\n"; ReadMode 0;
};
$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2;

my $from = ();
my $to = ();

my $authmech = "CRAM-MD5";


$timestart = time();
$timebefore = $timestart;

$fastio1 = 1;
$fastio2 = 1;

$debugimap and print "From connection\n";
$from = login_imap($host1, $port1, $user1, $password1, $debugimap, $timeout, $fastio1);

$debugimap and print "To  connection\n";
$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout, $fastio2);

# No history
$from->Clear(2);
$to->Clear(2);

$debug and print "From Buffer I/O : ", $from->Buffer(), "\n";
$debug and print "To   Buffer I/O : ", $to->Buffer(), "\n";

	

sub login_imap {
	my($host, $port, $user, $password, 
	   $debugimap, $timeout, $fastio) = @_;
	my $imap = Mail::IMAPClient->new();
	$imap->Server($host);
	$imap->Port($port);
	$imap->Fast_io($fastio);
	$imap->Buffer($buffersize || 4096);
	$imap->Uid(1);
	$imap->Peek(1);
	$imap->Debug($debugimap);
	$imap->connect()
	  or die "Can not open imap connection on [$host] with user [$user] : $@\n";
	if ($timeout)    # whr (ESS/PRW)
	  {
		  $imap->Timeout($timeout);
		  print "Setting imap timeout to $timeout\n";
	  }

	$imap->User($user);
	$imap->Password($password);
	md5auth($imap);
	$imap->login() or die "Error login : [$host] with user [$user] : $@";
	return($imap);
}


sub md5auth() {
	my ($imap) = @_;
	
	unless ($authmd5) {
		print "$authmech not wanted by you\n";
		return;
	}
	if ($imap->has_capability($authmech) 
	    or $imap->has_capability("AUTH=$authmech")) {
		print "Server [", $imap->Server, 
		  "] has capability $authmech\n";
	}else{
		print "Server [", $imap->Server, 
		  "] has NOT capability $authmech\n";
		return;
	}
	#print "EE", $imap->Authmechanism(), "\n";
	if ($imap->Authmechanism($authmech)) {
		print "Using $authmech authentification\n";
	}else{
		$imap->Authmechanism(undef);
		print "Can NOT use $authmech authentification, using plain\n";
	}
	return;
}




print "From software : ", ($from->Report())[0];
print "To   software : ", ($to->Report())[0];

print "From capability : ", join(" ", $from->capability()), "\n";
print "To   capability : ", join(" ", $to->capability()), "\n";

die unless $from->IsAuthenticated();
die unless   $to->IsAuthenticated();

my (@f_folders, @t_folders, %fs_folders);

# Make a hash of subscribed folders in source server.
map { $fs_folders{$_}=1 } $from->subscribed();




if (scalar(@folder)) {
	# folders given by option --folder
	@f_folders = @folder;
}elsif ($subscribed) {
	# option --subscribed
	@f_folders = sort keys (%fs_folders);
}else {
	# no option, all folders
	@f_folders = sort $from->folders();
	# consider (optional) includes and excludes
	if ($include) {
		@f_folders = grep  /$include/,@f_folders;
		print "Only including folders matching pattern '$include'\n";
	}
	if ($exclude) {
		@f_folders = grep !/$exclude/,@f_folders;
		print "Excluding folders matching pattern '$exclude'\n";
	}
}

@t_folders = sort @{$to->folders()};

my($f_sep,$t_sep); 
# what are the private folders separators for each server ?


$debug and print "Getting separators\n";
$f_sep = get_separator($from, $sep1, "--sep1");
$t_sep = get_separator($to, $sep2, "--sep2");

#my $f_namespace = $from->namespace();
#my $t_namespace = $to->namespace();
#$debug and print "From namespace:\n", Data::Dumper->Dump([$f_namespace]);
#$debug and print "To   namespace:\n", Data::Dumper->Dump([$t_namespace]);

my($f_prefix,$t_prefix); 
$f_prefix = get_prefix($from, $prefix1, "--prefix1");
$t_prefix = get_prefix($to, $prefix2, "--prefix2");

sub get_prefix {
	my($imap, $prefix_in, $prefix_opt) = @_;
	my($prefix_out);
	
	$debug and print "Getting prefix namespace\n";
	if (defined($prefix_in)) {
		print "Using [$prefix_in] given by $prefix_opt\n";
		$prefix_out = $prefix_in;
		return($prefix_out);
	}
	$debug and print "Calling namespace capability\n";
	if ($imap->has_capability("namespace")) {
		my $r_namespace = $imap->namespace();
		$prefix_out = $r_namespace->[0][0][0];
		return($prefix_out);
	}else{
		print 
		  "No NAMESPACE capability in imap server ", 
		    $imap->Server(),"\n",
		      "Give the prefix namespace with the $prefix_opt option\n";
		exit(1);
	}
}


sub get_separator {
	my($imap, $sep_in, $sep_opt) = @_;
	my($sep_out);
	
	
	if ($sep_in) {
		print "Using [$sep_in] given by $sep_opt\n";
		$sep_out = $sep_in;
		return($sep_out);
	}
	$debug and print "Calling namespace capability\n";
	if ($imap->has_capability("namespace")) {
		$sep_out = $imap->separator();
		return($sep_out);
	}else{
		print 
		  "No NAMESPACE capability in imap server ", 
		    $imap->Server(),"\n",
		      "Give the separator caracter with the $sep_opt option\n";
		exit(1);
	}
}


print "From separator and prefix : [$f_sep][$f_prefix]\n";
print "To   separator and prefix : [$t_sep][$t_prefix]\n";


sub foldersizes {

	my ($side, $imap, $folders_r) = @_;
	my $tot = 0;
	my $tmess = 0;
	my @folders = @{$folders_r};
	print "++++ Calculating sizes ++++\n";
	foreach my $folder (@folders)     {
		my $stot = 0;
		my $smess = 0;
		printf("$side Folder %-35s", "[$folder]");
		unless ($imap->select($folder)) {
			warn 
			  "$side Folder $folder : Could not select ",
			    $imap->LastError,  "\n";
			$error++;
			next;
		}
		if (defined($maxage) or defined($minage)) {
			# The pb is fetch_hash() can only be applied on ALL messages
			my @msgs = select_msgs($imap);
			$smess = scalar(@msgs);
			foreach my $m (@msgs) {
				my $s = $imap->size($m)
				  or warn "Could not find size of message $m: $@\n";
				$stot += $s;
			}
		}else{
			my $hashref = {};
			$smess = $imap->message_count();
			unless ($smess == 0) {
				#$imap->Ranges(1);
				$imap->fetch_hash("RFC822.SIZE",$hashref) or die "$@";
				#$imap->Ranges(0);
				#print map {$hashref->{$_}->{"RFC822.SIZE"}, " "} keys %$hashref;
				map {$stot += $hashref->{$_}->{"RFC822.SIZE"}} keys %$hashref;
			}
		}
		printf(" Size: %9s", $stot);
		printf(" Messages: %5s\n", $smess);
		$tot += $stot;
		$tmess += $smess;
	}
	print "Total size: $tot\n";
	print "Total messages: $tmess\n";
	print "Time : ", timenext(), " s\n";
}

if ($foldersizes) {
	foldersizes("From", $from, \@f_folders);
	foldersizes("To  ", $to,   \@t_folders);
}



sub timenext {
	my ($timenow, $timerel);
	# $timebefore is global, beurk !
	$timenow    = time;
	$timerel    = $timenow - $timebefore;
	$timebefore = $timenow;
	return($timerel);
}

exit if ($justfoldersizes);

# needed for setting flags
my $tohasuidplus = $to->has_capability("UIDPLUS");



print 
  "From folders : ", map("[$_] ",@f_folders),"\n",
  "To   folders : ", map("[$_] ",@t_folders),"\n";

print 
  "From subscribed folders : ", map("[$_] ", sort keys(%fs_folders)), "\n";

sub separator_invert {
	# The separator we hope we'll never encounter
	my $o_sep="\000";

	my($f_fold, $f_sep, $t_sep) = @_;

	my $t_fold = $f_fold;
	$t_fold =~ s@\Q$t_sep@$o_sep@g;
	$t_fold =~ s@\Q$f_sep@$t_sep@g;
	$t_fold =~ s@\Q$o_sep@$f_sep@g;
	return($t_fold);
}

FOLDER: foreach my $f_fold (@f_folders) {
	my $t_fold;
	print "From Folder [$f_fold]\n";
	
	my $x_fold = $f_fold;
	# first we remove the prefix
	$x_fold =~ s/^$f_prefix//;
	$debug and print "removed source prefix : [$x_fold]\n";
	$t_fold = separator_invert($x_fold,$f_sep, $t_sep);
	$debug and print "inverted   separators : [$t_fold]\n";
	# Adding the prefix supplied by namespace or the --prefix2 option
	$t_fold = $t_prefix . $t_fold unless($t_fold eq 'INBOX');
	$debug and print "added   target prefix : [$t_fold]\n";

	# Transforming the folder name by the --regextrans2 option(s)
	foreach my $regextrans2 (@regextrans2) {
		$debug and print "eval \$t_fold =~ $regextrans2\n";
		eval("\$t_fold =~ $regextrans2");
	}

	print "To   Folder [$t_fold]\n";

	unless ($from->select($f_fold)) {
		warn 
		"From Folder $f_fold : Could not select ",
		$from->LastError,  "\n";
		$error++;
		next FOLDER;
	}

	unless ($to->exists($t_fold) or $to->select($t_fold)) { 
		print "To   Folder $t_fold does not exist\n";
		print "Creating folder [$t_fold]\n";
		unless ($dry){
			unless ($to->create($t_fold)){
				warn "Couldn't create [$t_fold]",
				$to->LastError,"\n";
				$error++;
				next FOLDER;
			}
		}else{
			next FOLDER;
		}
	}
	
	if ($syncacls) {
	  my $f_hash = $from->getacl($f_fold)
	    or warn "Could not getacl for $f_fold: $@\n";
	  my $t_hash = $to->getacl($t_fold)
	    or warn "Could not getacl for $t_fold: $@\n";
	  my %users = map({ ($_, 1) } (keys(%$f_hash), keys(%$t_hash)));
	  foreach my $user (sort(keys(%users))) {
	    my $acl = $f_hash->{$user} || "none";
	    print "acl $user : [$acl]\n";
	    next if ($f_hash->{$user} && $t_hash->{$user} &&
		$f_hash->{$user} eq $t_hash->{$user});
	    unless ($dry) {
	      print "setting acl $t_fold $user $acl\n";
	      $to->setacl($t_fold, $user, $acl)
		or warn "Could not set acl: $@\n";
	    }
	  }
	}
	
	unless ($to->select($t_fold)) { 
		warn 
		"To   Folder $t_fold : Could not select ",
		$to->LastError, "\n";
		$error++;
		next FOLDER;
	}
	
	if ($expunge){
		print "Expunging $f_fold and $t_fold\n";
		unless($dry) { $from->expunge() };
		#unless($dry) { $to->expunge() };
	}
	
	if ($subscribe and exists $fs_folders{$f_fold}) {
		print "Subscribing to folder $t_fold on destination server\n";
		unless($dry) { $to->subscribe($t_fold) };
	}
	
	next FOLDER if ($justfolders);


	my @f_msgs = select_msgs($from);



	$debug and print "LIST FROM : ", scalar(@f_msgs), " messages [@f_msgs]\n";
	# internal dates on "TO" are after the ones on "FROM"
	# normally...
	my @t_msgs = select_msgs($to);
	
	$debug and print "LIST TO   : ", scalar(@t_msgs), " messages [@t_msgs]\n";

	my %f_hash = ();
	my %t_hash = ();

	print "++++ From [$f_fold] Parse 1 ++++\n";
	
	my $f_heads = $from->parse_headers($from->Range([@f_msgs]),@useheader) 
	  if (@f_msgs) ;
	$debug and print "Time headers: ", timenext(), " s\n";
	my $f_size  = $from->fetch_hash("RFC822.SIZE") if (@f_msgs);
	$debug and print "Time sizes  : ", timenext(), " s\n";
	#my $f_flags = $from->flags(@f_msgs) ;
	#print "Time flags  : ", timenext(), " s\n";
	use Data::Dumper;
	#print Data::Dumper->Dump([$f_heads]);
	#print Data::Dumper->Dump([$f_flags]);
	
	foreach my $m (@f_msgs) {
		parse_header_msg1($from, $m, $f_heads, $f_size, "F", \%f_hash);
	}
	$debug and print "Time headers: ", timenext(), " s\n";
	
	print "++++ To   [$t_fold] Parse 1 ++++\n";
	my $t_heads =   $to->parse_headers($to->Range([@t_msgs]),@useheader) 
	  if (@t_msgs);
	$debug and print "Time headers: ", timenext(), " s\n";
	my $t_size  =   $to->fetch_hash("RFC822.SIZE") if (@t_msgs);
	$debug and print "Time sizes  : ", timenext(), " s\n";
	#my $t_flags =   $to->flags(@t_msgs) ;
	#print "Time flags  : ", timenext(), " s\n";
	
	foreach my $m (@t_msgs) {
		parse_header_msg1($to, $m, $t_heads, $t_size, "T", \%t_hash);
	}
	$debug and print "Time headers: ", timenext(), " s\n";
	#exit;

	print "++++ Verifying [$f_fold] -> [$t_fold] ++++\n";
	# messages in "from" that are not good in "to"
	
	my @f_hash_keys_sorted_by_uid 
	  = sort {$f_hash{$a}{'m'} <=> $f_hash{$b}{'m'}} keys(%f_hash);
	
	#print map { $f_hash{$_}{'m'} . " "} @f_hash_keys_sorted_by_uid;
	
	MESS: foreach my $m_id (@f_hash_keys_sorted_by_uid) {
		my $f_size = $f_hash{$m_id}{'s'};
		my $f_msg = $f_hash{$m_id}{'m'};
		# print ".";
		if (defined $maxsize and $f_size > $maxsize) {
			print "+ Skipping msg #$f_msg:$f_size in folder $f_fold (exceeds maxsize limit $maxsize bytes)\n";
			$mess_size_total_skipped += $f_msg;
			next MESS;
		}
		$debug and print "+ key     $m_id #$f_msg\n";
		unless (exists($t_hash{$m_id})) {
			print "+ NO msg #$f_msg [$m_id] in $t_fold\n";
			# copy
			print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
			my $string = $from->message_string($f_msg);
			foreach my $regexmess (@regexmess) {
				$debug and print "eval \$string =~ $regexmess\n";
				eval("\$string =~ $regexmess");
			}
			$debug and print "F message content begin next line\n",
			  $string,
			    "F message content ended on previous line\n";
			my $d = "";
			if ($syncinternaldates) {
				$d = $from->internaldate($f_msg);
				$d = "\"$d\"";
				$debug and print "internal date from 1: [$d]\n";
			}
			
			my $flags_f_rv = $from->flags($f_msg);
			my @flags_f;
			my $flags_f;
			
			if (ref($flags_f_rv)) {
				@flags_f = @{$flags_f_rv};
				$flags_f = join(" ", @flags_f);
			}else{
				$flags_f = "";	
			}
			
			#$flags_f = join(" ", @{$from->flags($f_msg)});
			
			# RFC 2060 : This flag can not be altered by the client
			$flags_f =~ s@\\Recent@@g;
			
			my $new_id;
			print "flags from : [$flags_f][$d]\n";
			unless ($dry) {
				unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){
					warn "Couldn't append msg #$f_msg (Subject:[".$from->subject($f_msg)."]) to folder $t_fold: ",
					  $to->LastError, "\n";
					$error++;
					$mess_size_total_error += $f_size;
					next MESS;
					
				}else{
						# good
					# $new_id is an id if the IMAP server has the 
					# UIDPLUS capability else just a ref
					print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
					$mess_size_total_trans += $f_size;
					$mess_trans += 1;
				}
			}
			next MESS;
		}else{
			$debug and print "Message id [$m_id] found in t:$t_fold\n";
			$mess_size_total_skipped += $f_size;
			$mess_skipped += 1;
		}
		
		$fast and next MESS;
		#$debug and print "MESSAGE $m_id\n"; 
		my $t_size = $t_hash{$m_id}{'s'};
		my $t_msg  = $t_hash{$m_id}{'m'};
		
		$debug and print "Setting flags\n"; 
		my (@flags_f,@flags_t);
		my $flags_f_rv = $from->flags($f_msg);
		@flags_f = @{$flags_f_rv} if ref($flags_f_rv);
		
		# No flag \Recent here, no ?
		
		$to->store($t_msg,
			   "+FLAGS (" . join(" ", @flags_f) . ")"
			  ) unless ($dry) ;
		
		my $flags_t_rv = $to->flags($t_msg);
		@flags_t = @{$flags_t_rv} if ref($flags_t_rv);
		$debug and print 
		  "flags from : @flags_f\n",
		  "flags to   : @flags_t\n";
		

		$debug and do {
			print "Looking dates\n"; 
			my $d_f = $from->internaldate($f_msg);
			my $d_t = $to->internaldate($t_msg);
			print 
			  "idate from : $d_f\n",
			    "idate to   : $d_t\n";
			#unless ($d_f eq $d_t) {
			#	print "!!! Dates differ !!!\n";
			#}
		};
		unless (($f_size == $t_size) or $skipsize) {
			# Bad size
			print 
			"Message $m_id SZ_BAD  f:$f_msg:$f_size t:$t_msg:$t_size\n";
			# delete in to and recopy ?
			# NO recopy CODE HERE. to be written if needed.
			$error++;
			if ($opt_G){
				print "Deleting msg f:#$t_msg in folder $t_fold\n";
				$to->delete_message($t_msg) unless ($dry);
			}
		}else {
	    		# Good 
			$debug and print
			"Message $m_id SZ_GOOD f:$f_msg:$f_size t:$t_msg:$t_size\n";
			if($delete) {
				print "Deleting msg #$f_msg in folder $f_fold\n";
				$from->delete_message($f_msg) unless ($dry);
				$from->expunge() if ($expunge and not $dry);
			}
		}
	}
	if ($expunge1){
		print "Expunging source folder $f_fold\n";
		unless($dry) { $from->expunge() };
	}
	if ($expunge2){
		print "Expunging target folder $t_fold\n";
		unless($dry) { $to->expunge() };
	}

print "Time : ", timenext(), " s\n";
}
$from->logout();
$to->logout();

$timeend = time();

$timediff = $timeend - $timestart;

stats();

exit(1) if($error);

sub select_msgs {
	my ($imap) = @_;
	my (@msgs,@max,@min,@union,@inter);
	
	unless (defined($maxage) or defined($minage)) {
		@msgs = $imap->search("ALL");
		return(@msgs);
	}
	if (defined($maxage)) {
		@max = $imap->since(time - 86400 * $maxage);
	}
	if (defined($minage)) {
		@min = $imap->before(time - 86400 * $minage);
	}
      SWITCH: {
		unless(defined($minage)) {@msgs = @max; last SWITCH};
		unless(defined($maxage)) {@msgs = @min; last SWITCH};
		my (%union, %inter); 
		foreach my $m (@min, @max) {$union{$m}++ && $inter{$m}++}
		# normal case
		if ($minage <= $maxage)  {@msgs = @inter; last SWITCH};
		# just exclude messages between
		if ($minage > $maxage)  {@msgs = @union; last SWITCH};
		
	}
	return(@msgs);
}


sub stats {
	print "++++ Statistics ++++\n";
	print "Time                   : $timediff sec\n";
	print "Messages transfered    : $mess_trans\n";
	print "Messages skipped       : $mess_skipped\n";
	print "Total bytes transfered : $mess_size_total_trans\n";
	print "Total bytes skipped    : $mess_size_total_skipped\n";
	print "Total bytes error      : $mess_size_total_error\n";
	print "Detected $error errors\n";
	print "Please, rate imapsync at http://freshmeat.net/projects/imapsync/\n";


}


sub get_options
{
	my $numopt = scalar(@ARGV);
        my $opt_ret = GetOptions(
                                   "debug!"       => \$debug,
                                   "debugimap!"   => \$debugimap,
                                   "host1=s"     => \$host1,
                                   "host2=s"     => \$host2,
                                   "port1=i"     => \$port1,
                                   "port2=i"     => \$port2,
                                   "user1=s"     => \$user1,
                                   "user2=s"     => \$user2,
                                   "password1=s" => \$password1,
                                   "password2=s" => \$password2,
                                   "passfile1=s" => \$passfile1,
                                   "passfile2=s" => \$passfile2,
				   "authmd5!"    => \$authmd5,
                                   "sep1=s"      => \$sep1,
                                   "sep2=s"      => \$sep2,
				   "folder=s"    => \@folder,
				   "include=s"   => \$include,
				   "exclude=s"   => \$exclude,
				   "prefix1=s"   => \$prefix1,
				   "prefix2=s"   => \$prefix2,
				   "regextrans2=s" => \@regextrans2,
				   "regexmess=s" => \@regexmess,
                                   "delete!"     => \$delete,
                                   "syncinternaldates!" => \$syncinternaldates,
                                   "syncacls!"   => \$syncacls,
				   "maxsize=i"   => \$maxsize,
				   "maxage=i"    => \$maxage,
				   "minage=i"    => \$minage,
				   "buffersize=i" => \$buffersize,
				   "foldersizes!" => \$foldersizes,
                                   "dry!"        => \$dry,
                                   "expunge!"    => \$expunge,
                                   "expunge1!"    => \$expunge1,
                                   "expunge2!"    => \$expunge2,
                                   "subscribed!" => \$subscribed,
                                   "subscribe!"  => \$subscribe,
                                   "justconnect!"=> \$justconnect,
                                   "justfolders!"=> \$justfolders,
				   "justfoldersizes!" => \$justfoldersizes,
				   "fast!"       => \$fast,
                                   "version"     => \$version,
                                   "help"        => \$help,
                                   "timeout=i"   => \$timeout,
				   "skipheader=s" => \$skipheader,
				   "useheader=s" => \@useheader,
				   "skipsize!"   => \$skipsize,
				   "fastio1!"     => \$fastio1,
				   "fastio2!"     => \$fastio2,
                                  );
	
        $debug and print "get options: [$opt_ret]\n";

	# just the version
        print "$VERSION\n" and exit if ($version) ;

	# exit with --help option or no option at all
        usage() and exit if ($help or ! $numopt) ;

	# don't go on if options are not all known.
        exit(EX_USAGE()) unless ($opt_ret) ;
	
	
}


sub parse_header_msg1 {
	my ($imap, $m_uid, $s_heads, $s_size, $s, $s_hash) = @_;
	
	my $head = $s_heads->{$m_uid};
	my $headnum =  scalar(keys(%$head));
	$debug and print "Head NUM:", $headnum, "\n";
	unless($headnum) { print "Warning : no header used or found \n"; }
	my $headstr;
	
	foreach my $h (sort keys(%$head)){
		foreach my $val (sort @{$head->{$h}}) {
			# no 8-bit data in headers !
			$val =~ s/[\x80-\xff]/X/g;
			# remove the first blanks (dbmail bug ?)
			$val =~ s/^\s+//;
			# show stuff in debug mode
			$debug and print "${s}H $h:", $val, "\n";
			if ($skipheader and $h =~ m/$skipheader/) {
				$debug and print "Skipping header $h\n";
				next;
			}
			$headstr .= "$h:". $val;
		}
	}
	#return unless ($headstr);
	unless ($headstr){
		# no header so taking everything
		$headstr = $imap->message_string($m_uid);
	}
	my $size = $s_size->{$m_uid}->{"RFC822.SIZE"};
	#return unless ($size);
	$size = length($headstr) unless ($size);
	my $m_md5 = md5_base64($headstr);	
	$debug and print "$s msg $m_uid:$m_md5:$size\n";
	my $key;
        if ($skipsize) {
                $key = "$m_md5";
        }else {
                $key = "$m_md5:$size";
        }
	$s_hash->{"$key"}{'5'} = $m_md5;
	$s_hash->{"$key"}{'s'} = $size;
	$s_hash->{"$key"}{'m'} = $m_uid;
}


sub  firstline {
        # extract the first line of a file (without \n)

        my($file) = @_;
        my $line  = "";
        
        open FILE, $file or die("$! $file");
        chomp($line = <FILE>);
        close FILE;
        $line = ($line) ? $line : "!EMPTY! $file";
        return $line;   
}

sub usage {
        print <<EOF;

usage: $0 [options]

Several options are mandatory. 

--host1       <string> : "from" imap server. Mandatory.
--port1       <int>    : port to connect. Default is 143.
--user1       <string> : user to login.   Mandatory.
--password1   <string> : password for the user1. Dangerous, use --passfile1
--passfile1   <string> : password file for the user1. Contains the password.
--host2       <string> : "destination" imap server. Mandatory.
--port2       <int>    : port to connect. Default is 143.
--user2       <string> : user to login.   Mandatory.
--password2   <string> : password for the user2. Dangerous, use --passfile2
--passfile2   <string> : password file for the user2. Contains the password.
--noauthmd5            : don't use MD5 authentification.
--authmd5              : use MD5 authentification.
--folder      <string> : sync only this folder.
--folder      <string> : and this one.
--folder      <string> : and this one, etc.
--include     <regex>  : only sync folders matching this regular expression
                         (only effective if neither --folder nor --subscribed
			  is specified). 
--exclude     <regex>  : skips folders matching this regular expression
                         (only effective if neither --folder nor --subscribed
			  is specified). Several folders to avoid:
			  --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
--prefix1     <string> : remove prefix to all destination folders 
                         (usually INBOX. for cyrus imap servers)
                         use --prefix1 if your source imap server does not
                         have NAMESPACE capability.
--prefix2     <string> : add prefix to all destination folders 
                         (usually INBOX. for cyrus imap servers)
                         use --prefix2 if your target imap server does not
                         have NAMESPACE capability.
--regextrans2 <regex>  : Apply the whole regex to each destination folders.
--regextrans2 <regex>  : and this one. etc.
                         When you play with the --regextrans2 option, first
                         add also the safe options --dry --justfolders
                         Then, when happy, remove --dry, remove --justfolders
--regexmess   <regex>  : Apply the whole regex to each message before transfer.
                         Exemple : 's/\\000/ /g' # to replace null by space.
--regexmess   <regex>  : and this one.
--regexmess   <regex>  : and this one, etc.
--sep1        <string> : separator in case namespace is not supported.
--sep2        <string> : idem.
--delete               : delete messages in source imap server after
                         a successful transfert. Useful in case you
                         want to migrate from one server to another one.
			 With imap, delete tags messages as deleted, they
			 are not really deleted. See expunge.
--expunge              : expunge messages on source account.
                         expunge really deletes messages marked deleted.
                         expunge is made at the begining on the 
                         source server only. newly transfered messages
                         are expunged if option --expunge is given.
                         no expunge is done on destination account but
                         it will change in future releases.
--expunge1             : expunge messages on source account.
--expunge2             : expunge messages on target account.
--syncinternaldates    : sets the internal dates on host2 same as host1
--buffersize  <int>    : sets the size of a block of I/O.
--maxsize     <int>    : skip messages larger than <int> bytes
--maxage      <int>    : skip messages older than <int> days.
                         final stats (skipped) don't count older messages
			 see also --minage
--minage      <int>    : skip messages newer than <int> days.
                         final stats (skipped) don't count newer messages
                         You can do (+ are the messages selected):
                         past|----maxage+++++++++++++++>now
                         past|+++++++++++++++minage---->now
                         past|----maxage+++++minage---->now (intersection)
                         past|++++minage-----maxage++++>now (union)
--skipheader  <regex>  : Don't take into account header keyword 
                         matching <string> ex: --skipheader 'X.*'
--useheader   <string> : Use this header to compare messages on both sides.
                         Ex: Message-ID or Subject or Date.
--useheader   <string>   and this one, etc.
--skipsize             : Don't take message size into account.
--dry                  : do nothing, just print what would be done.
--subscribed           : transfer only subscribed folders.
--subscribe            : subscribe to the folders transfered on the 
                         "destination" server that are subscribed
                         on the "source" server.
--(no)foldersizes      : Calculate the size of each "From" folder in bytes
                         and message counts. Meant to be used with
                         --justfoldersizes. Turned on by default.
--justfoldersizes      : exit after printed the folder sizes.
--syncacls             : Synchronizes acls (Access Control Lists).
--nosyncacls           : Does not synchronize acls. This is the default.
--debug                : debug mode.
--debugimap            : imap debug mode.
--version              : print sotfware version.
--justconnect          : just connect to both servers and print useful
                         information. Need only --host1 and --host2 options.
--justfolders          : just do things about folders (ignore messages).
--fast                 : be faster (does not sync flags).
--nofastio1            : don't use fastio with the "from" server.
--nofastio2            : don't use fastio with the "destination" server.
--timeout     <int>    : imap connect timeout.
--help                 : print this.

Example: to synchronise imap account "foo" on "imap.truc.org"
                     to imap account "bar" on "imap.trac.org"

$0 \\
   --host1 imap.truc.org --user1 foo --passfile1 /etc/secret1 \\
   --host2 imap.trac.org --user2 bar --passfile2 /etc/secret2


 Mail::IMAPClient version is $Mail::IMAPClient::VERSION
$rcs
      imapsync copyleft is the GNU General Public License.
      See http://www.gnu.org/copyleft/gpl.html
EOF
}