From 252d8c82b719cf908c805ddd1a5c8463b11b2066 Mon Sep 17 00:00:00 2001 From: Nick Bebout Date: Sat, 12 Mar 2011 02:44:13 +0000 Subject: [PATCH] 1.125 --- CREDITS | 5 + ChangeLog | 13 +- README | 4 +- VERSION | 2 +- imapsync | 32 +- patches/imapsync-readkey | 1175 ++++++++++++++++++++++++++++++++++++++ 6 files changed, 1215 insertions(+), 16 deletions(-) create mode 100644 patches/imapsync-readkey diff --git a/CREDITS b/CREDITS index c2fe36f..9a74e7a 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,10 @@ #!/bin/cat +Brian Cunnie +Write good French and a patch +to allow password input on command line +if none by options --password nor --passfile + James Eborall Gave "Samsung Contact IMAP server 8.5.0" diff --git a/ChangeLog b/ChangeLog index 1930aed..db85198 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,22 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.124 +head: 1.125 branch: locks: strict - gilles: 1.124 access list: symbolic names: keyword substitution: kv -total revisions: 124; selected revisions: 124 +total revisions: 125; selected revisions: 125 description: ---------------------------- -revision 1.124 locked by: gilles; +revision 1.125 +date: 2005/04/22 01:12:18; author: gilles; state: Exp; lines: +23 -9 +Allow password input on command line +if none by options --password nor --passfile +Thanks to Brian Cunnie for his patch. +---------------------------- +revision 1.124 date: 2005/04/13 11:37:38; author: gilles; state: Exp; lines: +9 -7 Added Samsung Contact success ---------------------------- diff --git a/README b/README index 186912e..269e3f7 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ NAME imapsync - IMAP synchronization, copy or migration tool. Synchronize mailboxes between two imap servers. Good at IMAP migration. - $Revision: 1.124 $ + $Revision: 1.125 $ INSTALL imapsync works fine under any Unix OS. @@ -246,5 +246,5 @@ AUTHOR teaching free open and gratis softwares. Don't hesitate to pay him for that services. - $Id: imapsync,v 1.124 2005/04/13 11:37:38 gilles Exp gilles $ + $Id: imapsync,v 1.125 2005/04/22 01:12:18 gilles Exp $ diff --git a/VERSION b/VERSION index 5db94ba..2fbe148 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.124 +1.125 diff --git a/imapsync b/imapsync index 2b86e81..768f8a8 100755 --- a/imapsync +++ b/imapsync @@ -6,7 +6,7 @@ imapsync - IMAP synchronization, copy or migration tool. Synchronize mailboxes between two imap servers. Good at IMAP migration. -$Revision: 1.124 $ +$Revision: 1.125 $ =head1 INSTALL @@ -288,7 +288,7 @@ 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.124 2005/04/13 11:37:38 gilles Exp gilles $ +$Id: imapsync,v 1.125 2005/04/22 01:12:18 gilles Exp $ =cut @@ -298,6 +298,7 @@ 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' }; @@ -331,7 +332,7 @@ my( use vars qw ($opt_G); # missing code for this will be option. -$rcs = ' $Id: imapsync,v 1.124 2005/04/13 11:37:38 gilles Exp gilles $ '; +$rcs = ' $Id: imapsync,v 1.125 2005/04/22 01:12:18 gilles Exp $ '; $rcs =~ m/,v (\d+\.\d+)/; $VERSION = ($1) ? $1 : "UNKNOWN"; @@ -368,8 +369,8 @@ $error=0; my $banner = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.124 $ ', - '$Date: 2005/04/13 11:37:38 $ ', + '$Revision: 1.125 $ ', + '$Date: 2005/04/22 01:12:18 $ ', "\n", "Mail::IMAPClient version used here is ", $VERSION_IMAPClient, " auth md5 : $md5_supported", @@ -392,14 +393,10 @@ sub missing_option { $host1 || missing_option("--host1") ; $port1 = (defined($port1)) ? $port1 : 143; $user1 || missing_option("--user1"); -$password1 || $passfile1 || missing_option("--passfile1 or --password1"); -$password1 = (defined($passfile1)) ? firstline ($passfile1) : $password1; $host2 || missing_option("--host2") ; $port2 = (defined($port2)) ? $port2 : 143; $user2 || missing_option("--user2"); -$password2 || $passfile2 || missing_option("--passfile2 or --password2"); -$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2; $authmd5 = (defined($authmd5)) ? $authmd5 : 1; @@ -409,6 +406,23 @@ $foldersizes = (defined($foldersizes)) ? $foldersizes : 1; 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 = (); diff --git a/patches/imapsync-readkey b/patches/imapsync-readkey new file mode 100644 index 0000000..d3f7274 --- /dev/null +++ b/patches/imapsync-readkey @@ -0,0 +1,1175 @@ +#!/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.1 $ + +=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 ] + [--user1 ] [--passfile1 ] + [--host2 server2] [--port2 ] + [--user2 ] [--passfile2 ] + [--folder --folder ...] + [--include ] [--exclude ] + [--prefix2 ] + [--sep1 ] + [--sep2 ] + [--syncinternaldates] + [--maxsize ] + [--maxage ] + [--skipheader ] + [--skipsize] + [--delete] [--expunge] + [--subscribed] [--subscribe] + [--foldersizes] + [--dry] + [--debug] [--debugimap] + [--timeout ] + [--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 option, and run imapsync again +with the --expunge option. + +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 EXAMPLES + +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 + +=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: lamiral@linux-france.org + +=head1 IMAP SERVERS + +Success stories reported (softwares in alphabetic order) : + + - BincImap 1.2.3 + - CommunicatePro server (Redhat 8.0) + - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1 + - Critical Path (7.0.020) + - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, + 2.2.1, 2.2.2-BETA, 2.2.10 + - DBMail 1.2.1 + - Dovecot 0.99.10.4 + - Domino (Notes) 6.5, 5.0.6 + - iPlanet Messaging server 4.15, 5.1 + - IMail 7.15 (Ipswitch/Win2003), 8.12 + - MDaemon 7.0.1 + - MS Exchange Server 5.5 + - Netscape Mail Server 3.6 (Wintel !) + - Netscape Messaging Server 4.15 Patch 7 + - OpenWave + - Qualcomm Worldmail (NT) + - 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) + - 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. + +And please rate imapsync at http://freshmeat.net/projects/imapsync/ + +=head1 HUGE MIGRATION + + +Have a special attention on options +--subscribed +--subscribe +--delete +--expunge +--maxage +--maxsize + +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 + + 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.pl,v 1.1 2005/04/12 00:34:19 cunnie Exp cunnie $ + +=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, $prefix2, $regextrans2, @regexmess, + $sep1, $sep2, + $syncinternaldates, $syncacls, + $maxsize, $maxage, + $skipheader, $skipsize, $foldersizes, + $delete, $expunge, $dry, + $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.pl,v 1.1 2005/04/12 00:34:19 cunnie Exp cunnie $ '; +$rcs =~ m/,v (\d+\.\d+)/; +$VERSION = ($1) ? $1 : "UNKNOWN"; + +my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION; + +my $md5_supported = 0; +$md5_supported = md5_supported(); + +$mess_size_total_trans = 0; +$mess_size_total_skipped = 0; +$mess_size_total_error = 0; +$mess_trans = $mess_skipped = 0; + +sub md5_supported { + + + # before 2.2.6 no md5 native + # 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 >=6); + return(0) if($sub <=5); + }else{ + return 0; # don't match regex => bad + } +} + +$error=0; + +my $banner = join("", + '$RCSfile: imapsync.pl,v $ ', + '$Revision: 1.1 $ ', + '$Date: 2005/04/12 00:34:19 $ ', + "\n", + "Mail::IMAPClient version used here is ", + $VERSION_IMAPClient, " auth md5 : $md5_supported", + "\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; +$user1 || missing_option("--user1"); + +$host2 || missing_option("--host2") ; +$port2 = (defined($port2)) ? $port2 : 143; +$user2 || missing_option("--user2"); + +$authmd5 = (defined($authmd5)) ? $authmd5 : 1; + +$syncacls = (defined($syncacls)) ? $syncacls : 1; +$foldersizes = (defined($foldersizes)) ? $foldersizes : 1; + +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"; + +unless ($md5_supported) { + print "Auth $authmech not supported by IMAPClient $VERSION_IMAPClient\n"; + }else{ + print "Auth $authmech supported by IMAPClient $VERSION_IMAPClient\n"; + } + +$timestart = time(); +$timebefore = $timestart; + +$debugimap and print "From connection\n"; +$from = login_imap($host1, $port1, $user1, $password1, $debugimap, $timeout); + +$debugimap and print "To connection\n"; +$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout); + +sub login_imap { + my($host, $port, $user, $password, + $debugimap, $timeout, $authmech) = @_; + my $imap = Mail::IMAPClient->new(); + $imap->Server($host); + $imap->Port($port); + $imap->Fast_io(1); + $imap->Buffer(65536); + $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 ($md5_supported) { + return; + } + 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"); + +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 : [$f_sep]\n"; +print "To separator : [$t_sep]\n"; + +if ($foldersizes) { + my $tot = 0; + my $tmess = 0; + print "++++ Calculating sizes ++++\n"; + foreach my $f_fold (@f_folders) { + my $stot = 0; + my $smess = 0; + printf("From Folder %-25s", "[$f_fold]"); + unless ($from->select($f_fold)) { + warn + "From Folder $f_fold : Could not select ", + $from->LastError, "\n"; + $error++; + next; + } + if ($maxage) { + # The pb is fetch_hash() can only be applied on ALL messages + + my @f_msgs = $from->since(time - 86400 * $maxage); + my $smess = scalar(@f_msgs); + foreach my $m (@f_msgs) { + my $s = $from->size($m) + or warn "Could not find size of message $m: $@\n"; + $stot += $s; + } + }else{ + my $hashref = {}; + $smess = $from->message_count(); + unless ($smess == 0) { + $from->fetch_hash("RFC822.SIZE",$hashref); + #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"; + +} + +sub timenext { + my ($timenow, $timerel); + # $timebefore is global, beurk ! + $timenow = time; + $timerel = $timenow - $timebefore; + $timebefore = $timenow; + return($timerel); +} + +exit if ($justconnect); + +# 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"; + + $t_fold = separator_invert($f_fold,$f_sep, $t_sep); + + # Adding the prefix supplied by the --prefix2 option + $t_fold = $prefix2 . $t_fold if ($prefix2); + + # Transforming the folder name by the --regextrans2 option + if ($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; + } + } + + 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) }; + } + + if ($syncacls) { + my $hash = $from->getacl($f_fold) + or warn "Could not getacl for $f_fold: $@\n"; + foreach my $user (keys(%$hash)) { + my $acl = $hash->{$user}; + print "acl $user : " . $acl . "\n"; + unless ($dry) { + print "setting acl $t_fold $user $acl\n"; + $to->setacl($t_fold, $user, $acl) + or warn "Could not set acl: $@\n"; + } + } + } + + next FOLDER if ($justfolders); + + my @f_msgs = $maxage ? $from->since(time - 86400 * $maxage) : $from->search("ALL"); + $debug and print "LIST FROM : @f_msgs\n"; + # internal dates on "TO" are after the ones on "FROM" + # normally... + my @t_msgs = $maxage ? $to->since(time - 86400 * $maxage) : $to->search("ALL"); + $debug and print "LIST TO : @t_msgs\n"; + + my %f_hash = (); + my %t_hash = (); + + # No history + $from->Clear(1); + $to->Clear(1); + + + print "From Buffer I/O : ", $from->Buffer(), "\n"; + print "To Buffer I/O : ", $to->Buffer(), "\n"; +# $from->Buffer(4096*64); +# $to->Buffer(4096*64); +# print "From Buffer I/O : ", $from->Buffer(), "\n"; +# print "To Buffer I/O : ", $to->Buffer(), "\n"; + + print "++++ From Parse 1 ++++\n"; + + my $f_heads = $from->parse_headers([@f_msgs],"ALL") if (@f_msgs) ; + print "Time headers: ", timenext(), " s\n"; + my $f_size = $from->fetch_hash("RFC822.SIZE") if (@f_msgs); + 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]); + + #exit; + foreach my $m (@f_msgs) { + parse_header_msg1($m, $f_heads, $f_size, "F", \%f_hash); + } + print "Time headers: ", timenext(), " s\n"; + + print "\n++++ To Parse 1 ++++\n"; + my $t_heads = $to->parse_headers([@t_msgs],"ALL") if (@t_msgs); + print "Time headers: ", timenext(), " s\n"; + my $t_size = $to->fetch_hash("RFC822.SIZE") if (@t_msgs); + 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($m, $t_heads, $t_size, "T", \%t_hash); + } + print "Time headers: ", timenext(), " s\n"; + #exit; + + print "\n++++ Verifying ++++\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); + while (my $regexmess = shift(@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) { + # 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); + } + } + } +print "Time : ", timenext(), " s\n"; +} + +$timeend = time(); + +$timediff = $timeend - $timestart; + +stats(); + +exit(1) if($error); + +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, + "prefix2=s" => \$prefix2, + "regextrans2=s" => \$regextrans2, + "regexmess=s" => \@regexmess, + "delete!" => \$delete, + "syncinternaldates!" => \$syncinternaldates, + "syncacls!" => \$syncacls, + "maxsize=i" => \$maxsize, + "maxage=i" => \$maxage, + "foldersizes!" => \$foldersizes, + "dry!" => \$dry, + "expunge!" => \$expunge, + "subscribed!" => \$subscribed, + "subscribe!" => \$subscribe, + "justconnect!"=> \$justconnect, + "justfolders!"=> \$justfolders, + "fast!" => \$fast, + "version" => \$version, + "help" => \$help, + "timeout=i" => \$timeout, + "skipheader=s" => \$skipheader, + "skipsize!" => \$skipsize, + ); + + $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 ($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"; + return unless($headnum); + 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); + my $size = $s_size->{$m_uid}->{"RFC822.SIZE"}; + return unless ($size); + my $m_md5 = md5_base64($headstr); + + $debug and print "$s msg $m_uid:$m_md5:$size\n"; + $size = 0 if ($skipsize); + $s_hash->{"$m_md5:$size"}{'5'} = "$m_md5:$size"; + $s_hash->{"$m_md5:$size"}{'s'} = $size; + $s_hash->{"$m_md5:$size"}{'m'} = $m_uid; +} + +sub parse_header_msg { + + my ($m, $imap, $s, $s_hash) = @_; + $debug and print "-" x 50, "\nMSG $m\n"; + my $head = $imap->parse_headers($m,"ALL"); + my $headstr; + $debug and print "Head NUM:", scalar(keys(%$head)), "\n"; + # no header -> return + return unless(scalar(keys(%$head))); + 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; + } + } + my $m_md5 = md5_base64($headstr); + my $size = $imap->size($m); + $debug and print "$s msg $m:$m_md5:$size\n"; + $size = 0 if ($skipsize); + $s_hash->{"$m_md5:$size"}{'5'} = "$m_md5:$size"; + $s_hash->{"$m_md5:$size"}{'s'} = $size; + $s_hash->{"$m_md5:$size"}{'m'} = $m; +} + +sub firstline { + # extract the first line of a file (without \n) + + my($file) = @_; + my $line = ""; + + open FILE, $file or die("$! $file"); + chomp($line = ); + close FILE; + $line = ($line) ? $line : "!EMPTY! $file"; + return $line; +} + +sub usage { + print < : "from" imap server. Mandatory. +--port1 : port to connect. Default is 143. +--user1 : user to login. Mandatory. +--password1 : password for the user1. Dangerous, use --passfile1 +--passfile1 : password file for the user1. Contains the password. +--host2 : "destination" imap server. Mandatory. +--port2 : port to connect. Default is 143. +--user2 : user to login. Mandatory. +--password2 : password for the user2. Dangerous, use --passfile2 +--passfile2 : password file for the user2. Contains the password. +--noauthmd5 : don't use MD5 authentification +--folder : sync only this folder. +--folder : and this one. +--folder : and this one, etc. +--include : only sync folders matching this regular expression + (only effective if neither --folder nor --subscribed + is specified) +--exclude : skip folders matching this regular expression + (only effective if neither --folder nor --subscribed + is specified) +--prefix2 : add prefix to all destination folders + (usually INBOX. for cyrus imap servers) +--regextrans2 : Apply the whole regex to each destination folders. +--regexmess : Apply the whole regex to each message before transfer. + Exemple : 's/\\000/ /g' # to replace null by space. +--regexmess : and this one. +--regexmess : and this one, etc. +--sep1 : separator in case namespace is not supported. +--sep2 : 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. +--syncinternaldates : set the internal dates on host2 same as host1 +--maxsize : skip messages larger than bytes +--maxage : skip messages older than days. + final stats (skipped) don't count older messages +--skipheader : Don't take into account header keyword + matching ex: --skipheader 'X.*' +--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 + --justconnect. Turned on by default. +--nosyncacls : Don't synchronizes acls. +--debug : debug mode. +--debugimap : imap debug mode. +--version : print sotfware version. +--justconnect : just connect to both servers and print useful + information. +--justfolders : just do things about folders (ignore messages). +--fast : be faster. +--timeout : 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.troc.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 +}