diff --git a/CREDITS b/CREDITS index 814817d..85a22b2 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.171 2012/10/01 08:58:58 gilles Exp gilles $ +# $Id: CREDITS,v 1.172 2013/01/29 09:31:00 gilles Exp gilles $ If you want to make a donation to the author, Gilles LAMIRAL, use any of the following ways: @@ -30,6 +30,9 @@ I thank very much all of these people. I thank also very much all people who bought imapsync from the homepage but I don't cite them here. +Marc Weber +Suggested --mark-as-deleted1 --mark-as-deleted2 + Jeff Verheyen Contributed by giving an 32GB microSDHC card and the book 29.69 "Design by Nature: Using Universal Forms and Principles in Design" diff --git a/ChangeLog b/ChangeLog index e261924..a27da4b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,49 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.518 +head: 1.525 branch: locks: strict - gilles: 1.518 + gilles: 1.525 access list: symbolic names: keyword substitution: kv -total revisions: 518; selected revisions: 518 +total revisions: 525; selected revisions: 525 description: ---------------------------- -revision 1.518 locked by: gilles; +revision 1.525 locked by: gilles; +date: 2013/02/05 12:52:10; author: gilles; state: Exp; lines: +9 -9 +Typo synchronise -> synchronize. +---------------------------- +revision 1.524 +date: 2013/01/31 20:41:29; author: gilles; state: Exp; lines: +8 -7 +Small fix in help message. +\\D +---------------------------- +revision 1.523 +date: 2013/01/31 14:12:21; author: gilles; state: Exp; lines: +118 -99 +Reorganized the --help message. +---------------------------- +revision 1.522 +date: 2013/01/28 02:50:49; author: gilles; state: Exp; lines: +13 -13 +Printing info with several host1 folder going to one host2 folder is in --debug mode now. +---------------------------- +revision 1.521 +date: 2013/01/23 07:48:01; author: gilles; state: Exp; lines: +7 -7 +Speed. --nocheckmessageexists is activated by default since --checkmessageexists often slow down transfers too much. +---------------------------- +revision 1.520 +date: 2013/01/23 07:41:48; author: gilles; state: Exp; lines: +103 -30 +Fix. Removed reference to DWTFPL since license is NOLIMIT now. +License file is LICENSE now, no longer COPYING. +Fix. Handle the case where several folders on host2 go to one folder on host1 with --delete2 option. + The bug was imapsync was copying messages and deleting them on next folder. +---------------------------- +revision 1.519 +date: 2012/12/31 09:51:40; author: gilles; state: Exp; lines: +11 -9 +Usability fix. --foldersizesatend is on if --foldersizes is on. Off if --nofoldersizesatend +---------------------------- +revision 1.518 date: 2012/12/24 00:27:34; author: gilles; state: Exp; lines: +9 -6 Bugfix. When identtifying with header, change tabulations to spaces (Gmail bug on with "Received:" on multilines). ---------------------------- diff --git a/FAQ b/FAQ index d9aac5c..55a0798 100644 --- a/FAQ +++ b/FAQ @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ,v 1.120 2012/12/15 00:05:42 gilles Exp gilles $ +# $Id: FAQ,v 1.124 2013/02/05 18:40:50 gilles Exp gilles $ +------------------+ | FAQ for imapsync | @@ -177,7 +177,20 @@ R. By using --useuid imapsync avoid getting messages headers and build R. Add also --nofoldersizes since the default behavior is to compute folder sizes. Folder sizes are useless for the transfer, just - useful to see what has to be done on each folder. + useful to see what has to be done on each folder and guess when + the transfer will end (ETA). + +R. Add also --nocheckmessageexists + Since transfer can be long on a huge mailbox imapsync checks + a message exist before copying it, but it takes time and + cpu on the host1 server. + --nocheckmessageexists is on by default since release 1.520 + +R. Add also --noexpungeaftereach if you use --delete but be warn + that an interrupted transfer can loose messages on host2 in a + second run if you use a combination like + + imapsync ... --delete --noexpunge --noexpungeaftereach --expunge2 Notes about --useuid @@ -250,7 +263,7 @@ R2. Use --useuid then imapsync will avoid dealing with headers. imapsync ... --useuid ======================================================================= -Q. How can I try imapsync with the new Mail::IMAPClient 3.xx perl library? +Q. How can I try imapsync with Mail::IMAPClient 3.xx perl module? R. - Download latest Mail::IMAPClient 3.xx at http://search.cpan.org/dist/Mail-IMAPClient/ @@ -299,8 +312,8 @@ You can migrate emails from pop server to imap server with pop2imap: http://www.linux-france.org/prj/pop2imap/ R2. Yes -Many pop3 servers runs in parallel with an imap server on the -exactly the same mailboxes. They serve the same INBOX +Many pop3 servers runs in parallel with an imap server on exactly +the same mailboxes. They serve the same INBOX (imap serves INBOX and several other folders, pop3 serves only INBOX) So have a try with imapsync on the same host1. @@ -321,7 +334,7 @@ designed for this issue, and faster than imapsync. ======================================================================= Q. We have found that the sent time and date have been changed to the - time at which the file was synchronised. + time at which the file was synchronized. R. This is the case with: - Eudora @@ -367,9 +380,9 @@ Q. imapsync calculates 479 messages in a folder but only transfers 400 R1. Unless --useuid is used, imapsync considers a header part of a message to identify a message on both sides. - The header part is whole header with "--useheader ALL" or - only specific lines depending on --useheader --skipheader - or default values. + By default the header part used is lines "Message-Id:" "Message-ID:" + and "Received:" or specific lines depending on --useheader + --skipheader. Whole header can be set by --useheader ALL Consequences: @@ -466,12 +479,12 @@ R. It depends on the destination server. a) If the destination server honors the "PERMAENTFLAGS \*" directive (meaning it accepts any flag) or no PERMAENTFLAGS at all -then imapsync synchronises all flags except the \Recent flag +then imapsync synchronizes all flags except the \Recent flag (RFC 3501 says about \Recent flag "This flag can not be altered by the client."). b) If the destination server honors the "PERMAENTFLAGS without the -special "\*" then imapsync synchronises only the flags listed +special "\*" then imapsync synchronizes only the flags listed in PERMANENTFLAGS. Some imap servers have problems with flags not beginning with @@ -479,6 +492,156 @@ the backslash character \ (see next question to find a solution to this issue) +======================================================================= +Q. Is there a way to only sync messages with a specific flag set, +for example, the \Seen flag? + +R. use --search + + imapsync ... --search SEEN + +or + + imapsync ... --search UNSEEN + +or ... + +The complete list of search things are listed below + +http://www.faqs.org/rfcs/rfc3501.html + +6.4.4. SEARCH Command +... + ALL + All messages in the mailbox; the default initial key for + ANDing. + + ANSWERED + Messages with the \Answered flag set. + + BCC + Messages that contain the specified string in the envelope + structure's BCC field. + + BEFORE + Messages whose internal date (disregarding time and timezone) + is earlier than the specified date. + + BODY + Messages that contain the specified string in the body of the + message. + + CC + Messages that contain the specified string in the envelope + structure's CC field. + + DELETED + Messages with the \Deleted flag set. + + DRAFT + Messages with the \Draft flag set. + + FLAGGED + Messages with the \Flagged flag set. + + FROM + Messages that contain the specified string in the envelope + structure's FROM field. + + HEADER + Messages that have a header with the specified field-name (as + defined in [RFC-2822]) and that contains the specified string + in the text of the header (what comes after the colon). If the + string to search is zero-length, this matches all messages that + have a header line with the specified field-name regardless of + the contents. + + KEYWORD + Messages with the specified keyword flag set. + + LARGER + Messages with an [RFC-2822] size larger than the specified + number of octets. + + NEW + Messages that have the \Recent flag set but not the \Seen flag. + This is functionally equivalent to "(RECENT UNSEEN)". + + NOT + Messages that do not match the specified search key. + + OLD + Messages that do not have the \Recent flag set. This is + functionally equivalent to "NOT RECENT" (as opposed to "NOT + NEW"). + + ON + Messages whose internal date (disregarding time and timezone) + is within the specified date. + + OR + Messages that match either search key. + + RECENT + Messages that have the \Recent flag set. + + SEEN + Messages that have the \Seen flag set. + + SENTBEFORE + Messages whose [RFC-2822] Date: header (disregarding time and + timezone) is earlier than the specified date. + + SENTON + Messages whose [RFC-2822] Date: header (disregarding time and + timezone) is within the specified date. + + SENTSINCE + Messages whose [RFC-2822] Date: header (disregarding time and + timezone) is within or later than the specified date. + + SINCE + Messages whose internal date (disregarding time and timezone) + is within or later than the specified date. + + SMALLER + Messages with an [RFC-2822] size smaller than the specified + number of octets. + + SUBJECT + Messages that contain the specified string in the envelope + structure's SUBJECT field. + + TEXT + Messages that contain the specified string in the header or + body of the message. + + TO + Messages that contain the specified string in the envelope + structure's TO field. + + UID + Messages with unique identifiers corresponding to the specified + unique identifier set. Sequence set ranges are permitted. + + UNANSWERED + Messages that do not have the \Answered flag set. + + UNDELETED + Messages that do not have the \Deleted flag set. + + UNDRAFT + Messages that do not have the \Draft flag set. + + UNFLAGGED + Messages that do not have the \Flagged flag set. + + UNKEYWORD + Messages that do not have the specified keyword flag set. + + UNSEEN + Messages that do not have the \Seen flag set. + ======================================================================= Q. How to convert flags? @@ -743,6 +906,7 @@ output line : From folders list : [INBOX] [public.dreams] [etc.] + ====================================================================== Q. I want to exclude only INBOX @@ -754,6 +918,18 @@ A good way to see what will be done is to first use: imapsync ... --exclude "^INBOX$" --justfolders --nofoldersizes --dry +====================================================================== +Q. I want to exclude folders matching SPAM no matter the case, + aka how to be case insensitive + +R. Use: + + imapsync ... --exclude "(?i)spam" + +A good way to see what will be done is to first use: + + imapsync ... --exclude "(?i)spam" --justfolders --nofoldersizes --dry + ====================================================================== Q. I want the --folder "MyFolder" option be recursive. @@ -816,7 +992,6 @@ In case you are not aware: omitted in our case - Use --debugimap when testing initial connectivity, if necessary - ====================================================================== Q. How to migrate from or to Exchange 2007/2010 with an admin/authuser account? @@ -876,9 +1051,11 @@ R. Use ====================================================================== Q. How to migrate from cyrus with an admin account? -R. Use ---authuser1 admin_user ----password1 admin_user_password \ - --user1 foo_user --ssl1 +R. Use: + + imapsync ... \ + --authuser1 admin_user ----password1 admin_user_password \ + --user1 foo_user --ssl1 In this case, --authmech1 PLAIN will be used by default since it is the only way to go for now. So don't use --authmech1 SOMETHING diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4dde4a0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,15 @@ + NO LIMIT PUBLIC LICENSE + Version 0, June 2012 + +Gilles LAMIRAL +La Billais +35580 Baulon +France + + NO LIMIT PUBLIC LICENSE +Terms and conditions for copying, distribution, modification +or anything else. + + 0 No limit to do anything with this work and this license. + 1 GOTO 0 + diff --git a/Makefile b/Makefile index 341d282..192a156 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.113 2012/12/24 02:24:40 gilles Exp gilles $ +# $Id: Makefile,v 1.114 2013/01/29 00:26:51 gilles Exp gilles $ .PHONY: help usage all @@ -116,9 +116,9 @@ testv3: imapsync tests.sh CMD_PERL='perl -I./$(IMAPClient_3xx)' /usr/bin/time sh tests.sh touch .test_3xx -testv: testv2 testv3 +testv: testv3 -test: .test_229 .test_3xx +test: .test_3xx tests: test @@ -277,7 +277,7 @@ ksa: publish: upload_ks ksa ml -PUBLIC_FILES = ./ChangeLog ./COPYING ./CREDITS ./FAQ \ +PUBLIC_FILES = ./ChangeLog ./COPYING ./LICENSE ./CREDITS ./FAQ \ ./index.shtml ./INSTALL \ ./VERSION ./VERSION_EXE \ ./README ./TODO @@ -318,10 +318,10 @@ upload_lfo: /home/gilles/public_html/www.linux-france.org/html/prj/imapsync/.htaccess sh ~/memo/lfo-rsync -upload_index: FAQ COPYING CREDITS W/*.bat examples/*.bat examples/sync_loop_unix.sh index.shtml - rcsdiff index.shtml FAQ COPYING CREDITS W/*.bat examples/*.bat index.shtml +upload_index: FAQ LICENSE CREDITS W/*.bat examples/*.bat examples/sync_loop_unix.sh index.shtml + rcsdiff index.shtml FAQ LICENSE CREDITS W/*.bat examples/*.bat index.shtml validate --verbose index.shtml - rsync -avH index.shtml FAQ COPYING CREDITS root@ks.lamiral.info:/var/www/imapsync/ + rsync -avH index.shtml FAQ COPYING LICENSE CREDITS root@ks.lamiral.info:/var/www/imapsync/ rsync -avH W/*.bat root@ks.lamiral.info:/var/www/imapsync/W/ rsync -avH examples/*.bat examples/sync_loop_unix.sh root@ks.lamiral.info:/var/www/imapsync/examples/ diff --git a/README b/README index 2707002..ee0fb99 100644 --- a/README +++ b/README @@ -3,10 +3,10 @@ NAME Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 44 different IMAP server softwares supported with success. - $Revision: 1.518 $ + $Revision: 1.525 $ SYNOPSIS - To synchronise imap account "foo" on "imap.truc.org" to imap account + To synchronize imap account "foo" on "imap.truc.org" to imap account "bar" on "imap.trac.org" with foo password "secret1" and bar password "secret2": @@ -114,14 +114,17 @@ DESCRIPTION later, imapsync works well with bad connections. You can decide to delete the messages from the source mailbox after a - successful transfer (it is a good feature when migrating). In that case, - use the --delete option. Option --delete implies also option --expunge - so all messages marked deleted on host1 will be really deleted. (you can - use --noexpunge to avoid this but I don't see any real world scenario + successful transfer, it can be a good feature when migrating live + mailboxes since messages will be only one side. In that case, use the + --delete option. Option --delete implies also option --expunge so all + messages marked deleted on host1 will be really deleted. (you can use + --noexpunge to avoid this but I don't see any good real world scenario for the combinaison --delete --noexpunge). - 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 (--delete2 may help) + You can also just synchronize a mailbox B from another mailbox A in case + you just want to keep a "live" copy of A in B. In that case --delete2 + can be used, it deletes messages in host2 folder B that are not in host1 + folder A. imapsync is not adequate for maintaining two active imap accounts in synchronization where the user plays independently on both sides. Use @@ -194,10 +197,10 @@ EXIT STATUS done LICENSE - imapsync is free, open source but not always gratis software cover by - the No Limit Public License (NLPL). See COPYING - file included in the distribution or the web site - http://imapsync.lamiral.info/COPYING + imapsync is free, open, public but not always gratis software cover by + the NOLIMIT Public License. See the LICENSE file included in the + distribution or just read this: No limit to do anything with this work + and this license. MAILING-LIST The public mailing-list may be the best way to get support. @@ -356,7 +359,7 @@ IMAP SERVERS - Rockliffe Mailsite 5.3.11, 4.5.6 - Samsung Contact IMAP server 8.5.0 - Scalix v10.1, 10.0.1.3, 11.0.0.431, 11.4.6 - - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1]. + - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1], SmarterMail Professional 10.2 [host1]. - Softalk Workgroup Mail 7.6.4 [host1]. - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) - Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 @@ -385,8 +388,8 @@ IMAP SERVERS HUGE MIGRATION Pay special attention to options --subscribed --subscribe --delete - --delete2 --delete2folders --expunge --expunge1 --expunge2 --uidexpunge2 - --maxage --minage --maxsize --useheader --fast --useuid --usecache + --delete2 --delete2folders --maxage --minage --maxsize --useuid + --usecache If you have many mailboxes to migrate think about a little shell program. Write a file called file.txt (for example) containing users and @@ -418,7 +421,7 @@ HUGE MIGRATION Welcome in shell programming ! Hacking - Feel free to hack imapsync as the NLPL Licence permits it. + Feel free to hack imapsync as the NOLIMIT license permits it. Links Entries for imapsync: http://www.imap.org/products/showall.php @@ -442,5 +445,5 @@ SIMILAR SOFTWARES Feedback (good or bad) will often be welcome. - $Id: imapsync,v 1.518 2012/12/24 00:27:34 gilles Exp gilles $ + $Id: imapsync,v 1.525 2013/02/05 12:52:10 gilles Exp gilles $ diff --git a/TODO b/TODO index 85b29a3..772443c 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: TODO,v 1.114 2012/11/02 22:19:14 gilles Exp gilles $ +# $Id: TODO,v 1.118 2013/02/08 06:28:40 gilles Exp gilles $ TODO file for imapsync ---------------------- @@ -11,6 +11,8 @@ Add a best practice migration tips document. Write a Mail::imapsync package and use it. +Remove 2.2.9 Mail::IMAPClient support. + Fix the mailing-list archive bug with From at the beginning of a line http://www.linux-france.org/prj/imapsync_list/msg00307.html @@ -21,6 +23,17 @@ http://www.yippiemove.com/ http://www.migrationwiz.com/ http://www.microsoft.com/download/en/details.aspx?id=1329 "Microsoft Transporter Suite" +Add --delete1 as an alias for --delete +Add --mark-as-deleted1 --mark-as-deleted2 as +aliases for --noexpunge1 --delete1 and --noexpunge2 --delete2 + +Move --help documentation into the man page so that description is easier to find. + +Feature request for ImapSync. +Can you setup an option to make it stop if the destination mailbox reports that it is over quota? + +Print the list of messages not copied and why (duplicates or void header) + Fix bug found by Pavel Stano on 01/06/2012 (june) imapsync never stop login when login fails with a "* BYE Temp error" from server. diff --git a/VERSION b/VERSION index 449bde6..6e43d5b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.518 +1.525 diff --git a/VERSION_EXE b/VERSION_EXE index 449bde6..6e43d5b 100644 --- a/VERSION_EXE +++ b/VERSION_EXE @@ -1 +1 @@ -1.518 +1.525 diff --git a/W/.BUILD_EXE_TIME b/W/.BUILD_EXE_TIME index afd3a5f..eec9dda 100644 --- a/W/.BUILD_EXE_TIME +++ b/W/.BUILD_EXE_TIME @@ -164,3 +164,11 @@ 1356315575 END 1.518 : lundi 24 décembre 2012, 03:19:35 (UTC+0100) 1356340377 BEGIN 1.518 : lundi 24 décembre 2012, 10:12:57 (UTC+0100) 1356341221 END 1.518 : lundi 24 décembre 2012, 10:27:01 (UTC+0100) +1359077003 BEGIN 1.521 : vendredi 25 janvier 2013, 02:23:23 (UTC+0100) +1359077793 END 1.521 : vendredi 25 janvier 2013, 02:36:33 (UTC+0100) +1359419422 BEGIN 1.522 : mardi 29 janvier 2013, 01:30:22 (UTC+0100) +1359420274 END 1.522 : mardi 29 janvier 2013, 01:44:34 (UTC+0100) +1359421115 BEGIN 1.522 : mardi 29 janvier 2013, 01:58:35 (UTC+0100) +1359421989 END 1.522 : mardi 29 janvier 2013, 02:13:09 (UTC+0100) +1360108747 BEGIN 1.525 : mercredi 6 février 2013, 00:59:07 (UTC+0100) +1360109581 END 1.525 : mercredi 6 février 2013, 01:13:01 (UTC+0100) diff --git a/W/learn/dbfile b/W/learn/dbfile new file mode 100755 index 0000000..d8bbc1b --- /dev/null +++ b/W/learn/dbfile @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +# $Id: dbfile,v 1.1 2013/01/02 16:33:19 gilles Exp gilles $ + +use strict ; +use warnings ; + +use DB_File ; + +my %hash ; + +my $X = tie %hash, 'DB_File', 'test_dbfile.db' ; + + +print ( scalar keys %hash, "\n" ) ; +exit ; + +for my $num ( 0 .. 255 ) { + print "$num\n" ; + + my $key = chr $num ; + for my $num2 ( 1 .. 500 ) { + my $keylong = "$num2 $key" . ( $key x 1024 ) ; + my $val_1 = "V$key" ; + #print "$keylong\n" ; + my $val_2 ; + my $status ; + $status = $X->put( $keylong, $val_1 ) ; + $status = $X->get( $keylong, $val_2 ) ; + + my $cmp = $val_1 cmp $val_2 ; + print " $cmp $val_1 $val_2\n" if $cmp ; + #$status = $X->del( $keylong ) ; + } +} + diff --git a/W/learn/dbmdeep b/W/learn/dbmdeep new file mode 100755 index 0000000..112db0c --- /dev/null +++ b/W/learn/dbmdeep @@ -0,0 +1,39 @@ +#!/usr/bin/perl + +# $Id: dbfile,v 1.1 2013/01/02 16:33:19 gilles Exp gilles $ + +use strict ; +use warnings ; + +use DBM::Deep ; + +my %hash ; + +my $db = DBM::Deep->new( + file => "test_dbmdeep.db", + locking => 0, + autoflush => 0 +); + +print ( scalar keys %$db, "\n" ) ; +#exit ; + +for my $num ( 0 .. 255 ) { + print "$num\n" ; + + my $key = chr $num ; + for my $num2 ( 1 .. 500 ) { + my $keylong = "$num2 $key" . ( $key x 1024 ) ; + my $val_1 = "V$key" ; + #print "$keylong\n" ; + my $val_2 ; + + $db->{ $keylong } = $val_1 ; + $val_2 = $db->{ $keylong } ; + + my $cmp = $val_1 cmp $val_2 ; + print " $cmp $val_1 $val_2\n" if $cmp ; + #$db->delete( $keylong ) ; + } +} + diff --git a/W/learn/test_dbmdeep.db b/W/learn/test_dbmdeep.db new file mode 100644 index 0000000..86e5ab3 Binary files /dev/null and b/W/learn/test_dbmdeep.db differ diff --git a/W/ml_announce.in b/W/ml_announce.in index 6392d6f..a81ac14 100644 --- a/W/ml_announce.in +++ b/W/ml_announce.in @@ -1,4 +1,4 @@ -m4_dnl $Id: ml_announce.in,v 1.4 2012/11/03 01:38:45 gilles Exp gilles $ +m4_dnl $Id: ml_announce.in,v 1.6 2012/12/24 10:35:38 gilles Exp gilles $ m4_dnl m4_define(`M4_imapsync_VERSION',m4_esyscmd(cat VERSION|tr -d '\n'))m4_dnl m4_define(`M4_SECRET_PATH',m4_esyscmd(cat dist/path_last.txt|tr -d '\n'))m4_dnl @@ -10,8 +10,6 @@ To: imapsync_update@lists.lamiral.info Hello imapsync user, -Sorry for the previous link given, it was the one of release 1.508 - You're subscribed to the newsletter announcing imapsync new releases (very few traffic) and the way to get them. Send me a note if you don't want to receive those announces anymore. diff --git a/W/patches/imapsync-xgwtrustedapp b/W/patches/imapsync-xgwtrustedapp new file mode 100644 index 0000000..c85a5ad --- /dev/null +++ b/W/patches/imapsync-xgwtrustedapp @@ -0,0 +1,6033 @@ +#!/usr/bin/perl + +# structure +# pod documentation +# pragmas +# main program +# global variables initialisation +# default values +# folder loop +# subroutines +# IMAPClient 2.2.9 overrides +# IMAPClient 2.2.9 3.xx ads + +=pod + +=head1 NAME + +imapsync - IMAP synchronisation, sync, copy or migration tool. +Synchronise mailboxes between two imap servers. +Good at IMAP migration. More than 44 different IMAP server softwares +supported with success. + +$Revision: 1.516 $ + +=head1 SYNOPSIS + +To synchronise imap account "foo" on "imap.truc.org" + to imap account "bar" on "imap.trac.org" + with foo password "secret1" + and bar password "secret2": + + imapsync \ + --host1 imap.truc.org --user1 foo --password1 secret1 \ + --host2 imap.trac.org --user2 bar --password2 secret2 + +=head1 INSTALL + + imapsync works fine under any Unix OS with perl. + imapsync works fine under Windows (2000, XP) + with Strawberry Perl 5.10 or 5.12 + or as a standalone binary software imapsync.exe + +imapsync can be available directly on the following distributions: +FreeBSD, Debian, Ubuntu, Gentoo, Fedora, +NetBSD, Darwin, Mandriva and OpenBSD. + + Purchase latest imapsync at + http://imapsync.lamiral.info/ + + You'll receive a link to a compressed tarball called imapsync-x.xx.tgz + where x.xx is the version number. Untar the tarball where + you want (on Unix): + + tar xzvf imapsync-x.xx.tgz + + Go into the directory imapsync-x.xx and read the INSTALL file. + The INSTALL file is also at + http://imapsync.lamiral.info/INSTALL + + The freecode (was freshmeat) record is at + http://freecode.com/projects/imapsync + +=head1 USAGE + + imapsync [options] + +To get a description of each option just run imapsync like this: + + imapsync --help + imapsync + +The option list: + + imapsync [--host1 server1] [--port1 ] + [--user1 ] [--passfile1 ] + [--host2 server2] [--port2 ] + [--user2 ] [--passfile2 ] + [--ssl1] [--ssl2] + [--tls1] [--tls2] + [--authmech1 ] [--authmech2 ] + [--proxyauth1] [--proxyauth2] + [--domain1] [--domain2] + [--authmd51] [--authmd52] + [--folder --folder ...] + [--folderrec --folderrec ...] + [--include ] [--exclude ] + [--prefix2 ] [--prefix1 ] + [--regextrans2 --regextrans2 ...] + [--sep1 ] + [--sep2 ] + [--justfolders] [--justfoldersizes] [--justconnect] [--justbanner] + [--syncinternaldates] + [--idatefromheader] + [--syncacls] + [--regexmess ] [--regexmess ] + [--maxsize ] + [--minsize ] + [--maxage ] + [--minage ] + [--skipheader ] + [--useheader ] [--useheader ] + [--nouid1] [--nouid2] + [--usecache] + [--skipsize] [--allowsizemismatch] + [--delete] [--delete2] + [--expunge] [--expunge1] [--expunge2] [--uidexpunge2] + [--delete2folders] [--delete2foldersonly] [--delete2foldersbutnot] + [--subscribed] [--subscribe] [--subscribe_all] + [--nofoldersizes] [--nofoldersizesatend] + [--dry] + [--debug] [--debugimap][--debugimap1][--debugimap2] + [--timeout ] [--fast] + [--split1] [--split2] + [--reconnectretry1 ] [--reconnectretry2 ] + [--noreleasecheck] + [--pidfile ] + [--tmpdir ] + [--version] [--help] + [--tests] [--tests_debug] + +=cut +# comment + +=pod + +=head1 DESCRIPTION + +The command imapsync is a tool allowing incremental and +recursive imap transfer from one mailbox to another. + +By default all folders are transferred, recursively. + +We sometimes need to transfer mailboxes from one imap server to +another. This is called migration. + +imapsync is a good tool because it reduces the amount +of data transferred by not transferring a given message if it +is already on both sides. Same headers +and the transfer is done only once. All flags are +preserved, unread will stay unread, read will stay read, +deleted will stay deleted. You can stop the transfer at any +time and restart it later, imapsync works well with bad +connections. + +You can decide to delete the messages from the source mailbox +after a successful transfer (it is a good feature when migrating). +In that case, use the --delete option. Option --delete implies +also option --expunge so all messages marked deleted on host1 +will be really deleted. +(you can use --noexpunge to avoid this but I don't see any +real world scenario for the combinaison --delete --noexpunge). + +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 (--delete2 +may help) + +imapsync is not adequate for maintaining two active imap accounts +in synchronization where the user plays independently on both sides. +Use offlineimap (written by John Goerzen) or mbsync (written by +Michael R. Elkins) for 2 ways synchronizations. + + +=head1 OPTIONS + +To get a description of each option just invoke: + +imapsync --help + +=head1 HISTORY + +I wrote imapsync because an enterprise (basystemes) paid me to install +a new imap server without losing huge old mailboxes located on a far +away remote imap server accessible by a low bandwidth link. The tool +imapcp (written in python) could not help me because I had to verify +every mailbox was well transferred and delete it after a good +transfer. imapsync started life as 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" (with password "secret1") +on host "imap.src.fr" to the imap account "max" (with password "secret2") +on host "imap.dest.fr": + + imapsync --host1 imap.src.fr --user1 buddy --password1 secret1 \ + --host2 imap.dest.fr --user2 max --password2 secret2 + +Then you will have max's mailbox updated from buddy's +mailbox. + +=head1 SECURITY + +You can use --passfile1 instead of --password1 to give the +password since it is safer. With --password1 option 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 totally protected against sniffers on the +network since passwords may be transferred in plain text +if CRAM-MD5 is not supported by your imap servers. Use +--ssl1 (or --tls1) and --ssl2 (or --tls2) to enable +encryption on host1 and host2. + +You may authenticate as one user (typically an admin user), +but be authorized as someone else, which means you don't +need to know every user's personal password. Specify +--authuser1 "adminuser" to enable this on host1. In this +case, --authmech1 PLAIN will be used by default since it +is the only way to go for now. So don't use --authmech1 SOMETHING +with --authuser1 "adminuser", it will not work. +Same behavior with the --authuser2 option. + +When working on Sun/iPlanet/Netscape IMAP servers you must use +--proxyauth1 to enable administrative user to masquerade as another user. +Can also be used on destination server with --proxyauth2 + +=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 an unreliable internet connection, you can use this loop +in a Bourne shell: + + while ! imapsync ...; do + echo imapsync not complete + done + +=head1 LICENSE + +imapsync is free, open source but not always gratis software cover by +the Do What The Fuck You Want To Public License (WTFPL). +See COPYING file included in the distribution or the web site +http://sam.zoy.org/wtfpl/COPYING + +=head1 MAILING-LIST + +The public mailing-list may be the best way to get support. + +To write on the mailing-list, the address is: + + +To subscribe, send any message (even empty) to: + +then just reply to the confirmation message. + +To unsubscribe, send a message to: + + +To contact the person in charge for the list: + + +The list archives may be available at: +http://www.linux-france.org/prj/imapsync_list/ +So consider that the list is public, anyone +can see your post. Use a pseudonym or do not +post to this list if you want to stay private. + +Thank you for your participation. + +=head1 AUTHOR + +Gilles LAMIRAL + +Feedback good or bad is always welcome. + +The newsgroup comp.mail.imap may be a good place to talk about +imapsync. I read it when imapsync is concerned. +A better place is the public imapsync mailing-list +(see below). + +Gilles LAMIRAL earns his living writing, installing, +configuring and teaching free, open and often gratis +softwares. Do not hesitate to pay him for that services. + +=head1 BUG REPORT GUIDELINES + +Help us to help you: follow the following guidelines. + +Report any bugs or feature requests to the public mailing-list +or to the author. + +Before reporting bugs, read the FAQ, the README and the +TODO files. http://imapsync.lamiral.info/ + +Upgrade to last imapsync release, maybe the bug +is already fixed. + +Upgrade to last Mail-IMAPClient Perl module. +http://search.cpan.org/dist/Mail-IMAPClient/ +maybe the bug is already fixed. + +Make a good title with word "imapsync" in it (my spam filter won't filter it), +Don't write an email title with just "imapsync" or "problem", +a good title is made of keywords summary, not too long (one visible line). + +Don't write imapsync in uppercase in the email title, we'll +know you run Windows and you haven't read this README yet. + +Help us to help you: in your report, please include: + + - imapsync version. + + - output given with --debug --debugimap near the failure point. + Isolate a message or two in a folder 'BUG' and use + + imapsync ... --folder 'BUG' --debug --debugimap + + - imap server software on both side and their version number. + + - imapsync with all the options you use, the full command line + you use (except the passwords of course). + + - IMAPClient.pm version. + + - the run context. Do you run imapsync.exe, a unix binary or the perl script imapsync. + + - operating system running imapsync. + + - virtual software context (vmware, xen etc.) + + - operating systems on both sides and the third side in case + you run imapsync on a foreign host from the both. + +Most of those values can be found as a copy/paste at the begining of the output. + +One time in your life, read the paper +"How To Ask Questions The Smart Way" +http://www.catb.org/~esr/faqs/smart-questions.html +and then forget it. + +=head1 IMAP SERVERS + +Failure stories reported with the following 3 imap servers: + + - MailEnable 1.54 (Proprietary) but MailEnable 4.23 is supported. + - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 is supported. + Patient and confident testers are welcome. + - Imail 7.04 (maybe). + - (2011) MDaemon 12.0.3 as host2 but MDaemon is supported as host1. + MDaemon is simply buggy with the APPEND IMAP command with + any IMAP email client. + + +Success stories reported with the following 44 imap servers +(software names are in alphabetic order): + + - 1und1 H mimap1 84498 [host1] + - a1.net imap.a1.net IMAP4 Ready [host1] + - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] + (OSL 3.0) http://www.archiveopteryx.org/ + - Axigen Mail Server Version 8.0.0 + - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) + - CommuniGatePro server (Redhat 8.0) (Solaris), CommuniGate Pro 5.2.17[host2] (CentOS 5.4) + - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.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.3, 2.2.6, 2.2.10, 2.2.12, 2.2.13, + 2.3-alpha (OSI Approved), 2.3.1, 2.3.7, 2.3.16 + (http://asg.web.cmu.edu/cyrus/) + - David Tobit V8 (proprietary Message system). + - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). + 2.0.7 seems buggy. + - Deerfield VisNetic MailServer 5.8.6 [host1] + - dkimap4 [host1] + - Domino (Notes) 4.61[host1], 6.5[host1], 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, + 7.0.1[host1], 8.0.1[host1], 8.5.2[host2] + - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, + 1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/) + - Eudora WorldMail v2 + - Gimap (Gmail imap) + - GMX IMAP4 StreamProxy. + - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. + - hMailServer 5.3.3 [host2], 4.4.1 [host1] (see FAQ) + - iPlanet Messaging server 4.15, 5.1, 5.2 + - IMail 7.15 (Ipswitch/Win2003), 8.12, 11.03 [host1] + - Kerio 7.2.0 Patch 1 [host1] [host2] + - MailEnable 4.23 [host1] [host2], 4.26 [host1][host2], 5 [host1] + - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), 12 [host2], + 12.0.3 [host1], 12.5.5 [host1], + - Mercury 4.1 (Windows server 2000 platform) + - Microsoft Exchange Server 5.5, 6.0.6249.0[host1], 6.0.6487.0[host1], + 6.5.7638.1 [host2], 6.5 [host1], Exchange 2007 SP1 (with Update Rollup 2), + Exchange2007-EP-SP2, + Exchange 2010 RTM (Release to Manufacturing) [host2], + Exchange 2010 SP1 RU2[host2], + - Mirapoint, 4.1.9-GA [host1] + - Netscape Mail Server 3.6 (Wintel !) + - Netscape Messaging Server 4.15 Patch 7 + - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) + - OpenWave + - Oracle Beehive [host1] + - Qualcomm Worldmail (NT) + - Rockliffe Mailsite 5.3.11, 4.5.6 + - Samsung Contact IMAP server 8.5.0 + - Scalix v10.1, 10.0.1.3, 11.0.0.431, 11.4.6 + - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1]. + - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) + - Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 + - Surgemail 3.6f5-5 + - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 + (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) + (http://www.washington.edu/imap/) + - UW - QMail v2.1 + - VMS, Imap part of TCP/IP suite of VMS 7.3.2 + - Yahoo [host1] + - Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, + Zimbra 5.0.24_GA_3356.RHEL4 [host1], 5.5, 6.x + +Please report to the author any success or bad story with +imapsync and do not 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: + + Host1 software:* OK louloutte Cyrus IMAP4 v1.5.19 server ready + Host2 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 + + +=head1 HUGE MIGRATION + +Pay special attention to options +--subscribed +--subscribe +--delete +--delete2 +--delete2folders +--expunge +--expunge1 +--expunge2 +--uidexpunge2 +--maxage +--minage +--maxsize +--useheader +--fast +--useuid +--usecache + +If you have many mailboxes to migrate think about a little +shell program. Write a file called file.txt (for example) +containing users and passwords. +The separator used in this example is ';' + +The file.txt file contains: + +user001_1;password001_1;user001_2;password001_2 +user002_1;password002_1;user002_2;password002_2 +user003_1;password003_1;user003_2;password003_2 +user004_1;password004_1;user004_2;password004_2 +user005_1;password005_1;user005_2;password005_2 +... + +On Unix the shell program can be: + + { while IFS=';' read u1 p1 u2 p2; do + imapsync --host1 imap.side1.org --user1 "$u1" --password1 "$p1" \ + --host2 imap.side2.org --user2 "$u2" --password2 "$p2" ... + done ; } < file.txt + +On Windows the batch program can be: + + FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO imapsync ^ + --host1 imap.side1.org --user1 %%G --password1 %%H ^ + --host2 imap.side2.org --user2 %%I --password2 %%J ... + +The ... have to be replaced by nothing or any imapsync option. + +Welcome in shell programming ! + +=head1 Hacking + +Feel free to hack imapsync as the WTFPL 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 : https://github.com/nicolas33/offlineimap + mbsync : http://isync.sourceforge.net/ + mailsync : http://mailsync.sourceforge.net/ + mailutil : http://www.washington.edu/imap/ + part of the UW IMAP tookit. + imaprepl : http://www.bl0rg.net/software/ + http://freecode.com/projects/imap-repl/ + imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html + migrationtool : http://sourceforge.net/projects/migrationtool/ + imapmigrate : http://sourceforge.net/projects/cyrus-utils/ + wonko_imapsync: http://wonko.com/article/554 + see also file W/tools/wonko_ruby_imapsync + exchange-away : http://exchange-away.sourceforge.net/ + pop2imap : http://www.linux-france.org/prj/pop2imap/ + + +Feedback (good or bad) will often be welcome. + +$Id: imapsync,v 1.516 2012/11/02 22:15:04 gilles Exp gilles $ + +=cut + + +# pragmas + +use warnings; +++$|; +use strict; +use Carp; +use Getopt::Long; +use Mail::IMAPClient; +use Digest::MD5 qw(md5_base64); +#use Term::ReadKey; +#use IO::Socket::SSL; +use MIME::Base64; +use English; +use File::Basename; +use POSIX qw(uname SIGALRM); +use Fcntl; +use File::Spec; +use File::Path qw(mkpath rmtree); +use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE); +use Errno qw(EAGAIN EPIPE ECONNRESET); +use File::Glob qw( :glob ) ; +use IO::File; +use Time::Local ; +use Time::HiRes qw( time ) ; +use Test::More 'no_plan'; + +eval { require 'usr/include/sysexits.ph' }; + +use constant { + Unconnected => 0, + Connected => 1, # connected; not logged in + Authenticated => 2, # logged in; no mailbox selected + Selected => 3, # mailbox selected +}; + + +# global variables + +my( + $rcs, $pidfile, $pidfilelocking, + $debug, $debugimap, $debugimap1, $debugimap2, $debugcontent, $debugflags, + $debugLIST, $debugsleep, $debugdev, + $nb_errors, + $host1, $host2, $port1, $port2, + $user1, $user2, $domain1, $domain2, + $password1, $password2, $passfile1, $passfile2, + @folder, @include, @exclude, @folderrec, + $prefix1, $prefix2, + @regextrans2, @regexmess, @regexflag, + $flagsCase, $filterflags, + $sep1, $sep2, + $syncinternaldates, + $idatefromheader, + $usedatemanip, + $syncacls, + $fastio1, $fastio2, + $maxsize, $minsize, $maxage, $minage, + $exitwhenover, + $search, + $skipheader, @useheader, + $skipsize, $allowsizemismatch, $foldersizes, $foldersizesatend, $buffersize, + $delete, $delete2, $delete2duplicates, + $expunge, $expunge1, $expunge2, $uidexpunge2, $dry, + $justfoldersizes, + $authmd5, $authmd51, $authmd52, + $subscribed, $subscribe, $subscribe_all, + $version, $help, + $justconnect, $justfolders, $justbanner, + $fast, + + $total_bytes_transferred, + $total_bytes_skipped, + $total_bytes_error, + $nb_msg_transferred, + $nb_msg_skipped, + $nb_msg_skipped_dry_mode, + $h1_nb_msg_duplicate, + $h2_nb_msg_duplicate, + $h1_nb_msg_noheader, + $h2_nb_msg_noheader, + $h1_total_bytes_duplicate, + $h2_total_bytes_duplicate, + $h1_nb_msg_deleted, + $h2_nb_msg_deleted, + + $h1_bytes_processed, + $h1_nb_msg_processed, + $h1_nb_msg_start, $h1_bytes_start, + $h2_nb_msg_start, $h2_bytes_start, + $h1_nb_msg_end, $h1_bytes_end, + $h2_nb_msg_end, $h2_bytes_end, + + $timeout, + $timestart, $timestart_int, $timeend, $timediff, + $timesize, $timebefore, + $ssl1, $ssl2, + $tls1, $tls2, + $uid1, $uid2, + $authuser1, $authuser2, + $proxyauth1, $proxyauth2, + $authmech1, $authmech2, + $split1, $split2, + $reconnectretry1, $reconnectretry2, + $relogin1, $relogin2, + $tests, $test_builder, $tests_debug, + $allow3xx, $justlogin, + $tmpdir, + $releasecheck, + $max_msg_size_in_bytes, + $modules_version, + $delete2folders, $delete2foldersonly, $delete2foldersbutnot, + $usecache, $debugcache, $cacheaftercopy, + $wholeheaderifneeded, %h1_msgs_copy_by_uid, $useuid, $h2_uidguess, + $addheader, + %h1, %h2, + $checkselectable, $checkmessageexists, + $expungeaftereach, + $abletosearch, + $showpasswords, + $fixslash2, +); + +# main program + +# global variables initialisation + +$rcs = '$Id: imapsync,v 1.516 2012/11/02 22:15:04 gilles Exp gilles $ '; + +$total_bytes_transferred = 0; +$total_bytes_skipped = 0; +$total_bytes_error = 0; +$nb_msg_transferred = 0; +$nb_msg_skipped = $nb_msg_skipped_dry_mode = 0; +$h1_nb_msg_deleted = $h2_nb_msg_deleted = 0; +$h1_nb_msg_duplicate = $h2_nb_msg_duplicate = 0; +$h1_nb_msg_noheader = $h2_nb_msg_noheader = 0; +$h1_total_bytes_duplicate = $h2_total_bytes_duplicate = 0; + + +$h1_nb_msg_start = $h1_bytes_start = 0 ; +$h2_nb_msg_start = $h2_bytes_start = 0 ; +$h1_nb_msg_processed = $h1_bytes_processed = 0 ; + +$h1_nb_msg_end = $h1_bytes_end = 0 ; +$h2_nb_msg_end = $h2_bytes_end = 0 ; + +$nb_errors = 0; +$max_msg_size_in_bytes = 0; + +my %month_abrev = ( + Jan => 0, + Feb => 1, + Mar => 2, + Apr => 3, + May => 4, + Jun => 5, + Jul => 6, + Aug => 7, + Sep => 8, + Oct => 9, + Nov => 10, + Dec => 11, +); + +unless(defined(&_SYSEXITS_H)) { + # 64 on my linux box. + eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE); +} + + +# @ARGV will be eat by get_options() +my @argv_copy = @ARGV; + +get_options(); + +# $SIG{ INT } = \&catch_continue ; +$SIG{ INT } = \&catch_exit ; + +$timestart = time( ); +$timestart_int = int( $timestart ) ; +$timebefore = $timestart; + +my $timestart_str = localtime( $timestart ) ; +print "Transfer started at $timestart_str\n"; + +$modules_version = defined($modules_version) ? $modules_version : 1; + + +$releasecheck = defined($releasecheck) ? $releasecheck : 1; +my $warn_release = ($releasecheck) ? check_last_release() : ''; + +# default values + +$tmpdir ||= File::Spec->tmpdir(); +$pidfile ||= $tmpdir . '/imapsync.pid'; + +$pidfilelocking = defined( $pidfilelocking ) ? $pidfilelocking : 0 ; + +# allow Mail::IMAPClient 3.0.xx by default +$allow3xx = defined($allow3xx) ? $allow3xx : 1; + +$wholeheaderifneeded = defined( $wholeheaderifneeded ) ? $wholeheaderifneeded : 1; + +# turn on RFC standard flags correction like \SEEN -> \Seen +$flagsCase = defined( $flagsCase ) ? $flagsCase : 1 ; + +# Use PERMANENTFLAGS if available +$filterflags = defined( $filterflags ) ? $filterflags : 1 ; + +# turn on relogin 5 by default +$relogin1 = defined( $relogin1 ) ? $relogin1 : 5 ; +$relogin2 = defined( $relogin2 ) ? $relogin2 : 5 ; + +if ( $fast ) { + # $useuid = 1 ; + $foldersizes = 0 ; + $foldersizesatend = 0 ; +} + +# Activate --usecache if --useuid is set and no --nousecache +$usecache = 1 if ( $useuid and ( ! defined( $usecache ) ) ) ; +$cacheaftercopy = 1 if ( $usecache and ( ! defined( $cacheaftercopy ) ) ) ; + +$checkselectable = defined( $checkselectable ) ? $checkselectable : 1 ; +$checkmessageexists = defined( $checkmessageexists ) ? $checkmessageexists : 1 ; +$expungeaftereach = defined( $expungeaftereach ) ? $expungeaftereach : 1 ; +$abletosearch = defined( $abletosearch ) ? $abletosearch : 1 ; +$showpasswords = defined( $showpasswords ) ? $showpasswords : 0 ; +$fixslash2 = defined( $fixslash2 ) ? $fixslash2 : 1 ; + +$delete2duplicates = 1 if ( $delete2 and ( ! defined( $delete2duplicates ) ) ) ; + +print banner_imapsync(@argv_copy); + +print "Temp directory is $tmpdir\n"; + +is_valid_directory($tmpdir); +write_pidfile($pidfile) if ($pidfile); + +$modules_version and print "Modules version list:\n", modules_VERSION(), "\n"; + +check_lib_version() or + die "imapsync needs perl lib Mail::IMAPClient release 2.2.9, or 3.25 or superior \n"; + +exit_clean(0) if ($justbanner); + +# By default, 1000 at a time, not more. +$split1 ||= 100; +$split2 ||= 100; + +$host1 || missing_option("--host1") ; +$port1 ||= ( $ssl1 ) ? 993 : 143; + +$host2 || missing_option("--host2") ; +$port2 ||= ( $ssl2 ) ? 993 : 143; + +$debugimap1 = $debugimap2 = 1 if ( $debugimap ) ; +$debug = 1 if ( $debugimap1 or $debugimap2 ) ; + +# By default, don't take size to compare +$skipsize = (defined $skipsize) ? $skipsize : 1; + +$uid1 = defined($uid1) ? $uid1 : 1; +$uid2 = defined($uid2) ? $uid2 : 1; + +$subscribe = defined($subscribe) ? $subscribe : 1; + +# Allow size mismatch by default +$allowsizemismatch = defined($allowsizemismatch) ? $allowsizemismatch : 1; + +$delete2folders = 1 + if ( defined( $delete2foldersbutnot ) or defined( $delete2foldersonly ) ) ; + +if ($justconnect) { + justconnect(); + exit_clean(0); +} + +$user1 || missing_option("--user1"); +$user2 || missing_option("--user2"); + +$syncinternaldates = defined($syncinternaldates) ? $syncinternaldates : 1; + +# Turn on expunge if there is not explicit option --noexpunge and option +# --delete is given. +# Done because --delete --noexpunge is very dangerous on the second run: +# the Deleted flag is then synced to all previously transfered messages. +# So --delete implies --expunge is a better usability default behaviour. +if ($delete) { + if ( ! defined($expunge)) { + $expunge = 1; + } +} + +if ( $uidexpunge2 and ! Mail::IMAPClient->can( 'uidexpunge' ) ) { + print "Failure: uidexpunge not supported (IMAPClient release < 3.17), use --expunge2 instead\n" ; + exit_clean( 3 ) ; +} + +if ( $delete2 and ! defined( $uidexpunge2 ) ) { + if ( Mail::IMAPClient->can( 'uidexpunge' ) ) { + print "Info: will act as --uidexpunge2\n" ; + $uidexpunge2 = 1 ; + }elsif ( ! defined( $expunge2 ) ) { + print "Info: will act as --expunge2 (no uidexpunge support)\n" ; + $expunge2 = 1 ; + } +} + +if ( $delete and $delete2 ) { + print "Warning: using --delete and --delete2 together is almost always a bad idea, exiting imapsync\n" ; + exit_clean( 4 ) ; +} + +if ($idatefromheader) { + print "Turned ON idatefromheader, ", + "will set the internal dates on host2 from the 'Date:' header line.\n"; + $syncinternaldates = 0; +} + +if ($syncinternaldates) { + print "Info: turned ON syncinternaldates, ", + "will set the internal dates (arrival dates) on host2 same as host1.\n"; +}else{ + print "Info: turned OFF syncinternaldates\n"; +} + +if (defined($authmd5) and ($authmd5)) { + $authmd51 = 1 ; + $authmd52 = 1 ; +} + +if (defined($authmd51) and ($authmd51)) { + $authmech1 ||= 'CRAM-MD5'; +} +else{ + $authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN'; +} + +if (defined($authmd52) and ($authmd52)) { + $authmech2 ||= 'CRAM-MD5'; +} +else{ + $authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN'; +} + +$authmech1 = uc($authmech1); +$authmech2 = uc($authmech2); + +# Check required options for XGWTRUSTEDAPP +if ($authmech1 eq 'XGWTRUSTEDAPP') { + $authuser1 || missing_option("--authuser1"); +} + +if (defined $proxyauth1 && !$authuser1) { + missing_option("With --proxyauth1, --authuser1"); +} + +if (defined $proxyauth2 && !$authuser2) { + missing_option("With --proxyauth2, --authuser2"); +} + +$authuser1 ||= $user1; +$authuser2 ||= $user2; + +print "Info: will try to use $authmech1 authentication on host1\n"; +print "Info: will try to use $authmech2 authentication on host2\n"; + +$syncacls = (defined($syncacls)) ? $syncacls : 0; +$foldersizes = (defined($foldersizes)) ? $foldersizes : 1; +$foldersizesatend = (defined($foldersizesatend)) ? $foldersizesatend : 1; + +$fastio1 = (defined($fastio1)) ? $fastio1 : 0; +$fastio2 = (defined($fastio2)) ? $fastio2 : 0; + +$reconnectretry1 = (defined($reconnectretry1)) ? $reconnectretry1 : 3; +$reconnectretry2 = (defined($reconnectretry2)) ? $reconnectretry2 : 3; + +@useheader = ( "Message-Id", "Message-ID", "Received" ) unless ( @useheader ) ; + +my %useheader ; + +# Make a hash %useheader of each --useheader 'key' in uppercase +@useheader{ map( { uc( $_ ) } @useheader ) } = ( ) ; + +#require Data::Dumper ; +#print Data::Dumper->Dump( [ \%useheader ] ) ; + + +print "Host1: imap server [$host1] port [$port1] user [$user1]\n"; +print "Host2: imap server [$host2] port [$port2] user [$user2]\n"; + +$password1 || $passfile1 || 'PREAUTH' eq $authmech1 || do { + $password1 = ask_for_password( $authuser1 || $user1, $host1 ) ; +} ; + +$password1 = ( defined( $passfile1 ) ) ? firstline ( $passfile1 ) : $password1 ; + +$password2 || $passfile2 || 'PREAUTH' eq $authmech2 || do { + $password2 = ask_for_password( $authuser2 || $user2, $host2 ) ; +} ; + +$password2 = ( defined( $passfile2 ) ) ? firstline ( $passfile2 ) : $password2 ; + + +my $dry_message = '' ; +$dry_message = "\t(not really since --dry mode)" if $dry ; + + +my $imap1 = (); +my $imap2 = (); + + + +$debugimap1 and print "Host1 connection\n"; +$imap1 = login_imap($host1, $port1, $user1, $domain1, $password1, + $debugimap1, $timeout, $fastio1, $ssl1, $tls1, + $authmech1, $authuser1, $reconnectretry1, + $proxyauth1, $uid1, $split1); + +$debugimap2 and print "Host2 connection\n"; +$imap2 = login_imap($host2, $port2, $user2, $domain2, $password2, + $debugimap2, $timeout, $fastio2, $ssl2, $tls2, + $authmech2, $authuser2, $reconnectretry2, + $proxyauth2, $uid2, $split2); + + +$debug and print "Host1 Buffer I/O: ", $imap1->Buffer(), "\n"; +$debug and print "Host2 Buffer I/O: ", $imap2->Buffer(), "\n"; + + + +die_clean( 'Not authenticated on host1' ) unless $imap1->IsAuthenticated( ) ; +print "Host1: state Authenticated\n"; +die_clean( 'Not authenticated on host2' ) unless $imap2->IsAuthenticated( ) ; +print "Host2: state Authenticated\n"; + +print "Host1 capability: ", join(" ", $imap1->capability_update()), "\n"; +print "Host2 capability: ", join(" ", $imap2->capability_update()), "\n"; + + +exit_clean(0) if ($justlogin); + +# +# Folder stuff +# + +my ( +@h1_folders_all, %h1_folders_all, @h1_folders_wanted, %requested_folder, +%h1_subscribed_folder, %h2_subscribed_folder, +@h2_folders_all, %h2_folders_all, @h2_folders_from_1_wanted, %h2_folders_from_1_wanted, +@h2_folders_from_1_all, %h2_folders_from_1_all, +); + + +# Make a hash of subscribed folders in both servers. +map { $h1_subscribed_folder{ $_ } = 1 } $imap1->subscribed( ); +map { $h2_subscribed_folder{ $_ } = 1 } $imap2->subscribed( ); + + +# All folders on host1 and host2 +@h1_folders_all = sort $imap1->folders(); +@h2_folders_all = sort $imap2->folders(); + +map { $h1_folders_all{$_} = 1} @h1_folders_all; +map { $h2_folders_all{$_} = 1} @h2_folders_all; + +if (scalar(@folder) or $subscribed or scalar(@folderrec)) { + # folders given by option --folder + if (scalar(@folder)) { + add_to_requested_folders(@folder); + } + + # option --subscribed + if ( $subscribed ) { + add_to_requested_folders( keys ( %h1_subscribed_folder ) ) ; + } + + # option --folderrec + if (scalar(@folderrec)) { + foreach my $folderrec (@folderrec) { + add_to_requested_folders($imap1->folders($folderrec)); + } + } +} +else { + # no include, no folder/subscribed/folderrec options => all folders + if (not scalar(@include)) { + add_to_requested_folders(@h1_folders_all); + } +} + + +# consider (optional) includes and excludes +if (scalar(@include)) { + foreach my $include (@include) { + my @included_folders = grep /$include/, @h1_folders_all; + add_to_requested_folders(@included_folders); + print "Including folders matching pattern '$include': @included_folders\n"; + } +} + +if (scalar(@exclude)) { + foreach my $exclude (@exclude) { + my @requested_folder = sort(keys(%requested_folder)); + my @excluded_folders = grep /$exclude/, @requested_folder; + remove_from_requested_folders(@excluded_folders); + print "Excluding folders matching pattern '$exclude': @excluded_folders\n"; + } +} + +# Remove no selectable folders + +$checkselectable and do { + foreach my $folder (keys(%requested_folder)) { + if ( not $imap1->selectable($folder)) { + print "Warning: ignoring folder $folder because it is not selectable\n"; + remove_from_requested_folders($folder); + } + } +} ; + +my @requested_folder = sort(keys(%requested_folder)); + +@h1_folders_wanted = @requested_folder; + +#my $h1_namespace = $imap1->namespace() ; +#my $h2_namespace = $imap2->namespace() ; +#require Data::Dumper ; +#$debug and print "Host1 namespace:\n", Data::Dumper->Dump([$h1_namespace]) ; +#$debug and print "Host2 namespace:\n", Data::Dumper->Dump([$h2_namespace]) ; + +my($h1_sep,$h2_sep); +# what are the private folders separators for each server ? + +$debug and print "Getting separators\n"; +$h1_sep = get_separator($imap1, $sep1, "--sep1"); +$h2_sep = get_separator($imap2, $sep2, "--sep2"); + +my($h1_prefix,$h2_prefix); +$h1_prefix = get_prefix($imap1, $prefix1, "--prefix1"); +$h2_prefix = get_prefix($imap2, $prefix2, "--prefix2"); + + +print "Host1 separator and prefix: [$h1_sep][$h1_prefix]\n"; +print "Host2 separator and prefix: [$h2_sep][$h2_prefix]\n"; + +#my $h1_xlist_folders = $imap1->xlist_folders( ) ; +#my $h2_xlist_folders = $imap2->xlist_folders( ) ; +#require Data::Dumper ; +#print "Host1 xlist:\n", Data::Dumper->Dump([$h1_xlist_folders]) ; +#print "Host2 xlist:\n", Data::Dumper->Dump([$h2_xlist_folders]) ; + +#exit ; + +foreach my $h1_fold (@h1_folders_wanted) { + my $h2_fold; + $h2_fold = imap2_folder_name($h1_fold); + $h2_folders_from_1_wanted{$h2_fold}++; +} +@h2_folders_from_1_wanted = sort keys(%h2_folders_from_1_wanted); + +foreach my $h1_fold (@h1_folders_all) { + my $h2_fold; + $h2_fold = imap2_folder_name($h1_fold); + $h2_folders_from_1_all{$h2_fold}++; +} +#@h2_folders_from_1_all = sort keys(%h2_folders_from_1_all); + + +if ( $foldersizes ) { + ( $h1_nb_msg_start, $h1_bytes_start ) = foldersizes( "Host1", $imap1, @h1_folders_wanted ) ; + ( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( "Host2", $imap2, @h2_folders_from_1_wanted ) ; + sleep( 2 ) ; +} + + +exit_clean(0) if ($justfoldersizes); + +print + "++++ Listing folders\n", + "Host1 folders list:\n", map("[$_]\n",@h1_folders_all),"\n", + "Host2 folders list:\n", map("[$_]\n",@h2_folders_all),"\n"; + +print + "Host1 subscribed folders list: ", + map( "[$_] ", sort keys( %h1_subscribed_folder ) ), "\n" + if ( $subscribed ) ; + +my @h2_folders_not_in_1; +@h2_folders_not_in_1 = list_folders_in_2_not_in_1(); + +print "Folders in host2 not in host1:\n", + map("[$_]\n", @h2_folders_not_in_1),"\n"; + +delete_folders_in_2_not_in_1() if $delete2folders; + +# folder loop +print "++++ Looping on each folder\n"; + +my $begin_transfer_time = time ; + +FOLDER: foreach my $h1_fold (@h1_folders_wanted) { + + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my $h2_fold = imap2_folder_name( $h1_fold ) ; + #relogin1( ) if ( $relogin1 ) ; + printf( "%-35s -> %-35s\n", "[$h1_fold]", "[$h2_fold]" ) ; + + # host1 can not be fetched read only, select is needed because of expunge. + select_folder( $imap1, $h1_fold, 'Host1' ) or next FOLDER ; + #examine_folder( $imap1, $h1_fold, 'Host1' ) or next FOLDER ; + + + if ( ! exists( $h2_folders_all{ $h2_fold } ) ) { + create_folder( $imap2, $h2_fold, $h1_fold ) or next FOLDER ; + } + + acls_sync( $h1_fold, $h2_fold ) ; + + # Sometimes the folder on host2 is listed (it exists) but is + # not selectable but becomes selectable by a create (Gmail) + select_folder( $imap2, $h2_fold, 'Host2' ) + or ( create_folder( $imap2, $h2_fold, $h1_fold ) + and select_folder( $imap2, $h2_fold, 'Host2' ) ) + or next FOLDER ; + my @select_results = $imap2->Results( ) ; + + #print "%%% @select_results\n" ; + my $permanentflags2 = permanentflags( @select_results ) ; + $debug and print "permanentflags: $permanentflags2\n" ; + if ( $expunge or $expunge1 ){ + print "Expunging host1 $h1_fold $dry_message\n" ; + unless($dry) { $imap1->expunge() } ; + #print "Expunging host2 $h2_fold\n" ; + #unless($dry) { $imap2->expunge() } ; + } + + if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribe_all ) + and ! exists $h2_subscribed_folder{ $h2_fold } ) { + print "Subscribing to folder $h2_fold on destination server\n" ; + unless( $dry ) { $imap2->subscribe( $h2_fold ) } ; + } + + next FOLDER if ($justfolders); + + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my $h1_msgs_all_hash_ref = { } ; + my @h1_msgs = select_msgs( $imap1, $h1_msgs_all_hash_ref ); + + my $h1_msgs_nb = scalar( @h1_msgs ) ; + $h1{ $h1_fold }{ 'messages_nb' } = $h1_msgs_nb ; + + ( $debug or $debugLIST ) and print "Host1 LIST: $h1_msgs_nb messages [@h1_msgs]\n" ; + + my $h2_msgs_all_hash_ref = { } ; + my @h2_msgs = select_msgs( $imap2, $h2_msgs_all_hash_ref ) ; + + my $h2_msgs_nb = scalar( @h2_msgs ) ; + $h2{ $h2_fold }{ 'messages_nb' } = $h2_msgs_nb ; + + ( $debug or $debugLIST ) and print "Host2 LIST: $h2_msgs_nb messages [@h2_msgs]\n"; + + my $cache_base = "$tmpdir/imapsync_cache/$host1/$user1/$host2/$user2" ; + my $cache_dir = cache_folder( $cache_base, $h1_fold, $h2_fold ) ; + my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ) ; + my $h1_uidvalidity = $imap1->uidvalidity( ) || '' ; + my $h2_uidvalidity = $imap2->uidvalidity( ) || '' ; + + last FOLDER if $imap1->IsUnconnected() ; + last FOLDER if $imap2->IsUnconnected() ; + + if ( $usecache ) { + print "cache directory: $cache_dir\n" ; + mkpath( "$cache_dir" ) ; + ( $cache_1_2_ref, $cache_2_1_ref ) + = get_cache( $cache_dir, \@h1_msgs, \@h2_msgs, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ; + print "CACHE h1 h2: ", scalar( keys %$cache_1_2_ref ), " files\n" ; + $debug and print '[', + map ( { "$_->$cache_1_2_ref->{$_} " } keys %$cache_1_2_ref ), " ]\n"; + } + + my %h1_hash = (); + my %h2_hash = (); + + my ( %h1_msgs, %h2_msgs ) ; + @h1_msgs{ @h1_msgs } = (); + @h2_msgs{ @h2_msgs } = (); + + my @h1_msgs_in_cache = sort { $a <=> $b } keys %$cache_1_2_ref ; + my @h2_msgs_in_cache = keys %$cache_2_1_ref ; + + my ( %h1_msgs_not_in_cache, %h2_msgs_not_in_cache ) ; + %h1_msgs_not_in_cache = %h1_msgs ; + %h2_msgs_not_in_cache = %h2_msgs ; + delete @h1_msgs_not_in_cache{ @h1_msgs_in_cache } ; + delete @h2_msgs_not_in_cache{ @h2_msgs_in_cache } ; + + my @h1_msgs_not_in_cache = keys %h1_msgs_not_in_cache ; + #print "h1_msgs_not_in_cache: [@h1_msgs_not_in_cache]\n" ; + my @h2_msgs_not_in_cache = keys %h2_msgs_not_in_cache ; + + my @h2_msgs_delete2_not_in_cache = () ; + %h1_msgs_copy_by_uid = ( ) ; + + if ( $useuid ) { + # use uid so we have to avoid getting header + @h1_msgs_copy_by_uid{ @h1_msgs_not_in_cache } = ( ) ; + @h2_msgs_delete2_not_in_cache = @h2_msgs_not_in_cache if $usecache ; + @h1_msgs_not_in_cache = ( ) ; + @h2_msgs_not_in_cache = ( ) ; + + #print "delete2: @h2_msgs_delete2_not_in_cache\n"; + } + + $debug and print "Host1 parsing headers of folder [$h1_fold]\n"; + + my ($h1_heads_ref, $h1_fir_ref) = ({}, {}); + $h1_heads_ref = $imap1->parse_headers([@h1_msgs_not_in_cache], @useheader) if (@h1_msgs_not_in_cache); + $debug and print "Host1 parsing headers of folder [$h1_fold] took ", timenext(), " s\n"; + + @$h1_fir_ref{@h1_msgs} = (undef); + + $debug and print "Host1 getting flags idate and sizes of folder [$h1_fold]\n" ; + if ( $abletosearch ) { + $h1_fir_ref = $imap1->fetch_hash( "FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref ) + if ( @h1_msgs ) ; + }else{ + $h1_fir_ref = $imap1->fetch_hash( '1:999999', "FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref ) + if ( @h1_msgs ) ; + } + $debug and print "Host1 getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n"; + unless ($h1_fir_ref) { + print + "Host1 folder $h1_fold: Could not fetch_hash ", + scalar(@h1_msgs), " msgs: ", $imap1->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + + my @h1_msgs_duplicate; + foreach my $m (@h1_msgs_not_in_cache) { + my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, 'Host1', \%h1_hash); + if (! defined($rc)) { + my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + print "Host1 $h1_fold/$m size $h1_size ignored (no wanted headers so we ignore this message)\n" ; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + $h1_nb_msg_noheader +=1; + $h1_nb_msg_processed +=1 ; + } elsif(0 == $rc) { + # duplicate + push(@h1_msgs_duplicate, $m); + # duplicate, same id same size? + my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + $nb_msg_skipped += 1; + $h1_total_bytes_duplicate += $h1_size; + $h1_nb_msg_duplicate += 1; + $h1_nb_msg_processed +=1 ; + } + } + my $h1_msgs_duplicate_nb = scalar( @h1_msgs_duplicate ) ; + $h1{ $h1_fold }{ 'duplicates_nb' } = $h1_msgs_duplicate_nb ; + + $debug and print "Host1 selected: $h1_msgs_nb duplicates: $h1_msgs_duplicate_nb\n" ; + $debug and print "Host1 whole time parsing headers took ", timenext(), " s\n"; + + $debug and print "Host2 parsing headers of folder [$h2_fold]\n"; + + my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} ); + $h2_heads_ref = $imap2->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache); + $debug and print "Host2 parsing headers of folder [$h2_fold] took ", timenext(), " s\n" ; + + $debug and print "Host2 getting flags idate and sizes of folder [$h2_fold]\n" ; + @$h2_fir_ref{@h2_msgs} = ( ); # fetch_hash can select by uid with last arg as ref + $h2_fir_ref = $imap2->fetch_hash("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref) + if (@h2_msgs); + $debug and print "Host2 getting flags idate and sizes of folder [$h2_fold] took ", timenext(), " s\n" ; + + my @h2_msgs_duplicate; + foreach my $m (@h2_msgs_not_in_cache) { + my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, 'Host2', \%h2_hash); + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + if (! defined($rc)) { + print "Host2 $h2_fold/$m size $h2_size ignored (no wanted headers so we ignore this message)\n" ; + $h2_nb_msg_noheader += 1 ; + } elsif(0 == $rc) { + # duplicate + $h2_nb_msg_duplicate += 1; + $h2_total_bytes_duplicate += $h2_size; + push(@h2_msgs_duplicate, $m); + } + } + my $h2_msgs_duplicate_nb = scalar( @h2_msgs_duplicate ) ; + $h2{ $h2_fold }{ 'duplicates_nb' } = $h2_msgs_duplicate_nb ; + + print "Host2 selected: $h2_msgs_nb, duplicates: $h2_msgs_duplicate_nb\n" + if ( $debug or $delete2duplicates or $h2_msgs_duplicate_nb ) ; + $debug and print "Host2 whole time parsing headers took ", timenext(), " s\n"; + + $debug and print "++++ Verifying [$h1_fold] -> [$h2_fold]\n"; + # messages in host1 that are not in host2 + + my @h1_hash_keys_sorted_by_uid + = sort {$h1_hash{$a}{'m'} <=> $h1_hash{$b}{'m'}} keys(%h1_hash); + + #print map { $h1_hash{$_}{'m'} . " "} @h1_hash_keys_sorted_by_uid; + + my @h2_hash_keys_sorted_by_uid + = sort {$h2_hash{$a}{'m'} <=> $h2_hash{$b}{'m'}} keys(%h2_hash); + + if ( 0 ) { + # What the hell was this code written for? + # hashes, keys are uid, values are the internaldates in epoch (best format to compare dates) + my %h1_epoch ; + my %h2_epoch ; + @h1_epoch{ @h1_msgs } = map( { epoch( $h1_fir_ref->{ $_ }->{ 'INTERNALDATE' } ) } @h1_msgs ) ; + @h2_epoch{ @h2_msgs } = map( { epoch( $h2_fir_ref->{ $_ }->{ 'INTERNALDATE' } ) } @h2_msgs ) ; + #print keyval( %h1_epoch ) ; + #print keyval( %h2_epoch ) ; + my $h1_greatest_epoch = max( values %h1_epoch ) ; + print "h1_greatest_epoch $h1_greatest_epoch\n" ; + } + + #next FOLDER ; + + if( $delete2duplicates ) { + my @h2_expunge ; + + foreach my $h2_msg ( @h2_msgs_duplicate ) { + print "msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $dry_message\n" ; + push( @h2_expunge, $h2_msg ) if $uidexpunge2 ; + unless ( $dry ) { + $imap2->delete_message( $h2_msg ) ; + $h2_nb_msg_deleted += 1 ; + } + } + my $cnt = scalar @h2_expunge ; + if( @h2_expunge ) { + print "uidexpunge $cnt message(s) $dry_message\n" ; + $imap2->uidexpunge( \@h2_expunge ) if ! $dry ; + } + if ( $expunge2 ){ + print "Expunging host2 folder $h2_fold $dry_message\n" ; + $imap2->expunge( ) if ! $dry ; + } + } + + if($delete2) { + my @h2_expunge; + foreach my $m_id (@h2_hash_keys_sorted_by_uid) { + #print "$m_id "; + unless (exists($h1_hash{$m_id})) { + my $h2_msg = $h2_hash{$m_id}{'m'}; + my $h2_flags = $h2_hash{$m_id}{'F'} || ""; + my $isdel = $h2_flags =~ /\B\\Deleted\b/ ? 1 : 0; + print "msg $h2_fold/$h2_msg marked \\Deleted on host2 [$m_id] $dry_message\n" + if ! $isdel; + push(@h2_expunge, $h2_msg) if $uidexpunge2; + unless ($dry or $isdel) { + $imap2->delete_message($h2_msg); + $h2_nb_msg_deleted += 1; + } + } + } + foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) { + print "msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $dry_message\n"; + push(@h2_expunge, $h2_msg) if $uidexpunge2; + unless ($dry) { + $imap2->delete_message($h2_msg); + $h2_nb_msg_deleted += 1; + } + } + my $cnt = scalar @h2_expunge ; + if( @h2_expunge ) { + print "uidexpunge $cnt message(s) $dry_message\n" ; + $imap2->uidexpunge( \@h2_expunge ) if ! $dry ; + } + if ($expunge2){ + print "Expunging host2 folder $h2_fold $dry_message\n" ; + $imap2->expunge( ) if ! $dry ; + } + } + + my $h2_uidnext = $imap2->uidnext( $h2_fold ) ; + $debug and print "Host2 uidnext: $h2_uidnext\n" ; + $h2_uidguess = $h2_uidnext ; + MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) { + #print "h1_nb_msg_processed: $h1_nb_msg_processed\n" ; + my $h1_size = $h1_hash{$m_id}{'s'}; + my $h1_msg = $h1_hash{$m_id}{'m'}; + my $h1_idate = $h1_hash{$m_id}{'D'}; + + unless (exists($h2_hash{$m_id})) { + # copy + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ; + last FOLDER if total_bytes_max_reached( ) ; + next MESS; + } + else{ + # already on host2 + my $h2_msg = $h2_hash{$m_id}{'m'} ; + $debug and print "Host1 found msg $h1_fold/$h1_msg equals Host2 $h2_fold/$h2_msg\n" ; + $total_bytes_skipped += $h1_size ; + $nb_msg_skipped += 1 ; + $h1_nb_msg_processed +=1 ; + + if ( $usecache ) { + $debugcache and print "touch $cache_dir/${h1_msg}_$h2_msg\n" ; + touch( "$cache_dir/${h1_msg}_$h2_msg" ) + or die( "Couldn't touch $cache_dir/${h1_msg}_$h2_msg" ) ; + } + } + + #$debug and print "MESSAGE $m_id\n"; + my $h2_msg = $h2_hash{$m_id}{'m'}; + + sync_flags( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ; + + # Good + my $h2_size = $h2_hash{$m_id}{'s'}; + $debug and print + "Host1 size msg $h1_fold/$h1_msg = $h1_size <> $h2_size = Host2 $h2_fold/$h2_msg\n"; + if( $delete ) { + my $expunge_message = '' ; + $expunge_message = "and expunged" if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ; + print "Host1 msg $h1_fold/$h1_msg marked deleted $expunge_message $dry_message\n" ; + unless( $dry ) { + $imap1->delete_message( $h1_msg ) ; + $h1_nb_msg_deleted += 1 ; + $imap1->expunge() if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ; + } + } + + } + # END MESS: loop + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + MESS_IN_CACHE: foreach my $h1_msg ( @h1_msgs_in_cache ) { + my $h2_msg = $cache_1_2_ref->{ $h1_msg } ; + $debugcache and print "cache messages update flags $h1_msg->$h2_msg\n"; + sync_flags( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ; + my $h1_size = $h1_fir_ref->{ $h1_msg }->{ 'RFC822.SIZE' } || 0 ; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + $h1_nb_msg_processed +=1 ; + } + + #print "Messages by uid: ", map { "$_ " } keys %h1_msgs_copy_by_uid, "\n" ; + MESS_BY_UID: foreach my $h1_msg ( sort { $a <=> $b } keys %h1_msgs_copy_by_uid ) { + # + $debug and print "Copy by uid $h1_fold/$h1_msg\n" ; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ; + last FOLDER if total_bytes_max_reached( ) ; + } + + if ($expunge or $expunge1){ + print "Expunging host1 folder $h1_fold $dry_message\n"; + unless($dry) { $imap1->expunge() }; + } + if ($expunge2){ + print "Expunging host2 folder $h2_fold $dry_message\n"; + unless($dry) { $imap2->expunge() }; + } + + $debug and print "Time: ", timenext(), " s\n"; +} + +sub total_bytes_max_reached { + + return( 0 ) if not $exitwhenover ; + if ( $total_bytes_transferred >= $exitwhenover ) { + print "Maximum bytes transfered reached, $total_bytes_transferred >= $exitwhenover, ending sync\n" ; + return( 1 ) ; + } + +} + +sub size_filtered_flag { + my $h1_size = shift ; + + if (defined $maxsize and $h1_size >= $maxsize) { + return( 1 ) ; + } + if (defined $minsize and $h1_size <= $minsize) { + return( 1 ) ; + } + return( 0 ) ; +} + +sub sync_flags { + my ( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) = @_ ; + $debug and print "Host1 flags $h1_fold/$h1_msg -> Host2 $h2_fold/$h2_msg\n"; + + my $h1_size = $h1_fir_ref->{$h1_msg}->{"RFC822.SIZE"} ; + return() if size_filtered_flag( $h1_size ) ; + + # used cached flag values for efficiency + my $h1_flags = $h1_fir_ref->{ $h1_msg }->{ "FLAGS" } || '' ; + my $h2_flags = $h2_fir_ref->{ $h2_msg }->{ "FLAGS" } || '' ; + + ( $debug or $debugflags ) and + print "Host1 flags init msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n" ; + + # RFC 2060: This flag can not be altered by any client + $h1_flags =~ s@\\Recent\s?@@gi ; + $h1_flags = flags_regex( $h1_flags ) if @regexflag; + $h1_flags = flagsCase( $h1_flags ) if $flagsCase ; + $h1_flags = flags_filter( $h1_flags, $permanentflags2) if ( $permanentflags2 and $filterflags ) ; + + # compare flags - set flags if there a difference + my @h1_flags = sort split(' ', $h1_flags ); + my @h2_flags = sort split(' ', $h2_flags ); + my $diff = compare_lists( \@h1_flags, \@h2_flags ); + + #$diff = 1 ; + ( $debug or $debugflags ) and print "Host1 flags filt msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n" ; + $diff and ( $debug or $debugflags ) + and print "Host2 flags msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n"; + # This sets flags so flags can be removed with this + # When you remove a \Seen flag on host1 you want to it + # to be removed on host2. Just add flags is not what + # we need most of the time. + + if ( ! $dry and $diff and ! $imap2->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) { + print "Host2 flags msg $h2_fold/$h2_msg could not add flags [@h1_flags]: ", + $imap2->LastError, "\n"; + #$nb_errors++; + } +} + +print "++++ End looping on each folder\n"; +#print memory_consumption(); + +if ( $foldersizesatend ) { + ( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( "Host1", $imap1, @h1_folders_wanted ) ; + ( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( "Host2", $imap2, @h2_folders_from_1_wanted ) ; +} + +$imap1->logout( ) ; +$imap2->logout( ) ; + +stats( ) ; +exit_clean( 1 ) if ( $nb_errors ) ; +exit_clean( 0 ) ; + +# END of main program + +# subroutines + +sub max { + return(undef) if (0 == scalar(@_)); + my @sorted = sort { $a <=> $b } @_; + return(pop(@sorted)); +} + +sub tests_max { + ok(0 == max(0), "max 0"); + ok(1 == max(1), "max 1"); + ok(-1 == max(-1), "max -1"); + ok(! defined(max()), "max no arg"); + ok(100 == max(1, 100), "max 1 100"); + ok(100 == max(100, 1), "max 100 1"); + ok(100 == max(100, 42, 1), "max 100 42 1"); + ok(100 == max(100, "42", 1), "max 100 42 1"); + ok(100 == max("100", "42", 1), "max 100 42 1"); + #ok(100 == max(100, "haha", 1), "max 100 42 1"); +} + +sub keyval { + my %hash = @_ ; + return( join( " ", map( { "$_ => " . $hash{ $_ } } keys %hash ) ) . "\n" ) ; +} + + + +sub check_lib_version { + $debug and print "IMAPClient $Mail::IMAPClient::VERSION\n"; + ##if ($Mail::IMAPClient::VERSION eq '2.2.9') { + if ($Mail::IMAPClient::VERSION eq '3.31') { + override_imapclient2(); + return(1); + } + else{ + # 3.x.x is no longer buggy with imapsync. + if ($allow3xx) { + return(1); + }else{ + return(0); + } + } +} + +sub modules_VERSION { + + my @list_version; + + foreach my $module (qw( +Mail::IMAPClient +IO::Socket +IO::Socket::INET +IO::Socket::SSL +Digest::MD5 +Digest::HMAC_MD5 +Term::ReadKey +Authen::NTLM)) + { + my $v = "?"; + + if (eval "require $module") { + # module is here + $v = eval "\$${module}::VERSION"; + }else{ + # no module + $v = "?"; + } + #print ("$module ", $v, "\n"); + push (@list_version, sprintf("%-20s %s\n", $module, $v)); + } + return(@list_version); +} + +# Construct a command line copy with passwords replaced by MASKED. +sub command_line_nopassword { + my @argv_copy = @_; + my @argv_nopassword; + + return("@argv_copy") if $showpasswords ; + while (@argv_copy) { + my $arg = shift(@argv_copy); # option name or value + if ($arg =~ m/-password[12]/) { + shift(@argv_copy); # password value + push(@argv_nopassword, $arg, "MASKED"); # option name and fake value + }else{ + push(@argv_nopassword, $arg); # same option or value + } + } + return("@argv_nopassword"); +} + +sub tests_command_line_nopassword { + + ok('' eq command_line_nopassword(), 'command_line_nopassword void'); + ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla'); + #print command_line_nopassword((qw{ --password1 secret1 })), "\n"; + ok('--password1 MASKED' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1'); + ok('--blabla --password1 MASKED --blibli' + eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli'); + $showpasswords = 1 ; + ok('' eq command_line_nopassword(), 'command_line_nopassword void'); + ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla'); + #print command_line_nopassword((qw{ --password1 secret1 })), "\n"; + ok('--password1 secret1' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1'); + ok('--blabla --password1 secret1 --blibli' + eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli'); + +} + +sub ask_for_password { + my ($user, $host) = @_; + print "What's the password for $user\@$host? "; + Term::ReadKey::ReadMode(2); + my $password = <>; + chomp $password; + printf "\n"; + Term::ReadKey::ReadMode(0); + return $password; +} + +sub catch_exit { + my $signame = shift ; + print "\nGot a SIG$signame!\n" ; + stats( ) ; + exit_clean( 6 ) ; +} + +sub catch_continue { + my $signame = shift ; + print "\nGot a SIG$signame!\n" ; +} + +sub myconnect { + my $self = shift; + + $debug and print "Entering myconnect\n"; + %$self = (%$self, @_); + + my $sock = (($self->Ssl) ? IO::Socket::SSL->new : IO::Socket::INET->new); + my $dp = ($self->Ssl ? 'imaps(993)' : 'imap(143)'); + + $debug and print "Calling configure\n"; + my $ret = $sock->configure({ + PeerAddr => $self->Server , + PeerPort => $self->Port||$dp , + Proto => 'tcp' , + Timeout => $self->Timeout||0 , + Debug => $self->Debug , + }); + unless ( defined($ret) ) { + $self->LastError( "$@\n"); + $@ = "$@"; + carp "$@" + unless defined wantarray; + return undef; + } + $sock->autoflush(1); + + my $banner = $sock->getline(); + $debug and print "Read: $banner"; + + $self->Banner($banner); + $self->RawSocket2($sock); + $self->State(Connected); + if ($banner =~ /\* PREAUTH/) + { + $self->State(Authenticated); + } + if ($self->Tls) { + starttls($self); + $self->Starttls( 1 ) ; + } + + $self->Ignoresizeerrors($allowsizemismatch); + + if ($self->User and $self->Password) { + $debug and print "Calling login\n"; + return $self->login ; + } + else { + return $self; + } +} + + + + +sub starttls { + my $self = shift; + my $socket = $self->RawSocket2(); + + $debug and print "Entering starttls\n"; + unless ($self->has_capability("STARTTLS")) { + die_clean( "No STARTTLS capability" ); + } + + print $socket "z00 STARTTLS\015\012"; + CORE::select( undef, undef, undef, 0.025 ); + my $txt = $socket->getline(); + $debug and print "Read tls: $txt"; + unless($txt =~ /^z00 OK/){ + die_clean( "Invalid response for STARTTLS: $txt\n" ); + } + $debug and print "Calling start_SSL\n"; + unless(IO::Socket::SSL->start_SSL($socket, + { + SSL_version => "TLSV1", + SSL_startHandshake => 1, + SSL_verify_depth => 1, + })) + { + die_clean( "Couldn't start TLS: ".IO::Socket::SSL::errstr()."\n"); + } + if (ref($socket) ne "IO::Socket::SSL") { + die_clean( "Socket has NOT been converted to SSL"); + }else{ + $debug and print "Socket successfuly converted to SSL\n"; + } + $debug and print "Ending starttls\n"; +} + + + +sub connect_imap { + my($host, $port, $debugimap, $ssl, $tls) = @_; + my $imap = Mail::IMAPClient->new(); + $imap->Ssl($ssl) if ($ssl); + $imap->Tls($tls) if ($tls); + $imap->Server($host); + $imap->Port($port); + $imap->Debug($debugimap); + #$imap->connect() + myconnect($imap) + or die_clean("Can not open imap connection on [$host]: $@\n"); +} + +sub justconnect { + my $imap1 = (); + my $imap2 = (); + + $imap1 = connect_imap($host1, $port1, $debugimap1, $ssl1, $tls1); + print "Host1 software: ", server_banner($imap1); + print "Host1 capability: ", join(" ", $imap1->capability()), "\n"; + $imap2 = connect_imap($host2, $port2, $debugimap2, $ssl2, $tls2); + print "Host2 software: ", server_banner($imap2); + print "Host2 capability: ", join(" ", $imap2->capability()), "\n"; + $imap1->logout(); + $imap2->logout(); + +} + +sub relogin1 { + $imap1 = relogin_imap( + $imap1, + $host1, $port1, $user1, $domain1, $password1, + $debugimap1, $timeout, $fastio1, $ssl1, $tls1, + $authmech1, $authuser1, $reconnectretry1, + $proxyauth1, $uid1, $split1) ; + + $relogin1-- if ( $relogin1 ) ; +} + +sub relogin2 { + $imap2 = relogin_imap( + $imap2, + $host2, $port2, $user2, $domain2, $password2, + $debugimap2, $timeout, $fastio2, $ssl2, $tls2, + $authmech2, $authuser2, $reconnectretry2, + $proxyauth2, $uid2, $split2) ; + + $relogin2-- if ( $relogin2 ) ; +} + +sub relogin_imap { + my($imap, + $host, $port, $user, $domain, $password, + $debugimap, $timeout, $fastio, + $ssl, $tls, $authmech, $authuser, $reconnectretry, + $proxyauth, $uid, $split) = @_; + + my $folder_current = $imap->Folder ; + $imap->logout( ) ; + $imap = login_imap( + $host, $port, $user, $domain, $password, + $debugimap, $timeout, $fastio, + $ssl, $tls, $authmech, $authuser, $reconnectretry, + $proxyauth, $uid, $split + ) ; + $imap->select( $folder_current ) if defined( $folder_current ) ; + return( $imap ) ; +} + +sub login_imap { + my($host, $port, $user, $domain, $password, + $debugimap, $timeout, $fastio, + $ssl, $tls, $authmech, $authuser, $reconnectretry, + $proxyauth, $uid, $split ) = @_; + my ($imap); + + $imap = Mail::IMAPClient->new(); + + $imap->Ssl($ssl) if ($ssl); + $imap->Tls($tls) if ($tls); + $imap->Clear(1); + $imap->Server($host); + $imap->Port($port); + $imap->Fast_io($fastio); + $imap->Buffer($buffersize || 4096); + $imap->Uid($uid); + #$imap->Uid(0); + $imap->Peek(1); + $imap->Debug($debugimap); + $timeout and $imap->Timeout($timeout); + + $imap->Reconnectretry($reconnectretry) if ($reconnectretry); + + #$imap->connect() + myconnect($imap) + or die_clean("Failure: can not open imap connection on [$host] with user [$user]: $@\n"); + + print "Banner: ", server_banner($imap); + + if ( $authmech eq 'PREAUTH' ) { + if ( $imap->IsAuthenticated( ) ) { + $imap->Socket ; + printf("Info: Assuming PREAUTH for host %s\n", $imap->Server ) ; + }else{ + die_clean( "Failure: error login on [$host] with user [$user] auth [PREAUTH]" ) ; + } + } + + if ($imap->has_capability("AUTH=$authmech") + or $imap->has_capability($authmech) + ) { + printf("Info: host %s says it has CAPABILITY for AUTHENTICATE %s\n", + $imap->Server, $authmech); + } + else { + printf("Info: host %s says it has NO CAPABILITY for AUTHENTICATE %s\n", + $imap->Server, $authmech); + if ($authmech eq 'PLAIN') { + print "Info: frequently PLAIN is only supported with SSL, ", + "try --ssl or --tls options\n"; + } + } + + if ($proxyauth) { + $imap->Authmechanism(""); + } else { + $imap->Authmechanism( $authmech ) unless ( $authmech eq 'LOGIN' or $authmech eq 'PREAUTH' ) ; + } + + $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; + $imap->Authcallback(\&xgwtrustedappauth) if $authmech eq "XGWTRUSTEDAPP"; + + + if ($proxyauth) { + $imap->User($authuser); + $imap->Domain($domain) if (defined($domain)); + $imap->Authuser($authuser); + $imap->Password($password); + } else { + $imap->User($user); + $imap->Domain($domain) if (defined($domain)); + $imap->Authuser($authuser); + $imap->Password($password); + } + + unless ( $authmech eq 'PREAUTH' or $imap->login( ) ) { + my $info = "Failure: error login on [$host] with user [$user] auth" ; + my $einfo = $imap->LastError || @{$imap->History}[-1] ; + chomp( $einfo ) ; + my $error = "$info [$authmech]: $einfo\n" ; + if ( $authmech eq 'LOGIN' or $imap->IsUnconnected( ) or $authuser ) { + die_clean( $error ) ; + }else{ + print $error ; + } + print "Info: trying LOGIN Auth mechanism on [$host] with user [$user]\n" ; + $imap->Authmechanism("") ; + $imap->login() or + die_clean("$info [LOGIN]: ", $imap->LastError, "\n") ; + } + $proxyauth && $imap->proxyauth($user); + $split and $imap->Split( $split ) ; + + print "Info: success login on [$host] with user [$user] auth [$authmech]\n"; + return($imap); +} + + +sub plainauth() { + my $code = shift; + my $imap = shift; + + my $string = sprintf("%s\x00%s\x00%s", $imap->User, + $imap->Authuser, $imap->Password); + return encode_base64("$string", ""); +} + +sub xgwtrustedappauth() { + my $code = shift; + my $imap = shift; + + my $string = 'XGWTRUSTEDAPP ' . encode_base64(sprintf("%s\x00%s", $imap->Authuser, $imap->Password), ""); + + return $string; +} + + +sub server_banner { + my $imap = shift; + my $banner = $imap->Banner() || "No banner\n"; + return $banner; + } + + +sub banner_imapsync { + + my @argv_copy = @_; + my $banner_imapsync = join("", + '$RCSfile: imapsync,v $ ', + '$Revision: 1.516 $ ', + '$Date: 2012/11/02 22:15:04 $ ', + "\n",localhost_info(), "\n", + "Command line used:\n", + "$0 ", command_line_nopassword(@argv_copy), "\n", + ); +} + +sub is_valid_directory { + my $dir = shift; + return(1) if (-d $dir and -r _ and -w _); + # Trying to create it + mkpath($dir) or die "Error creating tmpdir $tmpdir : $!"; + die "Error with tmpdir $tmpdir : $!" if not (-d $dir and -r _ and -w _); + return(1); +} + + +sub write_pidfile { + my $pidfile = shift ; + + print "PID file is $pidfile\n" ; + if ( -e $pidfile and $pidfilelocking ) { + print "$pidfile already exists, another imapsync may be curently running. Aborting imapsync.\n" ; + exit( 8 ) ; + } + if ( -e $pidfile ) { + print "$pidfile already exists, overwriting it\n" ; + } + open( PIDFILE, ">$pidfile" ) or do { + print "Could not open $pidfile for writing" ; + return undef ; + } ; + + print PIDFILE $PROCESS_ID ; + close PIDFILE ; + return( $PROCESS_ID ) ; +} + +sub exit_clean { + my $status = shift ; + $status = defined( $status ) ? $status : 1 ; + unlink( $pidfile ) ; + exit( $status ) ; +} + +sub die_clean { + unlink( $pidfile ) ; + die @_ ; +} + +sub missing_option { + my ($option) = @_; + die_clean("$option option must be used, run $0 --help for help\n"); +} + + +sub select_folder { + my ( $imap, $folder, $hostside ) = @_ ; + if ( ! $imap->select( $folder ) ) { + print + "$hostside folder $folder: Could not select: ", + $imap->LastError, "\n" ; + $nb_errors++ ; + return( 0 ) ; + }else{ + # ok select succeeded + return( 1 ) ; + } +} + +sub examine_folder { + my ( $imap, $folder, $hostside ) = @_ ; + if ( ! $imap->examine( $folder ) ) { + print + "$hostside folder $folder: Could not examine: ", + $imap->LastError, "\n" ; + $nb_errors++ ; + return( 0 ) ; + }else{ + # ok examine succeeded + return( 1 ) ; + } +} + + +sub create_folder { + my( $imap2, $h2_fold, $h1_fold ) = @_ ; + + print "Creating folder [$h2_fold] on host2\n"; + if ( ( 'INBOX' eq uc( $h2_fold) ) + and ( $imap2->exists( $h2_fold ) ) ) { + print "Folder [$h2_fold] already exists\n" ; + return( 1 ) ; + } + if ( ! $dry ){ + if ( ! $imap2->create( $h2_fold ) ) { + print( "Couldn't create folder [$h2_fold] from [$h1_fold]: ", + $imap2->LastError( ), "\n" ); + $nb_errors++; + # success if folder exists ("already exists" error) + return( 1 ) if $imap2->exists( $h2_fold ) ; + # failure since create failed + return( 0 ); + }else{ + #create succeeded + return( 1 ); + } + }else{ + # dry mode, no folder so many imap will fail, assuming failure + return( 0 ); + } +} + + + +sub tests_folder_routines { + ok( !is_requested_folder('folder_foo') ); + ok( add_to_requested_folders('folder_foo') ); + ok( is_requested_folder('folder_foo') ); + ok( !is_requested_folder('folder_NO_EXIST') ); + ok( !remove_from_requested_folders('folder_foo'), "removed folder_foo"); + ok( !is_requested_folder('folder_foo') ); + my @f; + ok( @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f"); + ok( is_requested_folder('folder_bar') ); + ok( is_requested_folder('folder_toto') ); + ok( remove_from_requested_folders('folder_toto') ); + ok( !is_requested_folder('folder_toto') ); +} + + +sub is_requested_folder { + my ( $folder ) = @_; + + defined( $requested_folder{ $folder } ); +} + + +sub add_to_requested_folders { + my @wanted_folders = @_; + + foreach my $folder ( @wanted_folders ) { + ++$requested_folder{ $folder }; + } + return( keys( %requested_folder ) ); +} + +sub remove_from_requested_folders { + my @wanted_folders = @_; + + foreach my $folder (@wanted_folders) { + delete $requested_folder{$folder}; + } + return( keys(%requested_folder) ); +} + +sub compare_lists { + my ($list_1_ref, $list_2_ref) = @_; + + return(-1) if ((not defined($list_1_ref)) and defined($list_2_ref)); + return(0) if ((not defined($list_1_ref)) and not defined($list_2_ref)); # end if no list + return(1) if (not defined($list_2_ref)); # end if only one list + + if (not ref($list_1_ref)) {$list_1_ref = [$list_1_ref]}; + if (not ref($list_2_ref)) {$list_2_ref = [$list_2_ref]}; + + + my $last_used_indice = -1; + #print "\$#$list_1_ref:", $#$list_1_ref, "\n"; + #print "\$#$list_2_ref:", $#$list_2_ref, "\n"; + ELEMENT: + foreach my $indice ( 0 .. $#$list_1_ref ) { + $last_used_indice = $indice; + + # End of list_2 + return 1 if ($indice > $#$list_2_ref); + + my $element_list_1 = $list_1_ref->[$indice]; + my $element_list_2 = $list_2_ref->[$indice]; + my $balance = $element_list_1 cmp $element_list_2 ; + next ELEMENT if ($balance == 0) ; + return $balance; + } + # each element equal until last indice of list_1 + return -1 if ($last_used_indice < $#$list_2_ref); + + # same size, each element equal + return 0 +} + +sub tests_compare_lists { + + + my $empty_list_ref = []; + + ok( 0 == compare_lists() , 'compare_lists, no args'); + ok( 0 == compare_lists(undef) , 'compare_lists, undef = nothing'); + ok( 0 == compare_lists(undef, undef) , 'compare_lists, undef = undef'); + ok(-1 == compare_lists(undef , []) , 'compare_lists, undef < []'); + ok(-1 == compare_lists(undef , [1]) , 'compare_lists, undef < [1]'); + ok(-1 == compare_lists(undef , [0]) , 'compare_lists, undef < [0]'); + ok(+1 == compare_lists([]) , 'compare_lists, [] > nothing'); + ok(+1 == compare_lists([], undef) , 'compare_lists, [] > undef'); + ok( 0 == compare_lists([] , []) , 'compare_lists, [] = []'); + + ok(-1 == compare_lists([] , [1]) , 'compare_lists, [] < [1]'); + ok(+1 == compare_lists([1] , []) , 'compare_lists, [1] > []'); + + + ok( 0 == compare_lists([1], 1 ) , "compare_lists, [1] = 1 ") ; + ok( 0 == compare_lists( 1 , [1]) , "compare_lists, 1 = [1]") ; + ok( 0 == compare_lists( 1 , 1 ) , "compare_lists, 1 = 1 ") ; + ok(-1 == compare_lists( 0 , 1 ) , "compare_lists, 0 < 1 ") ; + ok(-1 == compare_lists(-1 , 0 ) , "compare_lists, -1 < 0 ") ; + ok(-1 == compare_lists( 1 , 2 ) , "compare_lists, 1 < 2 ") ; + ok(+1 == compare_lists( 2 , 1 ) , "compare_lists, 2 > 1 ") ; + + + ok( 0 == compare_lists([1,2], [1,2]) , "compare_lists, [1,2] = [1,2]") ; + ok(-1 == compare_lists([1], [1,2]) , "compare_lists, [1] < [1,2]") ; + ok(+1 == compare_lists([2], [1,2]) , "compare_lists, [2] > [1,2]") ; + ok(-1 == compare_lists([1], [1,1]) , "compare_lists, [1] < [1,1]") ; + ok(+1 == compare_lists([1, 1], [1]) , "compare_lists, [1, 1] > [1]") ; + ok( 0 == compare_lists([1 .. 20_000] , [1 .. 20_000]) + , "compare_lists, [1..20_000] = [1..20_000]") ; + ok(-1 == compare_lists([1], [3]) , 'compare_lists, [1] < [3]') ; + ok( 0 == compare_lists([2], [2]) , 'compare_lists, [0] = [2]') ; + ok(+1 == compare_lists([3], [1]) , 'compare_lists, [3] > [1]') ; + + ok(-1 == compare_lists(["a"], ["b"]) , 'compare_lists, ["a"] < ["b"]') ; + ok( 0 == compare_lists(["a"], ["a"]) , 'compare_lists, ["a"] = ["a"]') ; + ok( 0 == compare_lists(["ab"], ["ab"]) , 'compare_lists, ["ab"] = ["ab"]') ; + ok(+1 == compare_lists(["b"], ["a"]) , 'compare_lists, ["b"] > ["a"]') ; + ok(-1 == compare_lists(["a"], ["aa"]) , 'compare_lists, ["a"] < ["aa"]') ; + ok(-1 == compare_lists(["a"], ["a", "a"]), 'compare_lists, ["a"] < ["a", "a"]') ; + ok( 0 == compare_lists([split(" ", "a b")], ["a", "b"]), 'compare_lists, split') ; + ok( 0 == compare_lists([sort split(" ", "b a")], ["a", "b"]), 'compare_lists, sort split') ; +} + + + +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", + help_to_guess_prefix($imap, $prefix_opt); + exit_clean(1); + } +} + + +sub get_separator { + my($imap, $sep_in, $sep_opt) = @_; + my($sep_out); + + + if ( defined( $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) if defined $sep_out; + print + "NAMESPACE request failed for ", + $imap->Server(), ": ", $imap->LastError, "\n", + help_to_guess_sep( $imap, $sep_opt ) ; + exit_clean(1); + } + else{ + print + "No NAMESPACE capability in imap server ", + $imap->Server(),"\n", + help_to_guess_sep($imap, $sep_opt); + exit_clean(1); + } +} + +sub help_to_guess_sep { + my($imap, $sep_opt) = @_; + + my $help = "Give the separator character with the $sep_opt option,\n" + . "the folowing listing of folders may help you to find it:\n" + . folders_list_to_help($imap) + . "Most of the time it is character . or /\n" + . "so try $sep_opt . or $sep_opt /\n"; + + return($help); +} + +sub help_to_guess_prefix { + my($imap, $prefix_opt) = @_; + + my $help = "Give the prefix namespace with the $prefix_opt option,\n" + . "the folowing listing of folders may help you to find it:\n" + . folders_list_to_help($imap) + . "Most of the time it is INBOX. or an empty string\n" + . "so try $prefix_opt INBOX. or $prefix_opt ''\n"; + + return($help); +} + + +sub folders_list_to_help { + my($imap) = @_; + + my @folders = $imap->folders; + my $listing = join('', map { "[$_]\n" } @folders); + return $listing; + +} + +sub separator_invert { + # The separator we hope we'll never encounter: 00000000 + my $o_sep="\000" ; + + my($h1_fold, $h1_sep, $h2_sep) = @_ ; + + my $h2_fold = $h1_fold ; + $h2_fold =~ s@\Q$h2_sep@$o_sep@g ; + $h2_fold =~ s@\Q$h1_sep@$h2_sep@g ; + $h2_fold =~ s@\Q$o_sep@$h1_sep@g ; + $h2_fold =~ s,/,_,g if( $fixslash2 and '/' ne $h2_sep and '/' eq $h1_sep ) ; + return( $h2_fold ) ; +} + + +sub tests_imap2_folder_name { + +$h1_prefix = $h2_prefix = ''; +$h1_sep = '/'; +$h2_sep = '.'; + +$debug and print +"prefix1: [$h1_prefix] +prefix2: [$h2_prefix] +sep1:[$h1_sep] +sep2:[$h2_sep] +"; + +$fixslash2 = 0 ; +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam'); +ok('spam/spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam'); +ok('spam.spam/spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam'); +@regextrans2 = ('s,/,X,g'); +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string [s,/,X,g]'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,/,X,g]'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam [s,/,X,g]'); +ok('spamXspam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam [s,/,X,g]'); +ok('spam.spamXspam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam [s,/,X,g]'); + +@regextrans2 = ('s, ,_,g'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s, ,_,g]'); +ok('bla_bla' eq imap2_folder_name('bla bla'), 'imap2_folder_name: blabla [s, ,_,g]'); + +@regextrans2 = ('s,(.*),\U$1,'); +ok('BLABLA' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,\U(.*)\E,$1,]'); + +$fixslash2 = 1 ; +@regextrans2 = ( ) ; +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam -> spam.spam'); +ok('spam_spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam -> spam_spam'); +ok('spam.spam_spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam -> spam.spam_spam'); + +$h1_sep = '.'; +$h2_sep = '/'; +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam -> spam.spam'); +ok('spam/spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam -> spam/spam'); +ok('spam.spam/spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam -> spam.spam/spam'); + + +} + +sub imap2_folder_name { + my ($h2_fold); + my ($x_fold) = @_; + # first we remove the prefix + $x_fold =~ s/^\Q$h1_prefix\E//; + $debug and print "removed host1 prefix: [$x_fold]\n"; + $h2_fold = separator_invert($x_fold,$h1_sep, $h2_sep); + $debug and print "inverted separators: [$h2_fold]\n"; + # Adding the prefix supplied by namespace or the --prefix2 option + $h2_fold = $h2_prefix . $h2_fold + unless(($h2_prefix eq "INBOX" . $h2_sep) and ($h2_fold =~ m/^INBOX$/i)); + $debug and print "added host2 prefix: [$h2_fold]\n"; + + # Transforming the folder name by the --regextrans2 option(s) + foreach my $regextrans2 (@regextrans2) { + my $h2_fold_before = $h2_fold; + eval("\$h2_fold =~ $regextrans2"); + $debug and print "[$h2_fold_before] -> [$h2_fold] using re [$regextrans2]\n"; + die_clean("error: eval regextrans2 '$regextrans2': $@\n") if $@; + } + return($h2_fold); +} + + +sub foldersizes { + + my ( $side, $imap, @folders ) = @_ ; + my $total_size = 0 ; + my $total_nb = 0 ; + my $biggest = 0 ; + + print "++++ Calculating sizes on $side\n" ; + foreach my $folder ( @folders ) { + my $stot = 0 ; + my $nb_msgs = 0 ; + printf( "$side folder %-35s", "[$folder]" ) ; + if ( 'Host2' eq $side and ! exists( $h2_folders_all{ $folder } ) ) { + print(" does not exist yet\n") ; + next ; + } + if ( 'Host1' eq $side and ! exists( $h1_folders_all{ $folder } ) ) { + print( " does not exist\n" ) ; + next ; + } + + unless ( $imap->examine( $folder ) ) { + print + "$side Folder $folder: Could not examine: ", + $imap->LastError, "\n" ; + $nb_errors++ ; + next ; + } + + my $hash_ref = { } ; + my @msgs = select_msgs( $imap ) ; + $nb_msgs = scalar( @msgs ) ; + my $smax = 0 ; + @$hash_ref{ @msgs } = ( undef ) if @msgs ; + if ( $nb_msgs > 0 and @msgs ) { + if ( $abletosearch ) { + $imap->fetch_hash( "RFC822.SIZE", $hash_ref) or die_clean("$@" ) ; + }else{ + $imap->fetch_hash( '1:999999', "RFC822.SIZE", $hash_ref ) or die_clean( "$@" ) ; + } + #print map {$hash_ref->{$_}->{"RFC822.SIZE"}, " "} keys %$hash_ref ; + map { $stot += $hash_ref->{ $_ }->{ "RFC822.SIZE" } } keys %$hash_ref ; + $smax = max( map { $hash_ref->{ $_ }->{ "RFC822.SIZE" } } keys %$hash_ref ) ; + $biggest = max( $biggest, $smax ) ; + } + + printf( " Size: %9s", $stot ) ; + printf( " Messages: %5s", $nb_msgs ) ; + printf( " Biggest: %9s\n", $smax ) ; + $total_size += $stot ; + $total_nb += $nb_msgs ; + } + printf ( "%s Nb messages: %11s messages\n", $side, $total_nb ) ; + printf ( "%s Total size: %11s bytes (%s)\n", $side, $total_size, bytes_display_string( $total_size ) ) ; + printf ( "%s Biggest message: %11s bytes (%s)\n", $side, $biggest, bytes_display_string( $biggest ) ) ; + printf ( "%s Time spent: %11.1f seconds\n", $side, timenext( ) ) ; + return( $total_nb, $total_size ) ; +} + +sub timenext { + my ( $timenow, $timediff ) ; + # $timebefore is global, beurk ! + $timenow = time ; + $timediff = $timenow - $timebefore ; + $timebefore = $timenow ; + return( $timediff ) ; +} + +sub timesince { + my $timeinit = shift ; + my ( $timenow, $timediff ) ; + $timenow = time ; + $timediff = $timenow - $timeinit ; + return( $timediff ) ; +} + + + + +sub tests_flags_regex { + + my $string; + ok('' eq flags_regex(''), "flags_regex, null string ''"); + ok('\Seen NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, nothing to do'); + ok('\Seen NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex,'); + @regexflag = ('s/NonJunk//g'); + ok('\Seen $Spam' eq flags_regex('\Seen NonJunk $Spam'), "flags_regex, remove NonJunk: 's/NonJunk//g'"); + @regexflag = ('s/\$Spam//g'); + ok('\Seen NonJunk ' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, remove $Spam: '."'s/\$Spam//g'"); + + @regexflag = ('s/\\\\Seen//g'); + + ok(' NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, remove \Seen: '. "'s/\\\\\\\\Seen//g'"); + + @regexflag = ('s/(\s|^)[^\\\\]\w+//g'); + ok('\Seen \Middle \End' eq flags_regex('\Seen NonJunk \Middle $Spam \End'), 'flags_regex, only \word [' . flags_regex('\Seen NonJunk \Middle $Spam \End'.']')); + ok(' \Seen \Middle \End1' eq flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'), 'flags_regex, only \word [' . flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'.']')); + + @regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g'); + ok('Keep1 Keep2 ReB' eq flags_regex('ReA Keep1 REM Keep2 ReB'), "Keep only regex"); + #ok('Keep1 Keep2' eq flags_regex('Keep1 Keep2 Remove1'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM REM Keep1 Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM Keep1'), "Keep only regex"); + + @regexflag = ('s/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g'); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 ReB'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 REM REM REM'), "Keep only regex"); + ok('Keep2 ' eq flags_regex('Keep2 REM REM REM'), "Keep only regex"); + #ok('' eq flags_regex('REM REM'), "Keep only regex"); + + @regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g', + 's/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g'); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM REM Keep1 REM REM REM '), "Keep only regex"); + ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex"); + + @regexflag = ('s/(.*)/$1 jrdH8u/'); + ok('REM REM REM REM REM jrdH8u' eq flags_regex('REM REM REM REM REM'), "Keep only regex 's/(.*)/\$1 jrdH8u/'"); + @regexflag = ('s/jrdH8u *//'); + ok('REM REM REM REM REM ' eq flags_regex('REM REM REM REM REM jrdH8u'), "Keep only regex s/jrdH8u *//"); + + @regexflag = ( + 's/(.*)/$1 jrdH8u/', + 's/.*?(Keep1|Keep2|Keep3|jrdH8u)/$1 /g', + 's/(Keep1|Keep2|Keep3|jrdH8u) (?!(Keep1|Keep2|Keep3|jrdH8u)).*/$1 /g', + 's/jrdH8u *//' + ); + + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex 'REM Keep1 REM Keep2 REM'"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM REM Keep1 REM REM REM '), "Keep only regex"); + ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex"); + ok('' eq flags_regex('REM REM REM REM REM'), "Keep only regex"); + + @regexflag = ( + 's/(.*)/$1 jrdH8u/', + 's/.*?(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)/$1 /g', + 's/(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u) (?!(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)).*/$1 /g', + 's/jrdH8u *//' + ); + + ok('\\Deleted \\Answered ' + eq flags_regex('Blabla $Junk \\Deleted machin \\Answered truc'), "Keep only regex: Exchange case"); + ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string"); + ok('' + eq flags_regex('Blabla $Junk machin truc'), "Keep only regex: Exchange case, no accepted flags "); + ok('\\Deleted \\Answered \\Draft \\Flagged ' + eq flags_regex('\\Deleted \\Answered \\Draft \\Flagged '), "Keep only regex: Exchange case"); + + + @regexflag = ( + 's/.*?(?:(\\\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg' + ); + + ok('\\Deleted \\Answered ' + eq flags_regex('Blabla \$Junk \\Deleted machin \\Answered truc'), + "Keep only regex: Exchange case (Phil)"); + + ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string (Phil)"); + + ok('' + eq flags_regex('Blabla $Junk machin truc'), + "Keep only regex: Exchange case, no accepted flags (Phil)"); + + ok('\\Deleted \\Answered \\Draft \\Flagged ' + eq flags_regex('\\Deleted \\Answered \\Draft \\Flagged '), + "Keep only regex: Exchange case (Phil)"); + + +} + +sub flags_regex { + my ($h1_flags) = @_; + foreach my $regexflag (@regexflag) { + my $h1_flags_orig = $h1_flags; + $debugflags and print "eval \$h1_flags =~ $regexflag\n"; + eval("\$h1_flags =~ $regexflag"); + die_clean("error: eval regexflag '$regexflag': $@\n") if $@; + $debugflags and print "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n"; + } + return($h1_flags); +} + +sub acls_sync { + my($h1_fold, $h2_fold) = @_; + if ($syncacls) { + my $h1_hash = $imap1->getacl($h1_fold) + or print "Could not getacl for $h1_fold: $@\n"; + my $h2_hash = $imap2->getacl($h2_fold) + or print "Could not getacl for $h2_fold: $@\n"; + my %users = map({ ($_, 1) } (keys(%$h1_hash), keys(%$h2_hash))); + foreach my $user (sort(keys(%users))) { + my $acl = $h1_hash->{$user} || "none"; + print "acl $user: [$acl]\n"; + next if ($h1_hash->{$user} && $h2_hash->{$user} && + $h1_hash->{$user} eq $h2_hash->{$user}); + unless ($dry) { + print "setting acl $h2_fold $user $acl\n"; + $imap2->setacl($h2_fold, $user, $acl) + or print "Could not set acl: $@\n"; + } + } + } +} + + +sub tests_permanentflags { + + my $string; + ok('' eq permanentflags(' * OK [PERMANENTFLAGS (\* \Draft \Answered)] Limited'), + 'permanentflags \*'); + ok('\Draft \Answered' eq permanentflags(' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited'), + 'permanentflags \Draft \Answered'); + ok('\Draft \Answered' + eq permanentflags('Blabla', + ' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited', + 'Blabla'), + 'permanentflags \Draft \Answered' + ); + ok('' eq permanentflags('Blabla'), 'permanentflags nothing'); +} + +sub permanentflags { + my @lines = @_ ; + + foreach my $line (@lines) { + if ( $line =~ m{\[PERMANENTFLAGS \(([^)]+?)\)\]} ) { + ( $debugflags or $debug ) and print "permanentflags: $line" ; + my $permanentflags = $1 ; + if ( $permanentflags =~ m{\\\*} ) { + $permanentflags = '' ; + } + return($permanentflags) ; + }; + } +} + +sub tests_flags_filter { + + ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' ); + ok( '' eq flags_filter('\Seen', '\Draft \Answered'), 'flags_filter ' ); + ok( '\Seen' eq flags_filter('\Seen', '\Seen'), 'flags_filter ' ); + ok( '\Seen' eq flags_filter('\Seen', ' \Seen '), 'flags_filter ' ); + ok( '\Seen \Draft' + eq flags_filter('\Seen \Draft', '\Draft \Seen \Answered'), 'flags_filter ' ); + ok( '\Seen \Draft' + eq flags_filter('\Seen \Draft', ' \Draft \Seen \Answered '), 'flags_filter ' ); + +} + +sub flags_filter { + my($flags, $allowed_flags) = @_; + + my @flags = split(/\s+/, $flags); + my %allowed_flags = map { $_ => 1 } split(' ', $allowed_flags ); + my @flags_out = map { exists $allowed_flags{$_} ? $_ : () } @flags; + + my $flags_out = join(' ', @flags_out); + #print "%%%$flags_out%%%\n"; + return($flags_out); +} + +sub flagsCase { + my $flags = shift ; + + my @flags = split( /\s+/, $flags ); + my %rfc_flags = map { $_ => 1 } split(' ', '\Answered \Flagged \Deleted \Seen \Draft' ); + my @flags_out = map { exists $rfc_flags{ ucsecond( lc( $_ ) ) } ? ucsecond( lc( $_ ) ) : $_ } @flags ; + + my $flags_out = join( ' ', @flags_out ) ; + #print "%%%$flags_out%%%\n" ; + return( $flags_out ) ; +} + +sub tests_flagsCase { + ok( '\Seen' eq flagsCase( '\Seen' ), 'flagsCase: \Seen -> \Seen' ) ; + ok( '\Seen' eq flagsCase( '\SEEN' ), 'flagsCase: \SEEN -> \Seen' ) ; + + ok( '\Seen \Draft' eq flagsCase( '\SEEN \DRAFT' ), 'flagsCase: \SEEN \DRAFT -> \Seen \Draft' ) ; + ok( '\Draft \Seen' eq flagsCase( '\DRAFT \SEEN' ), 'flagsCase: \DRAFT \SEEN -> \Draft \Seen' ) ; + + ok( '\Draft LALA \Seen' eq flagsCase( '\DRAFT LALA \SEEN' ), 'flagsCase: \DRAFT LALA \SEEN -> \Draft LALA \Seen' ) ; + ok( '\Draft lala \Seen' eq flagsCase( '\DRAFT lala \SEEN' ), 'flagsCase: \DRAFT lala \SEEN -> \Draft lala \Seen' ) ; +} + +sub ucsecond { + my $string = shift ; + my $output ; + + return( $string ) if ( 1 >= length( $string ) ) ; + $output = substr( $string, 0, 1) . uc( substr( $string, 1, 1 ) ) if ( 2 == length( $string ) ) ; + $output = substr( $string, 0, 1) . uc( substr( $string, 1, 1 ) ) . substr( $string, 2 ); + #print "UUU $string -> $output\n" ; + return( $output ) ; +} + + +sub tests_ucsecond { + ok( 'aBcde' eq ucsecond( 'abcde' ), 'ucsecond: abcde -> aBcde' ) ; + ok( 'ABCDE' eq ucsecond( 'ABCDE' ), 'ucsecond: ABCDE -> ABCDE' ) ; + ok( 'ABCDE' eq ucsecond( 'AbCDE' ), 'ucsecond: AbCDE -> ABCDE' ) ; + ok( 'ABCde' eq ucsecond( 'AbCde' ), 'ucsecond: AbCde -> ABCde' ) ; + ok( 'A' eq ucsecond( 'A' ), 'ucsecond: A -> A' ) ; + ok( 'AB' eq ucsecond( 'Ab' ), 'ucsecond: Ab -> AB' ) ; + ok( '\B' eq ucsecond( '\b' ), 'ucsecond: \b -> \B' ) ; + ok( '\Bcde' eq ucsecond( '\bcde' ), 'ucsecond: \bcde -> \Bcde' ) ; +} + +sub select_msgs { + my ( $imap, $msgs_all_hash_ref ) = @_ ; + my ( @msgs, @msgs_all, @max, @min, @union, @inter ) ; + + # Need to have the whole list in msgs_all_hash_ref + # without calling messages() several times. + if ( defined( $msgs_all_hash_ref ) + or ( ! defined( $maxage ) and ! defined( $minage ) and ! defined( $search ) ) + ) { + if ( $abletosearch ) { + $debugdev and print "Calling messages()\n" ; + @msgs = $imap->messages() ; + }else{ + $debugdev and print "Calling fetch_hash()\n" ; + @msgs = sort { $a <=> $b } keys( %{$imap->fetch_hash( '1:999999', "RFC822.SIZE")} ) ; + } + $debugdev and print "Done fetch_hash()\n" ; + + if ( defined( $msgs_all_hash_ref ) ) { + @msgs_all = @msgs ; + @{ $msgs_all_hash_ref }{ @msgs_all } = () ; + } + # return all messages + if ( ! defined( $maxage ) and ! defined( $minage ) and ! defined( $search ) ) { + return( @msgs ) ; + } + } + + if ( defined( $search ) ) { + @msgs = $imap->search( $search ) ; + return( @msgs ) ; + } + + if ( defined( $maxage ) ) { + @max = $imap->sentsince( $timestart_int - 86400 * $maxage ) ; + } + if ( defined($minage ) ) { + @min = $imap->sentbefore( $timestart_int - 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}++ } + @inter = keys( %inter ) ; + @union = keys( %union ) ; + # normal case + if ( $minage <= $maxage ) { @msgs = @inter ; last SWITCH } ; + # just exclude messages between + if ( $minage > $maxage ) { @msgs = @union ; last SWITCH } ; + + } + return(@msgs); +} + + +sub lastuid { + my $imap = shift ; + my $folder = shift ; + my $lastuid_guess = shift ; + my $lastuid ; + + # rfc3501: The only reliable way to identify recent messages is to + # look at message flags to see which have the \Recent flag + # set, or to do a SEARCH RECENT. + # SEARCH RECENT doesn't work this way on courrier. + + my @recent_messages ; + # SEARCH RECENT for each transfer can be expensive with a big folder + # Call commented for now + #@recent_messages = $imap->recent( ) ; + #print "Recent: @recent_messages\n"; + + my $max_recent ; + $max_recent = max( @recent_messages ) ; + + if ( defined( $max_recent ) and ($lastuid_guess <= $max_recent ) ) { + $lastuid = $max_recent ; + }else{ + $lastuid = $lastuid_guess + } + return( $lastuid ) ; +} + +sub size_filtered { + my( $h1_size, $h1_msg, $h1_fold, $h2_fold ) = @_ ; + + $h1_size = 0 if ( ! $h1_size ) ; # null if empty or undef + if (defined $maxsize and $h1_size >= $maxsize) { + print "msg $h1_fold/$h1_msg skipped ($h1_size exceeds maxsize limit $maxsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + return( 1 ) ; + } + if (defined $minsize and $h1_size <= $minsize) { + print "msg $h1_fold/$h1_msg skipped ($h1_size smaller than minsize $minsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + return( 1 ) ; + } + return( 0 ) ; +} + +sub message_exists { + + my( $imap, $msg ) = @_ ; + return( 1 ) if not $imap->Uid( ) ; + + my $search ; + ( $search ) = $imap->search( "UID $msg" ) ; + #print "$search ? $msg\n" ; + return( 1 ) if ( $search eq $msg ) ; + return( 0 ) ; + +} + +sub copy_message { + # copy + + my ( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ; + $debug and print "msg $h1_fold/$h1_msg copying to $h2_fold\n"; + + my $h1_size = $h1_fir_ref->{$h1_msg}->{"RFC822.SIZE"} || '' ; + my $h1_flags = $h1_fir_ref->{$h1_msg}->{"FLAGS"} || '' ; + my $h1_idate = $h1_fir_ref->{$h1_msg}->{"INTERNALDATE"} || '' ; + + + if (size_filtered( $h1_size, $h1_msg, $h1_fold, $h2_fold ) ) { + $h1_nb_msg_processed +=1 ; + return( ) ; + } + + my $string; + do { print "SLEEP 5\n" and sleep 5 ; } if ( $debugsleep ) ; + print "- msg $h1_fold/$h1_msg S[$h1_size] F[$h1_flags] I[$h1_idate] has RFC822.SIZE null!\n" if ( ! $h1_size ) ; + + + if ( $checkmessageexists and not message_exists( $imap1, $h1_msg ) ) { + $h1_nb_msg_processed +=1 ; + return( ) ; + } + + $string = $imap1->message_string($h1_msg); + + + my $string_len = defined( $string ) ? length( $string ) : '' ; # length or undef + #print "- msg $h1_fold/$h1_msg {$string_len}\n" ; + unless ( defined( $string ) and $string_len ) { # undef or 0 length + print + "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] could not be fetched: ", + $imap1->LastError, "\n" ; + $nb_errors++ ; + $total_bytes_error += $h1_size if ( $h1_size ) ; + #relogin1( ) if ( $relogin1 ) ; + $h1_nb_msg_processed +=1 ; + return( ) ; + } + + if (@regexmess) { + $string = regexmess($string); + } + + $debugcontent and print + "=" x80, "\n", + "F message content begin next line\n", + $string, + "F message content ended on previous line\n", "=" x 80, "\n"; + my $h1_date = ""; + if ($syncinternaldates) { + $h1_date = $h1_idate; + $debug and print "internal date from host1: [$h1_date]\n"; + $h1_date = good_date($h1_date); + $debug and print "internal date from host1: [$h1_date] (fixed)\n"; + } + + if ($idatefromheader) { + + $h1_date = $imap1->get_header($h1_msg,"Date"); + $debug and print "header date from host1: [$h1_date]\n"; + $h1_date = good_date($h1_date); + $debug and print "header date from host1: [$h1_date] (fixed)\n"; + } + + if ( $addheader and defined $h1_fir_ref->{$h1_msg}->{"NO_HEADER"} ) { + my $header = add_header( $h1_msg ) ; + $debug and print "msg $h1_fold/$h1_msg adding custom header [$header]\n" ; + $string = $header . "\r\n" . $string ; + } + # RFC 2060: This flag can not be altered by any client + $h1_flags =~ s@\\Recent\s?@@gi; + $h1_flags = flags_regex($h1_flags) if @regexflag; + $h1_flags = flagsCase( $h1_flags ) if $flagsCase ; + $h1_flags = flags_filter( $h1_flags, $permanentflags2) if ( $permanentflags2 and $filterflags ) ; + + my $new_id; + $debug and print "msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"; + $h1_date = undef if ($h1_date eq ""); + + unless ($dry) { + $max_msg_size_in_bytes = max($h1_size, $max_msg_size_in_bytes); + $new_id = $imap2->append_string($h2_fold, $string, $h1_flags, $h1_date); + unless($new_id){ + no warnings 'uninitialized'; + print "- msg $h1_fold/$h1_msg {$string_len} couldn't append (Subject:[". + $imap1->subject($h1_msg)."]) to folder $h2_fold: ", + $imap2->LastError, "\n"; + $nb_errors++; + $total_bytes_error += $h1_size; + $h1_nb_msg_processed +=1 ; + return( ) ; + } + else{ + # good + # $new_id is an id if the IMAP server has the + # UIDPLUS capability else just a ref + if ( $new_id !~ m{^\d+$} ) { + $new_id = lastuid( $imap2, $h2_fold, $h2_uidguess ) ; + } + $h2_uidguess += 1 ; + $total_bytes_transferred += $h1_size ; + $nb_msg_transferred += 1 ; + $h1_nb_msg_processed +=1 ; + + my $time_spent = timesince( $begin_transfer_time ) ; + my $rate = bytes_display_string( $total_bytes_transferred / $time_spent ) ; + my $eta = eta( $time_spent, $h1_nb_msg_processed, $h1_nb_msg_start, $nb_msg_transferred ) ; + #my $eta = eta( $time_spent, $nb_msg_transferred, $h1_nb_msg_start ) ; + + printf( "msg %s/%-19s copied to %s/%-10s %.2f msgs/s %s/s %s\n", + $h1_fold, "$h1_msg {$string_len}", $h2_fold, $new_id, $nb_msg_transferred/$time_spent, $rate, $eta ); + + if ( $usecache and $cacheaftercopy and $new_id =~ m{^\d+$} ) { + $debugcache and print "touch $cache_dir/${h1_msg}_$new_id\n" ; + touch( "$cache_dir/${h1_msg}_$new_id" ) + or die( "Couldn't touch $cache_dir/${h1_msg}_$new_id" ) ; + } + if ( $delete ) { + print "msg $h1_fold/$h1_msg deleted on host1\n"; + unless($dry) { + $imap1->delete_message($h1_msg); + $h1_nb_msg_deleted += 1; + $imap1->expunge() if ( $expunge or $expunge1 ); + } + } + #print "PRESS ENTER" and my $a = <> ; + } + } + else{ + $nb_msg_skipped_dry_mode += 1; + $h1_nb_msg_processed +=1 ; + } +} + +sub eta { + + return( '' ) if not $foldersizes ; + + my( $time_spent, $h1_nb_msg_processed, $h1_nb_msg_start, $nb_msg_transferred ) = @_ ; + + my $time_remaining = time_remaining( @_ ) ; + my $nb_msg_remaining = $h1_nb_msg_start - $h1_nb_msg_processed ; + my $eta_date = localtime( time + $time_remaining ) ; + return( sprintf( "ETA: %s %1.0f s %s msgs left", $eta_date, $time_remaining, $nb_msg_remaining ) ) ; + +} + +sub time_remaining { + + my( $time_spent, $h1_nb_msg_processed, $h1_nb_msg_start, $nb_msg_transferred ) = @_ ; + + my $time_remaining = ( $time_spent / $nb_msg_transferred ) * ( $h1_nb_msg_start - $h1_nb_msg_processed ) ; + return( $time_remaining ) ; +} + + +sub tests_time_remaining { + + + ok( 1 == time_remaining( 1, 1, 2, 1 ), "time_remaining: 1, 1, 2, 1 -> 1") ; + ok( 1 == time_remaining( 9, 9, 10, 9 ), "time_remaining: 9, 9, 10, 9 -> 1") ; + ok( 9 == time_remaining( 1, 1, 10, 1 ), "time_remaining: 1, 1, 10, 1 -> 1") ; + +} + + +sub cache_map { + my ( $cache_files_ref, $h1_msgs_ref, $h2_msgs_ref ) = @_; + my ( %map1_2, %map2_1, %done2 ) ; + + my $h1_msgs_hash_ref = { } ; + my $h2_msgs_hash_ref = { } ; + + @$h1_msgs_hash_ref{ @$h1_msgs_ref } = ( ) ; + @$h2_msgs_hash_ref{ @$h2_msgs_ref } = ( ) ; + + foreach my $file ( sort @$cache_files_ref ) { + $debugcache and print "C12: $file\n" ; + ( $uid1, $uid2 ) = match_a_cache_file( $file ) ; + + if ( exists( $h1_msgs_hash_ref->{ defined( $uid1 ) ? $uid1 : q{} } ) + and exists( $h2_msgs_hash_ref->{ defined( $uid2 ) ? $uid2 : q{} } ) ) { + # keep only the greatest uid2 + # 130_2301 and + # 130_231 => keep only 130 -> 2301 + + # keep only the greatest uid1 + # 1601_260 and + # 161_260 => keep only 1601 -> 260 + my $max_uid2 = max( $uid2, $map1_2{ $uid1 } || -1 ) ; + if ( exists( $done2{ $max_uid2 } ) ) { + if ( $done2{ $max_uid2 } < $uid1 ) { + $map1_2{ $uid1 } = $max_uid2 ; + delete( $map1_2{ $done2{ $max_uid2 } } ) ; + $done2{ $max_uid2 } = $uid1 ; + } + }else{ + $map1_2{ $uid1 } = $max_uid2 ; + $done2{ $max_uid2 } = $uid1 ; + } + }; + + } + %map2_1 = reverse( %map1_2 ) ; + return( \%map1_2, \%map2_1) ; +} + +sub tests_cache_map { + #$debugcache = 1 ; + my @cache_files = qw ( + 100_200 + 101_201 + 120_220 + 142_242 + 143_243 + 177_277 + 177_278 + 177_279 + 155_255 + 180_280 + 181_280 + 182_280 + 130_231 + 130_2301 + 161_260 + 1601_260 + ) ; + + my $msgs_1 = [120, 142, 143, 144, 161, 1601, 177, 182, 130 ]; + my $msgs_2 = [ 242, 243, 260, 299, 377, 279, 255, 280, 231, 2301 ]; + + my( $c12, $c21 ) ; + ok( ( $c12, $c21 ) = cache_map( \@cache_files, $msgs_1, $msgs_2 ), 'cache_map: 02' ); + my $a1 = [ sort { $a <=> $b } keys %$c12 ] ; + my $a2 = [ sort { $a <=> $b } keys %$c21 ] ; + ok( 0 == compare_lists( [ 130, 142, 143, 177, 182, 1601 ], $a1 ), 'cache_map: 03' ); + ok( 0 == compare_lists( [ 242, 243, 260, 279, 280, 2301 ], $a2 ), 'cache_map: 04' ); + ok( ! $c12->{161}, 'cache_map: ! 161 -> 260' ); + ok( 260 == $c12->{1601}, 'cache_map: 1601 -> 260' ); + ok( 2301 == $c12->{130}, 'cache_map: 130 -> 2301' ); + #print $c12->{1601}, "\n"; + +} + +sub cache_dir_fix { + my $cache_dir = shift ; + $cache_dir =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'"\\])/\\$1/g ; + #print "cache_dir_fix: $cache_dir\n" ; + return( $cache_dir ) ; +} + +sub tests_cache_dir_fix { + ok( 'lalala' eq cache_dir_fix('lalala'), 'cache_dir_fix: lalala -> lalala' ); + ok( 'ii\\\\ii' eq cache_dir_fix('ii\ii'), 'cache_dir_fix: ii\ii -> ii\\\\ii' ); + ok( 'ii@ii' eq cache_dir_fix('ii@ii'), 'cache_dir_fix: ii@ii -> ii@ii' ); + ok( 'ii@ii\\:ii' eq cache_dir_fix('ii@ii:ii'), 'cache_dir_fix: ii@ii:ii -> ii@ii\\:ii' ); + +} + +sub get_cache { + $debugcache and print "Entering get_cache\n"; + my ( $cache_dir, $h1_msgs_ref, $h2_msgs_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) = @_; + + -d $cache_dir or return( undef ); # exit if cache directory doesn't exist + $debugcache and print "cache_dir : $cache_dir\n"; + + #$cache_dir =~ s{\\}{\\\\}g; + $cache_dir = cache_dir_fix( $cache_dir ) if ( 'MSWin32' ne $OSNAME ) ; + + $debugcache and print "cache_dir_fix: $cache_dir\n" ; + + my @cache_files = bsd_glob( "$cache_dir/*" ) ; + #$debugcache and print "cache_files: [@cache_files]\n" ; + + $debugcache and print( "cache_files: ", scalar( @cache_files ), " files found\n" ) ; + + my( $cache_1_2_ref, $cache_2_1_ref ) + = cache_map( \@cache_files, $h1_msgs_ref, $h2_msgs_ref ) ; + + clean_cache( \@cache_files, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ; + + #print "\n", map { "c12 $_ -> $cache_1_2_ref->{ $_ }\n" } keys %$cache_1_2_ref ; + #print "\n", map { "c21 $_ -> $cache_2_1_ref->{ $_ }\n" } keys %$cache_2_1_ref ; + + $debugcache and print "Exiting get_cache\n"; + return ( $cache_1_2_ref, $cache_2_1_ref ) ; +} + + +sub tests_get_cache { + + ok( ! get_cache('/cache_no_exist'), 'get_cache: /cache_no_exist' ); + ok( ( ! -d 'W/tmp/cache/F1/F2' or rmtree( 'W/tmp/cache/F1/F2' )), 'get_cache: rmtree W/tmp/cache/F1/F2' ) ; + ok( mkpath( 'W/tmp/cache/F1/F2' ), 'get_cache: mkpath W/tmp/cache/F1/F2' ) ; + + my @test_files_cache = ( qw( + W/tmp/cache/F1/F2/100_200 + W/tmp/cache/F1/F2/101_201 + W/tmp/cache/F1/F2/120_220 + W/tmp/cache/F1/F2/142_242 + W/tmp/cache/F1/F2/143_243 + W/tmp/cache/F1/F2/177_277 + W/tmp/cache/F1/F2/177_377 + W/tmp/cache/F1/F2/177_777 + W/tmp/cache/F1/F2/155_255 + ) ) ; + ok( touch( @test_files_cache ), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ; + + + # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255 + # on live: + my $msgs_1 = [120, 142, 143, 144, 177 ]; + my $msgs_2 = [ 242, 243, 299, 377, 777, 255 ]; + + my $msgs_all_1 = { 120 => '', 142 => '', 143 => '', 144 => '', 177 => '' } ; + my $msgs_all_2 = { 242 => '', 243 => '', 299 => '', 377 => '', 777 => '', 255 => '' } ; + + my( $c12, $c21 ) ; + ok( ( $c12, $c21 ) = get_cache( 'W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' ); + my $a1 = [ sort { $a <=> $b } keys %$c12 ] ; + my $a2 = [ sort { $a <=> $b } keys %$c21 ] ; + ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' ); + ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' ); + ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242'); + ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243'); + ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200'); + ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201'); + + # test clean_cache executed + $maxage = 2 ; + ok( touch(@test_files_cache), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ; + ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' ); + ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242'); + ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243'); + ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200'); + ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201'); + + + # strange files + #$debugcache = 1 ; + $maxage = undef ; + ok( ( ! -d 'W/tmp/cache/rr\uee' or rmtree( 'W/tmp/cache/rr\uee' )), 'get_cache: rmtree W/tmp/cache/rr\uee' ) ; + ok( mkpath( 'W/tmp/cache/rr\uee' ), 'get_cache: mkpath W/tmp/cache/rr\uee' ) ; + + @test_files_cache = ( qw( + W/tmp/cache/rr\uee/100_200 + W/tmp/cache/rr\uee/101_201 + W/tmp/cache/rr\uee/120_220 + W/tmp/cache/rr\uee/142_242 + W/tmp/cache/rr\uee/143_243 + W/tmp/cache/rr\uee/177_277 + W/tmp/cache/rr\uee/177_377 + W/tmp/cache/rr\uee/177_777 + W/tmp/cache/rr\uee/155_255 + ) ) ; + ok( touch(@test_files_cache), 'get_cache: touch strange W/tmp/cache/...' ) ; + + # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255 + # on live: + $msgs_1 = [120, 142, 143, 144, 177 ]; + $msgs_2 = [ 242, 243, 299, 377, 777, 255 ]; + + $msgs_all_1 = { 120 => '', 142 => '', 143 => '', 144 => '', 177 => '' } ; + $msgs_all_2 = { 242 => '', 243 => '', 299 => '', 377 => '', 777 => '', 255 => '' } ; + + ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/rr\uee', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2), 'get_cache: strange path 02' ); + $a1 = [ sort { $a <=> $b } keys %$c12 ] ; + $a2 = [ sort { $a <=> $b } keys %$c21 ] ; + ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: strange path 03' ); + ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: strange path 04' ); + ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 142_242'); + ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 143_243'); + ok( ! -f 'W/tmp/cache/rr\uee/100_200', 'get_cache: strange path file removed 100_200'); + ok( ! -f 'W/tmp/cache/rr\uee/101_201', 'get_cache: strange path file removed 101_201'); + + +} + +sub match_a_cache_file { + my $file = shift ; + my ( $uid1, $uid2 ) ; + + return( ( undef, undef ) ) if ( ! $file ) ; + if ( $file =~ m{(?:^|/)(\d+)_(\d+)$} ) { + $uid1 = $1 ; + $uid2 = $2 ; + } + return( $uid1, $uid2 ) ; +} + +sub tests_match_a_cache_file { + my ( $uid1, $uid2 ) ; + ok( ( $uid1, $uid2 ) = match_a_cache_file( ), 'match_a_cache_file: no arg' ) ; + ok( ! defined( $uid1 ), 'match_a_cache_file: no arg 1' ) ; + ok( ! defined( $uid2 ), 'match_a_cache_file: no arg 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '' ), 'match_a_cache_file: empty arg' ) ; + ok( ! defined( $uid1 ), 'match_a_cache_file: empty arg 1' ) ; + ok( ! defined( $uid2 ), 'match_a_cache_file: empty arg 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '000_000' ), 'match_a_cache_file: 000_000' ) ; + ok( '000' eq $uid1, 'match_a_cache_file: 000_000 1' ) ; + ok( '000' eq $uid2, 'match_a_cache_file: 000_000 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ; + ok( '123' eq $uid1, 'match_a_cache_file: 123_456 1' ) ; + ok( '456' eq $uid2, 'match_a_cache_file: 123_456 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ; + ok( '123' eq $uid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ; + ok( '456' eq $uid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ; + ok( ! $uid1, 'match_a_cache_file: /lala123_456 1' ) ; + ok( ! $uid2, 'match_a_cache_file: /lala123_456 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( 'la123_456' ), 'match_a_cache_file: NO la123_456' ) ; + ok( ! $uid1, 'match_a_cache_file: la123_456 1' ) ; + ok( ! $uid2, 'match_a_cache_file: la123_456 2' ) ; + + +} + +sub clean_cache { + my ( $cache_files_ref, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) = @_ ; + + $debugcache and print "Entering clean_cache\n"; + + $debugcache and print map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %$cache_1_2_ref ; + foreach my $file ( @$cache_files_ref ) { + $debugcache and print "$file\n" ; + my ( $uid1, $uid2 ) = match_a_cache_file( $file ) ; + $debugcache and print "u1: $uid1 u2: $uid2 c12: ", $cache_1_2_ref->{ $uid1 } || '', "\n" ; +# or ( ! exists( $cache_1_2_ref->{ $uid1 } ) ) +# or ( ! ( $uid2 == $cache_1_2_ref->{ $uid1 } ) ) + if ( ( ! defined( $uid1 ) ) + or ( ! defined( $uid2 ) ) + or ( ! exists( $h1_msgs_all_hash_ref->{ $uid1 } ) ) + or ( ! exists( $h2_msgs_all_hash_ref->{ $uid2 } ) ) + ) { + $debugcache and print "remove $file\n" ; + unlink( $file ) or print "$!" ; + } + } + + $debugcache and print "Exiting clean_cache\n"; + return( 1 ) ; +} + +sub tests_clean_cache { + + ok( ( ! -d 'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache: rmtree W/tmp/cache/G1/G2' ) ; + ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache: mkpath W/tmp/cache/G1/G2' ) ; + + my @test_files_cache = ( qw( + W/tmp/cache/G1/G2/100_200 + W/tmp/cache/G1/G2/101_201 + W/tmp/cache/G1/G2/120_220 + W/tmp/cache/G1/G2/142_242 + W/tmp/cache/G1/G2/143_243 + W/tmp/cache/G1/G2/177_277 + W/tmp/cache/G1/G2/177_377 + W/tmp/cache/G1/G2/177_777 + W/tmp/cache/G1/G2/155_255 + ) ) ; + ok( touch(@test_files_cache), 'clean_cache: touch W/tmp/cache/G1/G2/...' ) ; + + ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' ); + ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' ); + ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' ); + ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' ); + ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' ); + ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' ); + + my $cache = { + 142 => 242, + 177 => 777, + } ; + + my $all_1 = { + 142 => '', + 177 => '', + } ; + + my $all_2 = { + 200 => '', + 242 => '', + 777 => '', + } ; + ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache: ' ) ; + + ok( ! -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' ); + ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' ); + ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' ); + ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' ); + ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' ); + ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' ); +} + +sub tests_clean_cache_2 { + + ok( ( ! -d 'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache_2: rmtree W/tmp/cache/G1/G2' ) ; + ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache_2: mkpath W/tmp/cache/G1/G2' ) ; + + my @test_files_cache = ( qw( + W/tmp/cache/G1/G2/100_200 + W/tmp/cache/G1/G2/101_201 + W/tmp/cache/G1/G2/120_220 + W/tmp/cache/G1/G2/142_242 + W/tmp/cache/G1/G2/143_243 + W/tmp/cache/G1/G2/177_277 + W/tmp/cache/G1/G2/177_377 + W/tmp/cache/G1/G2/177_777 + W/tmp/cache/G1/G2/155_255 + ) ) ; + ok( touch(@test_files_cache), 'clean_cache_2: touch W/tmp/cache/G1/G2/...' ) ; + + ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 before' ); + ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 before' ); + ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 before' ); + ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 before' ); + ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 before' ); + ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 before' ); + + my $cache = { + 142 => 242, + 177 => 777, + } ; + + my $all_1 = { + 100 => '', + 142 => '', + 177 => '', + } ; + + my $all_2 = { + 200 => '', + 242 => '', + 777 => '', + } ; + + + + ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache_2: ' ) ; + + ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 after' ); + ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 after' ); + ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 after' ); + ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 after' ); + ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 after' ); + ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 after' ); +} + + + +sub tests_mkpath { + + my $long_path = "123456789/" x 30 ; + ok( (-d "W/tmp/tests/long/$long_path" or mkpath( "W/tmp/tests/long/$long_path" )), 'tests_mkpath: mkpath > 300 char' ) ; + ok( (-d "W/tmp/tests/long/$long_path" and rmtree( "W/tmp/tests/long/" )), 'tests_mkpath: rmtree > 300 char' ) ; + ok( 1 == 1, 'tests_mkpath: 1 == 1' ) ; +} + +sub tests_touch { + + ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' )), 'tests_touch: mkpath W/tmp/tests/' ) ; + ok( 1 == touch( 'W/tmp/tests/lala'), 'tests_touch: W/tmp/tests/lala') ; + ok( 1 == touch( 'W/tmp/tests/\y'), 'tests_touch: W/tmp/tests/\y') ; + ok( 0 == touch( '/aaa'), 'tests_touch: not /aaa') ; + ok( 1 == touch( 'W/tmp/tests/lili', 'W/tmp/tests/lolo'), 'tests_touch: 2 files') ; + ok( 0 == touch( 'W/tmp/tests/\y', '/aaa'), 'tests_touch: 2 files, 1 fails' ) ; + +} + + +sub touch { + my @files = @_ ; + my $failures = 0 ; + + foreach my $file ( @files ) { + my $fh = new IO::File ; + if ( $fh->open(">> $file" ) ) { + $fh->close ; + }else{ + print "Could not open file $file in write/append mode\n" ; + $failures++ ; + } + } + return( ! $failures ); +} + +sub tests_cache_folder { + + ok( '/path/fold1/fold2' eq cache_folder( '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ; + ok( '/pa_th/fold1/fold2' eq cache_folder( '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ; + ok( '/_p_a__th/fol_d1/fold2' eq cache_folder( '/>pp /path/fol_d1/fold2' ) ; +} + +sub cache_folder { + my( $cache_dir, $h1_fold, $h2_fold ) = @_ ; + + my $sep1 = $h1_sep || '/'; + my $sep2 = $h2_sep || '/'; + + #print "$cache_dir h1_fold $h1_fold sep1 $sep1 h2_fold $h2_fold sep2 $sep2\n"; + $h1_fold = convert_sep_to_slash( $h1_fold, $sep1 ) ; + $h2_fold = convert_sep_to_slash( $h2_fold, $sep2 ) ; + + my $cache_folder = "$cache_dir/$h1_fold/$h2_fold" ; + $cache_folder = filter_forbidden_characters( $cache_folder ) ; + #print "cache_folder [$cache_folder]\n" ; + return( $cache_folder ) ; +} + +sub filter_forbidden_characters { + my $string = shift ; + + $string =~ s{[\Q*|?:"<>\E]}{_}g ; + return ( $string ) ; +} + +sub tests_filter_forbidden_characters { + + ok( 'a_b' eq filter_forbidden_characters( 'a_b' ), 'filter_forbidden_characters: a_b -> a_b' ) ; + ok( 'a_b' eq filter_forbidden_characters( 'a*b' ), 'filter_forbidden_characters: a*b -> a_b' ); + ok( 'a_b' eq filter_forbidden_characters( 'a|b' ), 'filter_forbidden_characters: a|b -> a_b' ); + ok( 'a_b' eq filter_forbidden_characters( 'a?b' ), 'filter_forbidden_characters: a?*b -> a_b' ); + ok( 'a_______b' eq filter_forbidden_characters( 'a*|?:"<>b' ), 'filter_forbidden_characters: a*|?:"<>b -> a_______b' ); + +} + +sub convert_sep_to_slash { + my ( $folder, $sep ) = @_ ; + + $folder =~ s{\Q$sep\E}{/}g ; + return( $folder ) ; +} + +sub tests_convert_sep_to_slash { + + ok('' eq convert_sep_to_slash('', '/'), 'convert_sep_to_slash: no folder'); + ok('INBOX' eq convert_sep_to_slash('INBOX', '/'), 'convert_sep_to_slash: INBOX'); + ok('INBOX/foo' eq convert_sep_to_slash('INBOX/foo', '/'), 'convert_sep_to_slash: INBOX/foo'); + ok('INBOX/foo' eq convert_sep_to_slash('INBOX_foo', '_'), 'convert_sep_to_slash: INBOX_foo'); + ok('INBOX/foo/zob' eq convert_sep_to_slash('INBOX_foo_zob', '_'), 'convert_sep_to_slash: INBOX_foo_zob'); + ok('INBOX/foo' eq convert_sep_to_slash('INBOX.foo', '.'), 'convert_sep_to_slash: INBOX.foo'); + ok('INBOX/foo/hi' eq convert_sep_to_slash('INBOX.foo.hi', '.'), 'convert_sep_to_slash: INBOX.foo.hi'); +} + + +sub tests_regexmess { + + ok("blabla" eq regexmess("blabla"), "regexmess, no regexmess, nothing to do"); + + @regexmess = ('s/p/Z/g'); + ok("ZoZoZo" eq regexmess("popopo"), "regexmess, s/p/Z/g"); + + @regexmess = 's{c}{C}gxms'; + ok("H1: abC\nH2: Cde\n\nBody abC" + eq regexmess("H1: abc\nH2: cde\n\nBody abc"), + "regexmess, c->C"); + + @regexmess = 's{\AFrom\ }{From:}gxms'; + ok( '' + eq regexmess(''), + 'From mbox 1 add colon blank'); + + ok( 'From:' + eq regexmess('From '), + 'From mbox 2 add colo'); + + ok( "\n" . 'From ' + eq regexmess("\n" . 'From '), + 'From mbox 3 add colo'); + + ok( "From: zzz\n" . 'From ' + eq regexmess("From zzz\n" . 'From '), + 'From mbox 4 add colo'); + + @regexmess = 's{\AFrom\ [^\n]*(\n)?}{}gxms'; + ok( '' + eq regexmess(''), + 'From mbox 1 remove, blank'); + + ok( '' + eq regexmess('From '), + 'From mbox 2 remove'); + + ok( "\n" . 'From ' + eq regexmess("\n" . 'From '), + 'From mbox 3 remove'); + + #print "[", regexmess("From zzz\n" . 'From '), "]"; + ok( "" . 'From ' + eq regexmess("From zzz\n" . 'From '), + 'From mbox 4 remove'); + + + ok( +'Date: Sat, 10 Jul 2010 05:34:45 -0700 +From: + +Hello, +Bye.' + eq regexmess( +'From zzz +Date: Sat, 10 Jul 2010 05:34:45 -0700 +From: + +Hello, +Bye.' + ), + 'From mbox 5 remove'); +} + +sub regexmess { + my ($string) = @_; + foreach my $regexmess (@regexmess) { + $debug and print "eval \$string =~ $regexmess\n"; + eval("\$string =~ $regexmess"); + die_clean("error: eval regexmess '$regexmess': $@\n") if $@; + } + return($string); +} + +sub bytes_display_string { + my ( $bytes ) = @_ ; + + if ( abs( $bytes ) < ( 1024 * 1024 ) ) { + return sprintf( "%.2f KiB", $bytes / 1024) ; + } elsif ( abs( $bytes ) < ( 1024 * 1024 * 1024 ) ) { + return sprintf( "%.2f MiB", $bytes / (1024 * 1024) ) ; + } elsif ( abs( $bytes ) < ( 1024 * 1024 * 1024 * 1024) ) { + return sprintf("%.2f GiB", $bytes / (1024 * 1024 * 1024) ) ; + } elsif ( abs( $bytes ) < ( 1024 * 1024 * 1024 * 1024 * 1024) ) { + return sprintf( "%.2f TiB", $bytes / (1024 * 1024 * 1024 * 1024) ) ; + } else { + return sprintf( "%.2f PiB", $bytes / (1024 * 1024 * 1024 * 1024 * 1024) ) ; + } + # if you have exabytes (EiB) of email to transfer, you have too much email +} + +sub stats { + $timeend = time( ); + $timediff = $timeend - $timestart ; + + my $timeend_str = localtime( $timeend ) ; + + my $memory_consumption = memory_consumption( ) || 0 ; + my $memory_ratio = ($max_msg_size_in_bytes) ? + sprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : "NA" ; + + my $host1_reconnect_count = $imap1->Reconnect_counter() || 0 ; + my $host2_reconnect_count = $imap2->Reconnect_counter() || 0 ; + + print "++++ Statistics\n" ; + print "Transfer started on : $timestart_str\n"; + print "Transfer ended on : $timeend_str\n"; + printf( "Transfer time : %.1f sec\n", $timediff ) ; + print "Messages transferred : $nb_msg_transferred "; + print "(could be $nb_msg_skipped_dry_mode without dry mode)" if ($dry); + print "\n"; + print "Messages skipped : $nb_msg_skipped\n"; + print "Messages found duplicate on host1 : $h1_nb_msg_duplicate\n"; + print "Messages found duplicate on host2 : $h2_nb_msg_duplicate\n"; + print "Messages void (noheader) on host1 : $h1_nb_msg_noheader\n"; + print "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n"; + print "Messages deleted on host1 : $h1_nb_msg_deleted\n"; + print "Messages deleted on host2 : $h2_nb_msg_deleted\n"; + printf( "Total bytes transferred : %d (%s)\n", + $total_bytes_transferred, + bytes_display_string($total_bytes_transferred)); + printf( "Total bytes duplicate host1 : %d (%s)\n", + $h1_total_bytes_duplicate, + bytes_display_string($h1_total_bytes_duplicate)); + printf( "Total bytes duplicate host2 : %d (%s)\n", + $h2_total_bytes_duplicate, + bytes_display_string($h2_total_bytes_duplicate)); + printf( "Total bytes skipped : %d (%s)\n", + $total_bytes_skipped, + bytes_display_string($total_bytes_skipped)); + printf( "Total bytes error : %d (%s)\n", + $total_bytes_error, + bytes_display_string($total_bytes_error)); + $timediff ||= 1; # No division per 0 + printf ("Message rate : %.1f messages/s\n", $nb_msg_transferred / $timediff); + printf ("Average bandwidth rate : %.1f KiB/s\n", $total_bytes_transferred / 1024 / $timediff); + print "Reconnections to host1 : $host1_reconnect_count\n"; + print "Reconnections to host2 : $host2_reconnect_count\n"; + printf ("Memory consumption : %.1f MiB\n", $memory_consumption / 1024 / 1024); + print "Biggest message : $max_msg_size_in_bytes bytes\n"; +# print "Memory/biggest message ratio : $memory_ratio\n"; + if ( $foldersizesatend and $foldersizes ) { + printf("Initial difference host2 - host1 : %s messages, %s bytes (%s)\n", $h2_nb_msg_start - $h1_nb_msg_start, + $h2_bytes_start - $h1_bytes_start, + bytes_display_string( $h2_bytes_start - $h1_bytes_start ) ) ; + printf("Final difference host2 - host1 : %s messages, %s bytes (%s)\n", $h2_nb_msg_end - $h1_nb_msg_end, + $h2_bytes_end - $h1_bytes_end, + bytes_display_string( $h2_bytes_end - $h1_bytes_end ) ) ; + } + print "Detected $nb_errors errors\n\n" ; + + print $warn_release, "\n" ; + print thank_author(); +} + +sub thank_author { + + return("Homepage: http://imapsync.lamiral.info/\n"); + + # used to be + return(join("", "Happy with this free, open and gratis DWTFPL software?\n", + "Encourage the author (Gilles LAMIRAL) by giving him a book\n", + "or just money via paypal:\n", + "http://imapsync.lamiral.info/\n")); +} + +sub get_options { + my $numopt = scalar(@ARGV); + my $argv = join("¤", @ARGV); + + $test_builder = Test::More->builder; + $test_builder->no_ending(1); + + if($argv =~ m/-delete¤2/) { + print "May be you mean --delete2 instead of --delete 2\n"; + exit 1; + } + my $opt_ret = GetOptions( + "debug!" => \$debug, + "debugLIST!" => \$debugLIST, + "debugcontent!" => \$debugcontent, + "debugsleep!" => \$debugsleep, + "debugflags!" => \$debugflags, + "debugimap!" => \$debugimap, + "debugimap1!" => \$debugimap1, + "debugimap2!" => \$debugimap2, + "debugdev!" => \$debugdev, + "host1=s" => \$host1, + "host2=s" => \$host2, + "port1=i" => \$port1, + "port2=i" => \$port2, + "user1=s" => \$user1, + "user2=s" => \$user2, + "domain1=s" => \$domain1, + "domain2=s" => \$domain2, + "password1=s" => \$password1, + "password2=s" => \$password2, + "passfile1=s" => \$passfile1, + "passfile2=s" => \$passfile2, + "authmd5!" => \$authmd5, + "authmd51!" => \$authmd51, + "authmd52!" => \$authmd52, + "sep1=s" => \$sep1, + "sep2=s" => \$sep2, + "folder=s" => \@folder, + "folderrec=s" => \@folderrec, + "include=s" => \@include, + "exclude=s" => \@exclude, + "prefix1=s" => \$prefix1, + "prefix2=s" => \$prefix2, + "fixslash2!" => \$fixslash2, + "regextrans2=s" => \@regextrans2, + "regexmess=s" => \@regexmess, + "regexflag=s" => \@regexflag, + "filterflags!" => \$filterflags, + "flagsCase!" => \$flagsCase, + "delete!" => \$delete, + "delete2!" => \$delete2, + "delete2duplicates!" => \$delete2duplicates, + "delete2folders!" => \$delete2folders, + "delete2foldersonly=s" => \$delete2foldersonly, + "delete2foldersbutnot=s" => \$delete2foldersbutnot, + "syncinternaldates!" => \$syncinternaldates, + "idatefromheader!" => \$idatefromheader, + "syncacls!" => \$syncacls, + "maxsize=i" => \$maxsize, + "minsize=i" => \$minsize, + "maxage=i" => \$maxage, + "minage=i" => \$minage, + "search=s" => \$search, + "foldersizes!" => \$foldersizes, + "foldersizesatend!" => \$foldersizesatend, + "dry!" => \$dry, + "expunge!" => \$expunge, + "expunge1!" => \$expunge1, + "expunge2!" => \$expunge2, + "uidexpunge2!" => \$uidexpunge2, + "subscribed!" => \$subscribed, + "subscribe!" => \$subscribe, + "subscribe_all!" => \$subscribe_all, + "justbanner!" => \$justbanner, + "justconnect!"=> \$justconnect, + "justfolders!"=> \$justfolders, + "justfoldersizes!" => \$justfoldersizes, + "fast!" => \$fast, + "version" => \$version, + "help" => \$help, + "timeout=i" => \$timeout, + "skipheader=s" => \$skipheader, + "useheader=s" => \@useheader, + "wholeheaderifneeded!" => \$wholeheaderifneeded, + "skipsize!" => \$skipsize, + "allowsizemismatch!" => \$allowsizemismatch, + "fastio1!" => \$fastio1, + "fastio2!" => \$fastio2, + "ssl1!" => \$ssl1, + "ssl2!" => \$ssl2, + "tls1!" => \$tls1, + "tls2!" => \$tls2, + "uid1!" => \$uid1, + "uid2!" => \$uid2, + "authmech1=s" => \$authmech1, + "authmech2=s" => \$authmech2, + "authuser1=s" => \$authuser1, + "authuser2=s" => \$authuser2, + "proxyauth1" => \$proxyauth1, + "proxyauth2" => \$proxyauth2, + "split1=i" => \$split1, + "split2=i" => \$split2, + "buffersize=i" => \$buffersize, + "reconnectretry1=i" => \$reconnectretry1, + "reconnectretry2=i" => \$reconnectretry2, + "relogin1=i" => \$relogin1, + "relogin2=i" => \$relogin2, + "tests" => \$tests, + "tests_debug" => \$tests_debug, + "allow3xx!" => \$allow3xx, + "justlogin!" => \$justlogin, + "tmpdir=s" => \$tmpdir, + "pidfile=s" => \$pidfile, + "pidfilelocking!" => \$pidfilelocking, + "releasecheck!" => \$releasecheck, + "modules_version!" => \$modules_version, + "usecache!" => \$usecache, + "cacheaftercopy!" => \$cacheaftercopy, + "debugcache!" => \$debugcache, + "useuid!" => \$useuid, + "addheader!" => \$addheader, + "exitwhenover=i" => \$exitwhenover, + "checkselectable!" => \$checkselectable, + "checkmessageexists!" => \$checkmessageexists, + "expungeaftereach!" => \$expungeaftereach, + "abletosearch!" => \$abletosearch, + "showpasswords!" => \$showpasswords, + ); + + $debug and print "get options: [$opt_ret]\n"; + + # just the version + print imapsync_version(), "\n" and exit if ($version) ; + + if ($tests) { + $test_builder->no_ending(0); + tests(); + exit; + } + if ($tests_debug) { + $test_builder->no_ending(0); + tests_debug(); + exit; + } + + $help = 1 if ! $numopt; + load_modules(); + + # 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 load_modules { + + require IO::Socket::SSL if ($ssl1 or $ssl2 or $tls1 or $tls2); + + require Term::ReadKey if ( + ((not($password1 or $passfile1)) + or (not($password2 or $passfile2))) + and (not $help)); + + #require Data::Dumper if ($debug); +} + + + +sub parse_header_msg { + my ($imap, $m_uid, $s_heads, $s_fir, $s, $s_hash) = @_; + + my $head = $s_heads->{$m_uid}; + my $headnum = scalar(keys(%$head)); + $debug and print "$s uid $m_uid head nb pass one: ", $headnum, "\n"; + + my $headstr; + + if ( ( ! $headnum ) and ( $wholeheaderifneeded ) ){ + print "$s uid $m_uid no header by parse_headers so taking whole header with BODY.PEEK[HEADER]\n" ; + $imap->fetch($m_uid, "BODY.PEEK[HEADER]"); + my $whole_header = $imap->_transaction_literals; + + #print $whole_header; + $head = decompose_header( $whole_header ) ; + + $headnum = scalar( keys( %$head ) ) ; + $debug and print "$s uid $m_uid head nb pass two: ", $headnum, "\n"; + } + + #require Data::Dumper ; + #print Data::Dumper->Dump( [ $head, \%useheader ] ) ; + + foreach my $h (sort keys(%$head)){ + next if ( ! exists( $useheader{ uc( $h ) } ) + and ! exists( $useheader{ 'ALL' } ) + ) ; + 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*(.+)$/$1/; + + # and uppercase header line + # (dbmail and dovecot) + + my $H = uc("$h: $val"); + # show stuff in debug mode + $debug and print "$s uid $m_uid header [$H]", "\n"; + + if ($skipheader and $H =~ m/$skipheader/i) { + $debug and print "$s uid $m_uid skipping header [$H]\n"; + next; + } + $headstr .= "$H"; + } + } + + if ( ( ! $headstr) and ( $addheader ) and ( $s eq "Host1" )){ + my $header = add_header( $m_uid ) ; + print "Host1 uid $m_uid no header found so adding our own [$header]\n"; + $headstr .= uc( $header ) ; + $s_fir->{$m_uid}->{"NO_HEADER"} = 1; + } + + return() if ( ! $headstr ); + + my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"}; + my $flags = $s_fir->{$m_uid}->{"FLAGS"}; + my $idate = $s_fir->{$m_uid}->{"INTERNALDATE"}; + $size = length($headstr) unless ($size); + my $m_md5 = md5_base64($headstr); + $debug and print "$s uid $m_uid sig $m_md5 size $size idate $idate\n"; + my $key; + if ($skipsize) { + $key = "$m_md5"; + } + else { + $key = "$m_md5:$size"; + } + # 0 return code is used to identify duplicate message hash + return 0 if exists $s_hash->{"$key"}; + $s_hash->{"$key"}{'5'} = $m_md5; + $s_hash->{"$key"}{'s'} = $size; + $s_hash->{"$key"}{'D'} = $idate; + $s_hash->{"$key"}{'F'} = $flags; + $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_clean("error [$file]: $! "); + chomp($line = ); + close FILE; + $line = ($line) ? $line: "error !EMPTY! [$file]"; + return $line; +} + + +sub file_to_string { + my($file) = @_; + my @string; + open FILE, $file or die_clean("error [$file]: $! "); + @string = ; + close FILE; + return join("", @string); +} + + +sub string_to_file { + my($string, $file) = @_; + sysopen(FILE, $file,O_WRONLY|O_TRUNC|O_CREAT, 0600) or die_clean("$! $file"); + print FILE $string; + close FILE; +} + +sub tests_is_a_release_number { + ok(is_a_release_number(1.351), 'is_a_release_number 1.351'); + ok(is_a_release_number(42.4242), 'is_a_release_number 42.4242'); + ok(is_a_release_number(imapsync_version()), 'is_a_release_number imapsync_version()'); + ok(! is_a_release_number('blabla' ), '! is_a_release_number blabla'); + +} + +sub is_a_release_number { + my $number = shift; + + $number =~ m{\d\.\d+}; +} + +sub check_last_release { + + my $public_release = not_long('imapsync_version_lfo'); + #print "check_last_release: [$public_release]\n" ; + return('unknown') if ($public_release eq 'unknown'); + return('timeout') if ($public_release eq 'timeout'); + return('unknown') if (! is_a_release_number($public_release)); + + my $imapsync_here = imapsync_version(); + + if ($public_release > $imapsync_here) { + return("New imapsync release $public_release available"); + }else{ + return("This current imapsync is up to date"); + } +} + +sub imapsync_version { + my $rcs = '$Id: imapsync,v 1.516 2012/11/02 22:15:04 gilles Exp gilles $ '; + $rcs =~ m/,v (\d+\.\d+)/; + my $VERSION = ($1) ? $1: "UNKNOWN"; + return($VERSION); +} + +sub tests_imapsync_basename { + + ok('imapsync' eq imapsync_basename(), 'imapsync_basename: imapsync'); + ok('blabla' ne imapsync_basename(), '! imapsync_basename: blabla'); +} + +sub imapsync_basename { + + return basename($0); + +} + +sub imapsync_version_lfo { + + my $local_version = imapsync_version(); + my $imapsync_basename = imapsync_basename(); + my $agent_info = "$OSNAME system, perl " + . sprintf("%vd", $PERL_VERSION) + . ", Mail::IMAPClient $Mail::IMAPClient::VERSION" + . " $imapsync_basename"; + my $sock = new IO::Socket::INET ( + PeerAddr => 'imapsync.lamiral.info', + PeerPort => '80', + Proto => 'tcp'); + return('unknown') if not $sock; + print $sock + "GET /prj/imapsync/VERSION HTTP/1.0\n", + "User-Agent: imapsync/$local_version ($agent_info)\n", + "Host: ks.lamiral.info\n\n"; + my @line = <$sock>; + close($sock); + my $last_release = $line[-1]; + chomp($last_release); + return($last_release); +} + +sub not_long { + #print "Entering not_long\n"; + my ($func) = @_; + my $val; + + # Doesn't work with gethostbyname (see perlipc) + #local $SIG{ALRM} = sub { die "alarm\n" }; + + if ('MSWin32' eq $OSNAME) { + local $SIG{ALRM} = sub { die "alarm\n" }; + }else{ + + POSIX::sigaction(SIGALRM, + POSIX::SigAction->new(sub { die "alarm" })) + or print "Error setting SIGALRM handler: $!\n"; + } + + eval { + + alarm(3); + #print $func, "\n"; + { + no strict "refs"; + #print "Calling $func\n"; + $val = &$func(); + #print "End of $func\n"; + } + alarm(0); + }; + if ($@) { + #print "$@"; + if ($@ =~ /alarm/) { + # timed out + return('timeout'); + }else{ + alarm(0); + return('unknown'); # propagate unexpected errors + } + }else { + # didn't + return($val); + } +} + +sub localhost_info { + + my($infos) = join("", + "Here is a [$OSNAME] system (", + join(" ", + uname(), + ), + ")\n", + "With perl ", + sprintf("%vd", $PERL_VERSION), + " Mail::IMAPClient $Mail::IMAPClient::VERSION", + ); + return($infos); + +} + +sub usage { + my $localhost_info = localhost_info(); + my $thank = thank_author(); + my $warn_release =''; + $warn_release = check_last_release() if (not defined($releasecheck)); + my $escape_char = ( 'MSWin32' eq $OSNAME ) ? '^' : '\\'; + print < : "from" imap server. Mandatory. +--port1 : port to connect on host1. Default is 143. +--user1 : user to login on host1. Mandatory. +--domain1 : domain on host1 (NTLM authentication). +--authuser1 : user to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. +--proxyauth1 : Use proxyauth on host1. Requires --authuser1. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user +--password1 : password for the user1. Dangerous, use --passfile1 +--showpasswords : shows passwords on output instead of "MASKED". + Useful to restart a complete run by just reading a log. +--passfile1 : password file for the user1. Contains the password. +--host2 : "destination" imap server. Mandatory. +--port2 : port to connect on host2. Default is 143. +--user2 : user to login on host2. Mandatory. +--domain2 : domain on host2 (NTLM authentication). +--authuser2 : user to auth with on host2 (admin user). +--proxyauth2 : Use proxyauth on host2. Requires --authuser2. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user +--password2 : password for the user2. Dangerous, use --passfile2 +--passfile2 : password file for the user2. Contains the password. +--authmd51 : Use MD5 authentification for host1. +--authmd52 : Use MD5 authentification for host2. +--authmech1 : auth mechanism to use with host1: + PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. +--authmech2 : auth mechanism to use with host2. See --authmech1 +--ssl1 : use an SSL connection on host1. +--ssl2 : use an SSL connection on host2. +--tls1 : use an TLS connection on host1. +--tls2 : use an TLS connection on host2. +--folder : sync this folder. +--folder : and this one, etc. +--folderrec : sync this folder recursively. +--folderrec : and this one, etc. +--include : sync folders matching this regular expression +--include : or this one, etc. + in case both --include --exclude options are + use, include is done before. +--exclude : skips folders matching this regular expression + Several folders to avoid: + --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. +--exclude : or this one, etc. +--tmpdir : where to store temporary files and subdirectories. + Will be created if it doesn't exist. + Default is system specific and should be ok. +--pidfile : the file where imapsync pid is written. +--pidfilelocking : Abort if pidfile already exists. Usefull to avoid + concurrent transfers on the same mailbox. +--prefix1 : remove prefix to all destination folders + (usually INBOX. for cyrus imap servers) + you can use --prefix1 if your source imap server + does not have NAMESPACE capability. +--prefix2 : 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 : Apply the whole regex to each destination folders. +--regextrans2 : 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 : Apply the whole regex to each message before transfer. + Example: 's/\\000/ /g' # to replace null by space. +--regexmess : and this one. +--regexmess : and this one, etc. +--regexflag : Apply the whole regex to each flags list. + Example: 's/\"Junk"//g' # to remove "Junk" flag. +--regexflag : and this one, etc. +--sep1 : host1 separator in case namespace is not supported. +--sep2 : idem for host2. +--delete : Deletes messages on host1 server after + a successful transfer. Useful in case you + want to migrate from one server to another one. + With imapsync, --delete tags messages as deleted and + they are really deleted unless --noexpunge is used. +--delete2 : delete messages in host2 that are not in + host1 server. Useful for backup or pre-sync. +--delete2duplicates : delete messages in host2 that are duplicates. + Works only without --useuid since duplicates are + detected with header part of each message. +--delete2folders : Delete folders in host2 that are not in host1 server. + For safety, first try it like this (it is safe): + --delete2folders --dry --justfolders --nofoldersizes +--delete2foldersonly : delete only folders matching regex. +--delete2foldersbutnot : do not delete folders matching regex. + Example: --delete2foldersbutnot "/Tasks|Contacts|Foo/" +--noexpunge : Do not expunge messages on host1. + Expunge really deletes messages marked deleted. + Expunge is made at the beginning, on host1 only. + Newly transferred messages are also expunged if + option --delete is given. + No expunge is done on host2 account (unless --expunge2) +--expunge1 : Expunge messages on host1 after messages transfer. +--expunge2 : Expunge messages on host2 after messages transfer. +--uidexpunge2 : uidexpunge messages on the host2 account + that are not on the host1 account, requires --delete2 +--syncinternaldates : sets the internal dates on host2 same as host1. + Turned on by default. Internal date is the date + a message arrived on a host (mtime). +--idatefromheader : sets the internal dates on host2 same as the + "Date:" headers. +--maxsize : skip messages larger (or equal) than bytes +--minsize : skip messages smaller (or equal) than bytes +--maxage : skip messages older than days. + final stats (skipped) don't count older messages + see also --minage +--minage : skip messages newer than 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) +--search : Select messages returned by this IMAP SEARCH command. +--exitwhenover : Stop syncing when total bytes transferred reached. + Gmail per day allows 2500000000 down 500000000 upload. +--useheader : Use this header to compare messages on both sides. + Ex: Message-ID or Subject or Date. +--useheader and this one, etc. +--dry : do nothing, just print what would be done. +--subscribed : transfers subscribed folders. +--subscribe : subscribe to the folders transferred on the + host2 that are subscribed on host1. On by default. +--subscribe_all : subscribe to the folders transferred on the + host2 even if they are not subscribed on host1. +--nofoldersizes : Do not calculate the size of each folder in bytes + and message counts. Default is to calculate them. +--nofoldersizesatend : Do not calculate the size of each folder in bytes + and message counts at the end. Default is on. +--justfoldersizes : exit after printed the folder sizes. +--syncacls : synchronises acls (Access Control Lists). +--nosyncacls : does not synchronise acls. This is the default. +--usecache : Use cache to speedup. +--nousecache : Do not use cache. Caveat: --useuid --nousecache creates + duplicates on multiple runs. +--useuid : Use uid instead of header as a criterium to sync. + --usecache is then implied unless --nousecache is + used. +--debug : debug mode. +--debugcontent : debug content of the messages transfered. +--debugflags : debug flags. +--debugimap1 : imap debug mode for host1. imap debug is very verbose. +--debugimap2 : imap debug mode for host2. +--debugimap : imap debug mode for host1 and host2. +--version : print software version. +--noreleasecheck : do not check for new imapsync release (a http request). +--justconnect : just connect to both servers and print useful + information. Need only --host1 and --host2 options. +--justlogin : just login to both host1 and host2 with users + credentials, then exit. +--justfolders : just do things about folders (ignore messages). +--fast : be faster, equivalent to --nofoldersizes +--help : print this help. + +Example: to synchronise imap account "foo" on "imap.truc.org" + to imap account "bar" on "imap.trac.org" + with foo password "secret1" + and bar password "secret2" + +$0 $escape_char + --host1 imap.truc.org --user1 foo --password1 secret1 $escape_char + --host2 imap.trac.org --user2 bar --password2 secret2 + +$localhost_info +$rcs +$warn_release + +$thank +EOF +} + +sub usage_complete { + print < : Don't take into account header keyword + matching ex: --skipheader 'X.*' + +--skipsize : Don't take message size into account to compare + messages on both sides. On by default. + Use --no-skipsize for using size comparaison. +--allowsizemismatch : allow RFC822.SIZE != fetched msg size + consider also --skipsize to avoid duplicate messages + when running syncs more than one time per mailbox + +--reconnectretry1 : reconnect to host1 if connection is lost up to + times per imap command (default is 3) +--reconnectretry2 : same as --reconnectretry1 but for host2 +--split1 : split the requests in several parts on host1. + is the number of messages handled per request. + default is like --split1 500. +--split2 : same thing on host2. +--timeout : imap connect timeout. + +EOF +} + +sub memory_consumption { + # memory consumed by imapsync until now in bytes + return( ( memory_consumption_of_pids( ) )[0] ); +} + +sub memory_consumption_of_pids { + + my @PID = (@_) ? @_ : ($PROCESS_ID); + + #print "PIDs: @PID\n"; + my @val; + if ('MSWin32' eq $OSNAME) { + @val = memory_consumption_of_pids_win32(@PID); + }else{ + # Unix + my @ps = qx{ ps -o vsz -p @PID }; + shift @ps; # First line is column name "VSZ" + chomp @ps; + # convert to + @val = map { $_ * 1024 } @ps; + return(@val); + } +} + +sub memory_consumption_of_pids_win32 { + # Windows + my @PID = @_; + my %PID; + # hash of pids as key values + map { $PID{$_}++ } @PID; + + # Does not work but should reading the tasklist documentation + #@ps = qx{ tasklist /FI "PID eq @PID" }; + + my @ps = qx{ tasklist /NH /FO CSV }; + #print "-" x 80, "\n", @ps, "-" x 80, "\n"; + my @val; + foreach my $line (@ps) { + my($name, $pid, $mem) = (split(',', $line))[0,1,4]; + next if (! $pid); + #print "[$name][$pid][$mem]"; + if ($PID{remove_qq($pid)}) { + #print "MATCH !\n"; + chomp($mem); + $mem = remove_qq($mem); + $mem = remove_Ko($mem); + $mem = remove_not_num($mem); + #print "[$mem]\n"; + push(@val, $mem * 1024); + } + } + return(@val); +} + +sub remove_not_num { + + my $string = shift; + $string =~ tr/0-9//cd; + #print "tr [$string]\n"; + return($string); +} + +sub tests_remove_not_num { + + ok('123' eq remove_not_num(123), 'remove_not_num( 123 )'); + ok('123' eq remove_not_num('123'), "remove_not_num( '123' )"); + ok('123' eq remove_not_num('12 3'), "remove_not_num( '12 3' )"); + ok('123' eq remove_not_num('a 12 3 Ko'), "remove_not_num( 'a 12 3 Ko' )"); +} + +sub remove_Ko { + my $string = shift; + if ($string =~ /^(.*) Ko$/) { + return($1); + }else{ + return($string); + } +} + +sub remove_qq { + my $string = shift; + if ($string =~ /^"(.*)"$/) { + return($1); + }else{ + return($string); + } +} + +sub memory_consumption_ratio { + + my ($base) = @_; + $base ||= 1; + my $consu = memory_consumption(); + return($consu / $base); +} + +sub tests_memory_consumption { + + ok(print join("\n", memory_consumption_of_pids()), "\n"); + ok(print join("\n", memory_consumption_of_pids('1')), "\n"); + ok(print join("\n", memory_consumption_of_pids('1', $$)), "\n"); + + ok(print memory_consumption_ratio(), "\n"); + ok(print memory_consumption_ratio(1), "\n"); + ok(print memory_consumption_ratio(10), "\n"); + + ok(print memory_consumption(), "\n"); +} + +sub good_date { + # two incoming formats: + # header Tue, 24 Aug 2010 16:00:00 +0200 + # internal 24-Aug-2010 16:00:00 +0200 + + # outgoing format: internal date format + # 24-Aug-2010 16:00:00 +0200 + + my $d = shift ; + return ('') if not defined($d); + + if ( $d =~ m{(\d?)(\d-...-\d{4})( \d{2}:\d{2}:\d{2})( (?:\+|-)\d{4})?}o ) { + #print "internal: [$1][$2][$3][$4]\n"; + my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4); + $day_1 = '0' if ($day_1 eq ''); + $zone = ' +0000' if not defined($zone); + $d = $day_1 . $date_rest . $hour . $zone; + }elsif ($d =~ m{(?:\w{3,}, )?(\d{1,2}),?\s+(\w{3,})\s+(\d{2,4})\s+(\d{1,2})(?::|\.)(\d{1,2})(?:(?::|\.)(\d{1,2}))?\s*((?:\+|-)\d{4})?}o ) { + # Handles any combination of following formats + # Tue, 24 Aug 2010 16:00:00 +0200 -- Standard + # 24 Aug 2010 16:00:00 +0200 -- Missing Day of Week + # Tue, 24 Aug 97 16:00:00 +0200 -- Two digit year + # Tue, 24 Aug 1997 16.00.00 +0200 -- Periods instead of colons + # Tue, 24 Aug 1997 16:00:00 +0200 -- Extra whitespace between year and hour + # Tue, 24 Aug 1997 6:5:2 +0200 -- Single digit hour, min, or second + # Tue, 24, Aug 1997 16:00:00 +0200 -- Extra comma + + #print "header: [$1][$2][$3][$4][$5][$6][$7][$8]\n"; + my ($day, $month, $year, $hour, $min, $sec, $zone) = ($1,$2,$3,$4,$5,$6,$7,$8); + $year = '19' . $year if length($year) == 2 && $year =~ /^[789]/; + $year = '20' . $year if length($year) == 2; + + $month = substr $month, 0, 3 if length($month) > 4; + $day = sprintf("%02d", $day); + $hour = sprintf("%02d", $hour); + $min = sprintf("%02d", $min); + $sec = '00' if not defined($sec); + $sec = sprintf("%02d", $sec); + $zone = '+0000' if not defined($zone); + $d = "$day-$month-$year $hour:$min:$sec $zone"; + + }elsif ($d =~ m{(?:.{3}) (...)\s+(\d{1,2}) (\d{1,2}):(\d{1,2}):(\d{1,2}) (?:\w{3})?\s?(\d{4})}o ) { + # Handles any combination of following formats + # Sun Aug 20 11:55:09 2006 + # Wed Jan 24 11:58:38 MST 2007 + # Wed Jan 2 08:40:57 2008 + + #print "header: [$1][$2][$3][$4][$5][$6]\n"; + my ($month, $day, $hour, $min, $sec, $year) = ($1,$2,$3,$4,$5,$6); + $day = sprintf("%02d", $day); + $hour = sprintf("%02d", $hour); + $min = sprintf("%02d", $min); + $sec = sprintf("%02d", $sec); + $d = "$day-$month-$year $hour:$min:$sec +0000"; + + }elsif ($d =~ m{(\d{2})/(\d{2})/(\d{2}) (\d{2}):(\d{2}):(\d{2})}o ) { + # Handles the following format + # 02/06/09 22:18:08 -- Generated by AVTECH TemPageR devices + + #print "header: [$1][$2][$3][$4][$5][$6]\n"; + my ($month, $day, $year, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6); + $year = '20' . $year; + my %num2mon = qw(01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec); + $month = $num2mon{$month}; + $d = "$day-$month-$year $hour:$min:$sec +0000"; + + }elsif ($d =~ m{\w{6,}, (\w{3})\w+\s+(\d{1,2}), (\d{4}) (\d{2}):(\d{2}) (AM|PM)}o ) { + # Handles the following format + # Saturday, December 14, 2002 05:00 PM - KBtoys.com order confirmations + + my ($month, $day, $year, $hour, $min, $apm) = ($1,$2,$3,$4,$5,$6); + + $hour += 12 if $apm eq 'PM'; + $day = sprintf("%02d", $day); + $d = "$day-$month-$year $hour:$min:00 +0000"; + + }elsif ($d =~ m{(\w{3}) (\d{1,2}) (\d{4}) (\d{2}):(\d{2}):(\d{2}) ((?:\+|-)\d{4})}o ) { + # Handles the following format + # Saturday, December 14, 2002 05:00 PM - jr.com order confirmations + + my ($month, $day, $year, $hour, $min, $sec, $zone) = ($1,$2,$3,$4,$5,$6,$7); + + $day = sprintf("%02d", $day); + $d = "$day-$month-$year $hour:$min:$sec $zone"; + + }elsif ($d =~ m{(\d{1,2})-(\w{3})-(\d{4})}o ) { + # Handles the following format + # 21-Jun-2001 - register.com domain transfer email circa 2001 + + my ($day, $month, $year) = ($1,$2,$3); + $day = sprintf("%02d", $day); + $d = "$day-$month-$year 11:11:11 +0000"; + + }else{ + # unknown/unmatch => return same string + return($d); + } + + $d = qq("$d"); + return($d); +} + + +sub tests_good_date { + + ok('' eq good_date(), 'good_date no arg'); + ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24-Aug-2010 16:00:00 +0200'), 'good_date internal 2digit zone'); + ok('"24-Aug-2010 16:00:00 +0000"' eq good_date('24-Aug-2010 16:00:00'), 'good_date internal 2digit no zone'); + ok('"01-Sep-2010 16:00:00 +0200"' eq good_date( '1-Sep-2010 16:00:00 +0200'), 'good_date internal SP 1digit'); + ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('Tue, 24 Aug 2010 16:00:00 +0200'), 'good_date header 2digit zone'); + ok('"01-Sep-2010 16:00:00 +0000"' eq good_date('Wed, 1 Sep 2010 16:00:00'), 'good_date header SP 1digit zone'); + ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200'), 'good_date header SP 1digit zone'); + ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200 (CEST)'), 'good_date header SP 1digit zone'); + ok('"06-Feb-2009 22:18:08 +0000"' eq good_date('02/06/09 22:18:08'), 'good_date header TemPageR'); + ok('"02-Jan-2008 08:40:57 +0000"' eq good_date('Wed Jan 2 08:40:57 2008'), 'good_date header dice.com support 1digit day'); + ok('"20-Aug-2006 11:55:09 +0000"' eq good_date('Sun Aug 20 11:55:09 2006'), 'good_date header dice.com support 2digit day'); + ok('"24-Jan-2007 11:58:38 +0000"' eq good_date('Wed Jan 24 11:58:38 MST 2007'), 'good_date header status-now.com'); + ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24 Aug 2010 16:00:00 +0200'), 'good_date header missing date of week'); + ok('"24-Aug-2067 16:00:00 +0200"' eq good_date('Tue, 24 Aug 67 16:00:00 +0200'), 'good_date header 2digit year'); + ok('"24-Aug-1977 16:00:00 +0200"' eq good_date('Tue, 24 Aug 77 16:00:00 +0200'), 'good_date header 2digit year'); + ok('"24-Aug-1987 16:00:00 +0200"' eq good_date('Tue, 24 Aug 87 16:00:00 +0200'), 'good_date header 2digit year'); + ok('"24-Aug-1997 16:00:00 +0200"' eq good_date('Tue, 24 Aug 97 16:00:00 +0200'), 'good_date header 2digit year'); + ok('"24-Aug-2004 16:00:00 +0200"' eq good_date('Tue, 24 Aug 04 16:00:00 +0200'), 'good_date header 2digit year'); + ok('"24-Aug-1997 16:00:00 +0200"' eq good_date('Tue, 24 Aug 1997 16.00.00 +0200'), 'good_date header period time sep'); + ok('"24-Aug-1997 16:00:00 +0200"' eq good_date('Tue, 24 Aug 1997 16:00:00 +0200'), 'good_date header extra white space type1'); + ok('"24-Aug-1997 05:06:02 +0200"' eq good_date('Tue, 24 Aug 1997 5:6:2 +0200'), 'good_date header 1digit time vals'); + ok('"24-Aug-1997 05:06:02 +0200"' eq good_date('Tue, 24, Aug 1997 05:06:02 +0200'), 'good_date header extra commas'); + ok('"01-Oct-2003 12:45:24 +0000"' eq good_date('Wednesday, 01 October 2003 12:45:24 CDT'), 'good_date header no abbrev'); + ok('"11-Jan-2005 17:58:27 -0500"' eq good_date('Tue, 11 Jan 2005 17:58:27 -0500'), 'good_date extra white space'); + ok('"18-Dec-2002 15:07:00 +0000"' eq good_date('Wednesday, December 18, 2002 03:07 PM'), 'good_date kbtoys.com orders'); + ok('"16-Dec-2004 02:01:49 -0500"' eq good_date('Dec 16 2004 02:01:49 -0500'), 'good_date jr.com orders'); + ok('"21-Jun-2001 11:11:11 +0000"' eq good_date('21-Jun-2001'), 'good_date register.com domain transfer'); + +} + + +sub tests_list_keys_in_2_not_in_1 { + + my @list; + ok( ! list_keys_in_2_not_in_1( {}, {}), 'list_keys_in_2_not_in_1: {} {}'); + ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {}, {} ) ] ), 'list_keys_in_2_not_in_1: {} {}'); + ok( 0 == compare_lists( ['a','b'], [ list_keys_in_2_not_in_1( {}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {} {a, b}'); + ok( 0 == compare_lists( ['b'], [ list_keys_in_2_not_in_1( {'a' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a} {a, b}'); + ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b} {a, b}'); + ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}'); + ok( 0 == compare_lists( ['b'], [ list_keys_in_2_not_in_1( {'a' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}'); + +} + +sub list_keys_in_2_not_in_1 { + + my $folders1_ref = shift; + my $folders2_ref = shift; + my @list; + + foreach my $folder ( sort keys %$folders2_ref ) { + next if exists($folders1_ref->{$folder}); + push(@list, $folder); + } + return(@list); +} + + +sub list_folders_in_2_not_in_1 { + + my (@h2_folders_not_in_1, %h2_folders_not_in_1); + @h2_folders_not_in_1 = list_keys_in_2_not_in_1( \%h1_folders_all, \%h2_folders_all); + map { $h2_folders_not_in_1{$_} = 1} @h2_folders_not_in_1; + @h2_folders_not_in_1 = list_keys_in_2_not_in_1( \%h2_folders_from_1_all, \%h2_folders_not_in_1); + + return( reverse @h2_folders_not_in_1 ); +} + +sub delete_folders_in_2_not_in_1 { + + my $dry_message = ''; + $dry_message = "\t(not really since --dry mode)" if $dry; + foreach my $folder (@h2_folders_not_in_1) { + if ( defined( $delete2foldersonly ) and eval( "\$folder !~ $delete2foldersonly" ) ) { + print "Not deleting $folder because of --delete2foldersonly $delete2foldersonly\n"; + next; + } + if ( defined( $delete2foldersbutnot ) and eval( "\$folder =~ $delete2foldersbutnot" ) ) { + print "Not deleting $folder because of --delete2foldersbutnot $delete2foldersbutnot\n"; + next; + } + my $res = $dry ; # always success in dry mode! + $imap2->unsubscribe( $folder ) if ( ! $dry ) ; + $res = $imap2->delete( $folder ) if ( ! $dry ) ; + if ( $res ) { + print "Delete $folder", "$dry_message", "\n" ; + }else{ + print "Delete $folder failure", "\n" ; + } + } +} + + +sub extract_header { + my $string = shift ; + + my ( $header ) = split( /\n\n/, $string ) ; + #print "[$header]\n" ; + return( $header ) ; +} + +sub tests_extract_header { + ok( +'Message-Id: <20100428101817.A66CB162474E@plume.est.belle> +Date: Wed, 28 Apr 2010 12:18:17 +0200 (CEST) +From: gilles@louloutte.dyndns.org (Gilles LAMIRAL)' +eq extract_header( +'Message-Id: <20100428101817.A66CB162474E@plume.est.belle> +Date: Wed, 28 Apr 2010 12:18:17 +0200 (CEST) +From: gilles@louloutte.dyndns.org (Gilles LAMIRAL) + +body +lalala +' ), 'extract_header: 1') ; + +} + +sub decompose_header{ + my $string = shift ; + + my $header = { } ; + + my ($key, $val ) ; + my @line = split( /\n|\r\n/, $string ) ; + foreach my $line ( @line ) { + #print "DDD $line\n" ; + if( $line =~ m/(^[^ :]+): (.*)/ ) { + $key = $1 ; + $val = $2 ; + #print "DDD [$key] [$val]\n" ; + push( @{ $header->{ $key } }, $val ) ; + }elsif( $line =~ m/^(\s+)(.*)/ ) { + $val = $2 ; + #print "DDD only [$val]\n" ; + @{ $header->{ $key } }[ -1 ] .= " $val" if $key ; + }else{ + next ; + } + } + #require Data::Dumper ; + #print Data::Dumper->Dump( [ $header ] ) ; + + return( $header ) ; +} + + +sub tests_decompose_header{ + + my $header_dec ; + + $header_dec = decompose_header( +'KEY_1: VAL_1 +KEY_2: VAL_2 + VAL_2_+ + VAL_2_++ +KEY_3: VAL_3 +KEY_1: VAL_1_other +' + ) ; + + ok( 'VAL_3' + eq $header_dec->{ 'KEY_3' }[0], 'decompose_header: VAL_3' ) ; + + ok( 'VAL_1' + eq $header_dec->{ 'KEY_1' }[0], 'decompose_header: VAL_1' ) ; + + ok( 'VAL_1_other' + eq $header_dec->{ 'KEY_1' }[1], 'decompose_header: VAL_1_other' ) ; + + ok( 'VAL_2 VAL_2_+ VAL_2_++' + eq $header_dec->{ 'KEY_2' }[0], 'decompose_header: VAL_2 VAL_2_+ VAL_2_++' ) ; + + + $header_dec = decompose_header( +'Message-Id: <20100428101817.A66CB162474E@plume.est.belle> +Date: Wed, 28 Apr 2010 12:18:17 +0200 (CEST) +From: gilles@louloutte.dyndns.org (Gilles LAMIRAL)' + ) ; + + ok( '<20100428101817.A66CB162474E@plume.est.belle>' + eq $header_dec->{ 'Message-Id' }[0], 'decompose_header: 1' ) ; + + $header_dec = decompose_header( +'Return-Path: +Received: by plume.est.belle (Postfix, from userid 1000) + id 120A71624742; Wed, 28 Apr 2010 01:46:40 +0200 (CEST) +Subject: test:eekahceishukohpe' + ) ; + ok( +'by plume.est.belle (Postfix, from userid 1000) id 120A71624742; Wed, 28 Apr 2010 01:46:40 +0200 (CEST)' + eq $header_dec->{ 'Received' }[0], 'decompose_header: 2' ) ; + + $header_dec = decompose_header( +'Received: from plume (localhost [127.0.0.1]) + by plume.est.belle (Postfix) with ESMTP id C6EB73F6C9 + for ; Mon, 26 Nov 2007 10:39:06 +0100 (CET) +Received: from plume [192.168.68.7] + by plume with POP3 (fetchmail-6.3.6) + for (single-drop); Mon, 26 Nov 2007 10:39:06 +0100 (CET)' + ) ; + ok( + 'from plume (localhost [127.0.0.1]) by plume.est.belle (Postfix) with ESMTP id C6EB73F6C9 for ; Mon, 26 Nov 2007 10:39:06 +0100 (CET)' + eq $header_dec->{ 'Received' }[0], 'decompose_header: 3' ) ; + ok( + 'from plume [192.168.68.7] by plume with POP3 (fetchmail-6.3.6) for (single-drop); Mon, 26 Nov 2007 10:39:06 +0100 (CET)' + eq $header_dec->{ 'Received' }[1], 'decompose_header: 3' ) ; + +# Bad header beginning with a blank character + $header_dec = decompose_header( +' KEY_1: VAL_1 +KEY_2: VAL_2 + VAL_2_+ + VAL_2_++ +KEY_3: VAL_3 +KEY_1: VAL_1_other +' + ) ; + + ok( 'VAL_3' + eq $header_dec->{ 'KEY_3' }[0], 'decompose_header: Bad header VAL_3' ) ; + + ok( 'VAL_1_other' + eq $header_dec->{ 'KEY_1' }[0], 'decompose_header: Bad header VAL_1_other' ) ; + + ok( 'VAL_2 VAL_2_+ VAL_2_++' + eq $header_dec->{ 'KEY_2' }[0], 'decompose_header: Bad header VAL_2 VAL_2_+ VAL_2_++' ) ; +} + +sub epoch { + # incoming format: + # internal date 24-Aug-2010 16:00:00 +0200 + + # outgoing format: epoch + + + my $d = shift ; + return ('') if not defined($d); + + my ( $mday, $month, $year, $hour, $min, $sec, $sign, $zone_h, $zone_m ) ; + my $time ; + + if ( $d =~ m{(\d{2})-([A-Z][a-z]{2})-(\d{4}) (\d{2}):(\d{2}):(\d{2}) ((?:\+|-))(\d{2})(\d{2})}o ) { + #print "internal: [$1][$2][$3][$4][$5][$6][$7][$8][$9]\n" ; + ( $mday, $month, $year, $hour, $min, $sec, $sign, $zone_h, $zone_m ) + = ( $1, $2, $3, $4, $5, $6, $7, $8, $9 ) ; + #print "( $mday, $month, $year, $hour, $min, $sec, $sign, $zone_h, $zone_m )\n" ; + + $sign = +1 if ( '+' eq $sign ) ; + $sign = -1 if ( '-' eq $sign ) ; + + $time = timegm( $sec, $min, $hour, $mday, $month_abrev{$month}, $year ) + - $sign * ( 3600 * $zone_h + 60 * $zone_m ) ; + + #print( "$time ", scalar(localtime($time)), "\n"); + } + return( $time ) ; +} + +sub tests_epoch { + ok( '1282658400' eq epoch( '24-Aug-2010 16:00:00 +0200' ), 'epoch 24-Aug-2010 16:00:00 +0200 -> 1282658400' ) ; + ok( '1282658400' eq epoch( '24-Aug-2010 14:00:00 +0000' ), 'epoch 24-Aug-2010 14:00:00 +0000 -> 1282658400' ) ; + ok( '1282658400' eq epoch( '24-Aug-2010 12:00:00 -0200' ), 'epoch 24-Aug-2010 12:00:00 -0200 -> 1282658400' ) ; + ok( '1282658400' eq epoch( '24-Aug-2010 16:01:00 +0201' ), 'epoch 24-Aug-2010 16:01:00 +0201 -> 1282658400' ) ; + ok( '1282658400' eq epoch( '24-Aug-2010 14:01:00 +0001' ), 'epoch 24-Aug-2010 14:01:00 +0001 -> 1282658400' ) ; +} + +sub add_header { + my $uid = shift || 'mistake' ; + my $header = 'Message-Id: <' . $uid . '@imapsync>' ; + return( $header ) ; +} + +sub tests_add_header { + ok( 'Message-Id: ' eq add_header(), 'add_header no arg' ) ; + ok( 'Message-Id: <123456789@imapsync>' eq add_header(123456789), 'add_header 123456789' ) ; + +} + + +sub tests_debug { + + SKIP: { + skip "No test in normal run" if ( not $tests_debug ); + tests_imap2_folder_name( ) ; + } +} + +sub tests { + + SKIP: { + skip "No test in normal run" if (not $tests); + tests_folder_routines(); + tests_compare_lists(); + tests_regexmess(); + tests_flags_regex(); + tests_permanentflags(); + tests_flags_filter( ) ; + tests_imap2_folder_name(); + tests_command_line_nopassword(); + tests_good_date(); + tests_max(); + tests_remove_not_num(); + tests_memory_consumption(); + tests_is_a_release_number(); + tests_imapsync_basename(); + tests_list_keys_in_2_not_in_1(); + tests_convert_sep_to_slash( ) ; + tests_match_a_cache_file( ) ; + tests_cache_map( ) ; + tests_get_cache( ) ; + tests_clean_cache( ) ; + tests_clean_cache_2( ) ; + tests_touch( ) ; + tests_ucsecond( ) ; + tests_flagsCase( ) ; + tests_mkpath( ) ; + tests_extract_header( ) ; + tests_decompose_header( ) ; + tests_epoch( ) ; + tests_add_header( ) ; + tests_cache_dir_fix( ) ; + tests_filter_forbidden_characters( ) ; + tests_cache_folder( ) ; + tests_time_remaining( ) ; + } +} + +# IMAPClient 3.31 overrides + +sub override_imapclient2 { +no warnings 'redefine'; +no strict 'subs'; + +use constant Unconnected => 0; +use constant Connected => 1; # connected; not logged in +use constant Authenticated => 2; # logged in; no mailbox selected +use constant Selected => 3; # mailbox selected +use constant INDEX => 0; # Array index for output line number +use constant TYPE => 1; # Array index for line type + # (either OUTPUT, INPUT, or LITERAL) +use constant DATA => 2; # Array index for output line data +use constant NonFolderArg => 1; # Value to pass to Massage to + # indicate non-folder argument + +*Mail::IMAPClient::authenticate = sub { + + my $self = shift; + my $scheme = shift; + my $response = shift; + + $scheme ||= $self->Authmechanism; + $response ||= $self->Authcallback; + my $clear = $self->Clear; + + $self->Clear($clear) + if $self->Count >= $clear and $clear > 0; + + my $count = $self->Count($self->Count+1); + + + my $string = "$count AUTHENTICATE $scheme"; + + $self->_record($count,[ $self->_next_index($self->Transaction), + "INPUT", "$string\x0d\x0a"] ); + + my $feedback = $self->_send_line("$string"); + + unless ($feedback) { + $self->LastError("Error sending '$string' to IMAP: $!\n"); + return undef; + } + + my ($code, $output); + + until ($code) { + $output = $self->_read_line or return undef; + + foreach my $o (@$output) { + $self->_record($count,$o); # $o is a ref + ($code) = $o->[DATA] =~ /^\+(.*)$/ ; + if ($o->[DATA] =~ /^\*\s+BYE/) { + $self->State(Unconnected); + return undef ; + } + if ($o->[DATA]=~ /^\d+\s+(NO|BAD)/i) { + return undef ; + } + } + } + + if ('CRAM-MD5' eq $scheme && ! $response) { + if ($Mail::IMAPClient::_CRAM_MD5_ERR) { + $self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR); + carp $Mail::IMAPClient::_CRAM_MD5_ERR; + } + else { + $response = \&Mail::IMAPClient::_cram_md5; + } + } + + $feedback = $self->_send_line($response->($code, $self)); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + return undef; + } + + $code = ""; # clear code + until ($code) { + $output = $self->_read_line or return undef; + foreach my $o (@$output) { + $self->_record($count,$o); # $o is a ref + if ( ($code) = $o->[DATA] =~ /^\+ (.*)$/ ) { + $feedback = $self->_send_line($response->($code,$self)); + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + return undef; + } + $code = "" ; # Clear code; we're still not finished + } else { + $o->[DATA] =~ /^$count (OK|NO|BAD)/ and $code = $1; + if ($o->[DATA] =~ /^\*\s+BYE/) { + $self->State(Unconnected); + return undef ; + } + } + } + } + + ##$code =~ /^OK/ and $self->State(Authenticated) ; + ##return $code =~ /^OK/ ? $self : undef ; + + # Return undef on authenticate failure + if (! ($code =~ /^OK/)) { + return undef; + } + + # With XGWTRUSTEDAPP authentication, we have to select mailbox after auth + if ($scheme eq 'XGWTRUSTEDAPP') { + + my $id = $self->User; + my $has_quotes = $id =~ /^".*"$/ ? 1 : 0; + my $string = "Login " . ( $has_quotes ? $id : qq("$id") ) . "\r\n"; + $self->_imap_command($string) + and $self->State(Authenticated); + # $self->folders and $self->separator unless $self->NoAutoList; + unless ( $self->IsAuthenticated) { + my($carp) = $self->LastError; + $carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/; + carp $carp unless defined wantarray; + return undef; + }; + return $self; + } + + # Set authenticated flag and return imap object + $self->State(Authenticated); + return $self; +}; + +} + +# End of sub override_imapclient2 (yes, very bad indentation) + +# IMAPClient 2.2.9 overrides + +sub override_imapclient { +no warnings 'redefine'; +no strict 'subs'; + +use constant Unconnected => 0; +use constant Connected => 1; # connected; not logged in +use constant Authenticated => 2; # logged in; no mailbox selected +use constant Selected => 3; # mailbox selected +use constant INDEX => 0; # Array index for output line number +use constant TYPE => 1; # Array index for line type + # (either OUTPUT, INPUT, or LITERAL) +use constant DATA => 2; # Array index for output line data +use constant NonFolderArg => 1; # Value to pass to Massage to + # indicate non-folder argument + + +*Mail::IMAPClient::_transaction_literals = sub { + my $self = shift; + my $string = ""; + + foreach my $result (@{$self->{"History"}{$self->Transaction}}) { + $string .= $result->[DATA] + if defined($result) and $self->_is_literal($result) ; + } + return $string; +}; + +# Got from 3.25 +*Mail::IMAPClient::append_string = sub { + my $self = shift; + my $folder = $self->Massage(shift); + my ( $text, $flags, $date ) = @_; + defined $text or $text = ''; + + if ( defined $flags ) { + $flags =~ s/^\s+//g; + $flags =~ s/\s+$//g; + $flags = "($flags)" if $flags !~ /^\(.*\)$/; + } + + if ( defined $date ) { + $date =~ s/^\s+//g; + $date =~ s/\s+$//g; + $date = qq("$date") if $date !~ /^"/; + } + + $text =~ s/\r?\n/$CRLF/og; + + my $command = + "APPEND $folder " + . ( $flags ? "$flags " : "" ) + . ( $date ? "$date " : "" ) . "{" + . length($text) + . "}$CRLF"; + + $command .= $text . $CRLF; + $self->_imap_command( $command ) or return undef; + + my $data = join '', $self->Results; + #print "ZZZ|$data|ZZZ\n"; + # look for something like return size or self if no size found: + # OK [APPENDUID ] APPEND completed + # 18 OK [APPENDUID 1286144680 1539] APPEND Ok. + my $ret = $data =~ m#^\d+ OK \[APPEND.*\s+(\d+)\].*\Z#m ? $1 : $self; + + return $ret; +}; + + +*Mail::IMAPClient::fetch_hash = sub { + # taken from above *Mail::IMAPClient::fetch_hash + # if last arg is a ref then the fetch is done only + # on the messages listed as the keys of this hash. + # Init an "empty" $hash_ref by value can be done this way: + # @$hash_ref{2, 3, 4, 55} = (undef); + + my $self = shift; + my $hash_ref = ref($_[-1]) ? pop @_ : {}; + my @words = @_; + for (@words) { + s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i ; + s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i ; + } + + my $msgs_ref_all; + if (scalar %$hash_ref) { + $msgs_ref_all = [ sort { $a <=> $b } keys (%$hash_ref) ]; + #print "ZZZZ 1 [@$msgs_ref_all]\n"; + }else{ + $msgs_ref_all = scalar($self->messages); + #print "ZZZZ 2 [@$msgs_ref_all]\n"; + } + + my $split = $self->Split() || scalar(@$msgs_ref_all); + while(my @msgs = splice(@$msgs_ref_all, 0, $split)) { + #print "SPLIT: @msgs\n"; + my $msgs_ref = \@msgs; + my $output = scalar($self->fetch($msgs_ref,"(" . join(" ",@_) . ")")) + ; # unless grep(/\b(?:FAST|FULL)\b/i,@words); + my $x; + for ($x = 0; $x <= $#$output ; $x++) { + my $entry = {}; + my $l = $output->[$x]; + if ($self->Uid) { + my($uid) = $l =~ /\((?:.* )?UID (\d+).*\)/i; + next unless $uid; + if ( defined $hash_ref->{$uid} ) { + $entry = $hash_ref->{$uid} ; + } + else { + $hash_ref->{$uid} ||= $entry; + } + } + else { + my($mid) = $l =~ /^\* (\d+) FETCH/i; + next unless $mid; + if ( defined $hash_ref->{$mid} ) { + $entry = $hash_ref->{$mid} ; + } + else { + $hash_ref->{$mid} ||= $entry; + } + } + + foreach my $w (@words) { + if ( $l =~ /\Q$w\E\s*$/i ) { + $entry->{$w} = $output->[$x+1]; + $entry->{$w} =~ s/(?:\x0a?\x0d)+$//g; + chomp $entry->{$w}; + } + else { + $l =~ /\( # open paren followed by ... + (?:.*\s)? # ...optional stuff and a space + \Q$w\E\s # escaped fetch field + (?:" # then: a dbl-quote + (\\.| # then bslashed anychar(s) or ... + [^"]+) # ... nonquote char(s) + "| # then closing quote; or ... + \( # ...an open paren + (\\.| # then bslashed anychar or ... + [^\)]*) # ... non-close-paren char + \)| # then closing paren; or ... + (\S+)) # unquoted string + (?:\s.*)? # possibly followed by space-stuff + \) # close paren + /xi; + $entry->{$w}=defined($1)?$1:defined($2)?$2:$3; + } + } + } +} + return wantarray ? %$hash_ref : $hash_ref; +}; + + + +*Mail::IMAPClient::login = sub { + my $self = shift; + return $self->authenticate($self->Authmechanism,$self->Authcallback) + if $self->{Authmechanism}; + + my $id = $self->User; + my $has_quotes = $id =~ /^".*"$/ ? 1 : 0; + my $string = "Login " . ( $has_quotes ? $id : qq("$id") ) . + " " . $self->Password . "\r\n"; + $self->_imap_command($string) + and $self->State(Authenticated); + # $self->folders and $self->separator unless $self->NoAutoList; + unless ( $self->IsAuthenticated) { + my($carp) = $self->LastError; + $carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/; + carp $carp unless defined wantarray; + return undef; + }; + return $self; +}; + + +*Mail::IMAPClient::get_header = sub { + my($self , $msg, $header ) = @_; + my $val; + + #eval { $val = $self->parse_headers([$msg],$header)->{$header}[0] }; + my $h = $self->parse_headers([$msg],$header); + #require Data::Dumper; + #print Data::Dumper->Dump([$h]); + #$val = $self->parse_headers([$msg],$header)->{$header}[0]; + + $val = $h->{$msg}{$header}[0]; + return defined($val)? $val : undef; +}; + + +*Mail::IMAPClient::parse_headers = sub { + my($self,$msgspec_all,@fields) = @_; + my(%fieldmap) = map { ( lc($_),$_ ) } @fields; + my $msg; my $string; my $field; + #print ref($msgspec_all), "\n"; + #if(ref($msgspec_all) eq 'HASH') { + # print ref($msgspec_all), "\n"; + #$msgspec_all = [$msgspec_all]; + #} + + unless(ref($msgspec_all) eq 'ARRAY') { + print "parse_headers want an ARRAY ref\n"; + #exit 1; + return undef; + } + + my $headers = {}; # hash from message ids to header hash + my $split = $self->Split() || scalar(@$msgspec_all); + while(my @msgs = splice(@$msgspec_all, 0, $split)) { + #$debug and print "SPLIT: @msgs\n"; + my $msgspec = \@msgs; + + # Make $msg a comma separated list, of messages we want + $msg = $self->Range($msgspec); + + if ($fields[0] =~ /^[Aa][Ll]{2}$/ ) { + + $string = "$msg body" . + # use ".peek" if Peek parameter is a) defined and true, + # or b) undefined, but not if it's defined and untrue: + + ( defined($self->Peek) ? + ( $self->Peek ? ".peek" : "" ) : + ".peek" + ) . "[header]" ; + + }else { + $string = "$msg body" . + # use ".peek" if Peek parameter is a) defined and true, or + # b) undefined, but not if it's defined and untrue: + + ( defined($self->Peek) ? + ( $self->Peek ? ".peek" : "" ) : + ".peek" + ) . "[header.fields (" . join(" ",@fields) . ')]' ; + } + + my @raw=$self->fetch( $string ) or return undef; + + + my $h = 0; # reference to hash of current msgid, or 0 between msgs + + for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) { + + no warnings; + if ( $header =~ /^\*\s+\d+\s+FETCH\s+\(.*BODY\[HEADER(?:\]|\.FIELDS)/i) { + if ($self->Uid) { + if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) { + $h = {}; + $headers->{$msgid} = $h; + } + else { + $h = {}; + } + } + else { + if ( my($msgid) = $header =~ /^\*\s+(\d+)/ ) { + #start of new message header: + $h = {}; + $headers->{$msgid} = $h; + } + } + } + next if $header =~ /^\s+$/; + + # ( for vi + if ($header =~ /^\)/) { # end of this message + $h = 0; # set to be between messages + next; + } + # check for 'UID)' + # when parsing headers by UID. + if ($self->Uid and my($msgid) = $header =~ /^\s*UID\s+(\d+)\s*\)/) { + $headers->{$msgid} = $h; # store in results against this message + $h = 0; # set to be between messages + next; + } + + if ($h != 0) { # do we expect this to be a header? + my $hdr = $header; + chomp $hdr; + $hdr =~ s/\r$//; + #print "W[$hdr]", ref($hdr), "!\n"; + #next if ( ! defined($hdr)); + #print "X[$hdr]\n"; + + if (defined($hdr) and ($hdr =~ s/^(\S+):\s*//)) { + # if ($hdr =~ s/^(\S+):\s*//) { + #print "X1\n"; + $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; + push @{$h->{$field}} , $hdr ; + } elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) { + #print "X2\n"; + $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; + push @{$h->{$field}} , $hdr ; + } elsif ( ref($h->{$field}) eq 'ARRAY') { + #print "X3\n"; + + $hdr =~ s/^\s+/ /; + $h->{$field}[-1] .= $hdr ; + } + } + } + use warnings; +# my $candump = 0; +# if ($self->Debug) { +# eval { +# require Data::Dumper; +# Data::Dumper->import; +# }; +# $candump++ unless $@; +# } + + } + # if we asked for one message, just return its hash, + # otherwise, return hash of numbers => header hash + # if (ref($msgspec) eq 'ARRAY') { + + return $headers; + +}; + + +*Mail::IMAPClient::authenticate = sub { + + my $self = shift; + my $scheme = shift; + my $response = shift; + + $scheme ||= $self->Authmechanism; + $response ||= $self->Authcallback; + my $clear = $self->Clear; + + $self->Clear($clear) + if $self->Count >= $clear and $clear > 0; + + my $count = $self->Count($self->Count+1); + + + my $string = "$count AUTHENTICATE $scheme"; + + $self->_record($count,[ $self->_next_index($self->Transaction), + "INPUT", "$string\x0d\x0a"] ); + + my $feedback = $self->_send_line("$string"); + + unless ($feedback) { + $self->LastError("Error sending '$string' to IMAP: $!\n"); + return undef; + } + + my ($code, $output); + + until ($code) { + $output = $self->_read_line or return undef; + + foreach my $o (@$output) { + $self->_record($count,$o); # $o is a ref + ($code) = $o->[DATA] =~ /^\+(.*)$/ ; + if ($o->[DATA] =~ /^\*\s+BYE/) { + $self->State(Unconnected); + return undef ; + } + if ($o->[DATA]=~ /^\d+\s+(NO|BAD)/i) { + return undef ; + } + } + } + + if ('CRAM-MD5' eq $scheme && ! $response) { + if ($Mail::IMAPClient::_CRAM_MD5_ERR) { + $self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR); + carp $Mail::IMAPClient::_CRAM_MD5_ERR; + } + else { + $response = \&Mail::IMAPClient::_cram_md5; + } + } + + $feedback = $self->_send_line($response->($code, $self)); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + return undef; + } + + $code = ""; # clear code + until ($code) { + $output = $self->_read_line or return undef; + foreach my $o (@$output) { + $self->_record($count,$o); # $o is a ref + if ( ($code) = $o->[DATA] =~ /^\+ (.*)$/ ) { + $feedback = $self->_send_line($response->($code,$self)); + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + return undef; + } + $code = "" ; # Clear code; we're still not finished + } else { + $o->[DATA] =~ /^$count (OK|NO|BAD)/ and $code = $1; + if ($o->[DATA] =~ /^\*\s+BYE/) { + $self->State(Unconnected); + return undef ; + } + } + } + } + + ##$code =~ /^OK/ and $self->State(Authenticated) ; + ##return $code =~ /^OK/ ? $self : undef ; + + # Return undef on authenticate failure + if (! ($code =~ /^OK/)) { + return undef; + } + + # With XGWTRUSTEDAPP authentication, we have to select mailbox after auth + if ($scheme eq 'XGWTRUSTEDAPP') { + + my $id = $self->User; + my $has_quotes = $id =~ /^".*"$/ ? 1 : 0; + my $string = "Login " . ( $has_quotes ? $id : qq("$id") ) . "\r\n"; + $self->_imap_command($string) + and $self->State(Authenticated); + # $self->folders and $self->separator unless $self->NoAutoList; + unless ( $self->IsAuthenticated) { + my($carp) = $self->LastError; + $carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/; + carp $carp unless defined wantarray; + return undef; + }; + return $self; + } + + # Set authenticated flag and return imap object + $self->State(Authenticated); + return $self; +}; + + + +*Mail::IMAPClient::_cram_md5 = sub { + my ($code, $client) = @_; + my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($code), + $client->Password()); + return MIME::Base64::encode($client->User() . " $hmac", ""); +}; + +*Mail::IMAPClient::message_string = sub { + my $self = shift; + my $msg = shift; + my $expected_size = $self->size($msg); + return undef unless(defined $expected_size); # unable to get size + my $cmd = $self->has_capability('IMAP4REV1') ? + "BODY" . ( $self->Peek ? '.PEEK[]' : '[]' ) : + "RFC822" . ( $self->Peek ? '.PEEK' : '' ) ; + + #print "Message_string Beg fetch:\n", memory_consumption(); + $self->fetch($msg,$cmd) or return undef; + #print "Message_string End fetch:\n", memory_consumption(); + + my $string = ""; + + + foreach my $result (@{$self->{"History"}{$self->Transaction}}) { + $string .= $result->[DATA] + if defined($result) and $self->_is_literal($result) ; + } + #print "Message_string End string:\n", memory_consumption(); + + # BUG? should probably return undef if length != expected + # No bug, somme servers are buggy. + + if (! $self->Ignoresizeerrors ) { + if ( length($string) != $expected_size ) { + print "message_string: " . + "expected $expected_size bytes but received " . + length($string) . "\n"; + $self->LastError("message_string: expected ". + "$expected_size bytes but received " . + length($string)."\n"); + } + } + return $string; +}; + + + +{ +no warnings 'once'; + +*Mail::IMAPClient::Ssl = sub { + my $self = shift; + + if (@_) { $self->{SSL} = shift } + return $self->{SSL}; +}; + +*Mail::IMAPClient::Starttls = sub { + my $self = shift; + + if (@_) { $self->{Starttls} = shift } + return $self->{Starttls}; +}; + + + +*Mail::IMAPClient::exists = sub { + # Bad implementation STATUS fails and can close the connexion + # Exchange does this after 10 failures + my ( $self, $folder ) = @_; + $self->status($folder) ? $self : undef; +}; + + + +*Mail::IMAPClient::Authuser = sub { + my $self = shift; + + if (@_) { $self->{AUTHUSER} = shift } + return $self->{AUTHUSER}; +}; + + +*Mail::IMAPClient::Ignoresizeerrors = sub { + my $self = shift; + + if (@_) { $self->{IGNORESIZEERRORS} = shift } + return $self->{IGNORESIZEERRORS}; +}; + +*Mail::IMAPClient::Reconnectretry = sub { + my $self = shift; + + if (@_) { $self->{RECONNECTRETRY} = shift } + return $self->{RECONNECTRETRY}; +}; + + +*Mail::IMAPClient::reconnect = sub { + my $self = shift; + + if ( $self->IsAuthenticated ) { + $self->_debug("reconnect called but already authenticated"); + return $self; + } + + my $einfo = $self->LastError || ""; + $self->_debug( "reconnecting to ", $self->Server, ", last error: $einfo" ); + + # reconnect and select appropriate folder + $self->connect or return undef; + + return ( defined $self->Folder ) ? $self->select( $self->Folder ) : $self; +}; + + +# wrapper for _imap_command_do to enable retrying on lost connections +*Mail::IMAPClient::_imap_command = sub { + my $self = shift; + + my $tries = 0; + my $retry = $self->Reconnectretry || 0; + my ( $rc, @err ); + + #print "@_ Beg _imap_command:\n", memory_consumption(); + + # LastError (if set) will be overwritten masking any earlier errors + while ( $tries++ <= $retry ) { + # do command on the first try or if Connected (reconnect ongoing) + if ( $tries == 1 or $self->IsConnected ) { + #print "call @_\n"; + $rc = $self->_imap_command_do(@_); + push( @err, $self->LastError ) if $self->LastError; + #print "call @_ done [", $rc || '', "] [$tries/$retry][" . $self->IsUnconnected . "]\n"; + } + + if ( !defined($rc) + and $retry and $self->IsUnconnected + and ( $self->LastIMAPCommand !~ /LOGOUT/ ) + + ) { + print "\nWarning: disconnected. "; + if ( $self->reconnect ) { + print "Reconnect successful on try #$tries\n"; + $self->Reconnect_counter($self->Reconnect_counter() + 1); + } + else { + print "Reconnect failed on try #$tries\n"; + push( @err, $self->LastError ) if $self->LastError; + } + } + else { + last; + } + } + + unless ($rc) { + my ( %seen, @keep, @info ); + + foreach my $str (@err) { + my ( $sz, $len ) = ( 96, length($str) ); + $str =~ s/$CR?$LF$/\\n/omg; + if ( !$self->Debug and $len > $sz * 2 ) { + my $beg = substr( $str, 0, $sz ); + my $end = substr( $str, -$sz, $sz ); + $str = $beg . "..." . $end; + } + next if $seen{$str}++; + push( @keep, $str ); + } + foreach my $msg (@keep) { + push( @info, $msg . ( $seen{$msg} > 1 ? " ($seen{$msg}x)" : "" ) ); + } + $self->LastError( join( "; ", @info ) ); + } + #print "@_ End _imap_command:\n", memory_consumption(); + return $rc; +}; + + +*Mail::IMAPClient::_imap_command_do = sub { + + my $self = shift; + my $string = shift or return undef; + my $good = shift || 'GOOD'; + + my $qgood = quotemeta($good); + + my $clear = ""; + $clear = $self->Clear; + + $self->Clear($clear) + if $self->Count >= $clear and $clear > 0; + + my $count = $self->Count($self->Count+1); + + $string = "$count $string" ; + + #print "$string\n", memory_consumption(); + $self->_record($count,[ 0, "INPUT", "$string\x0d\x0a"] ); + #print "\n2 $count\n", memory_consumption(); + my $feedback = $self->_send_line("$string"); + + unless ($feedback) { + $self->LastError( "Error sending '$string' to IMAP: $!\n"); + $@ = "Error sending '$string' to IMAP: $!"; + carp "Error sending '$string' to IMAP: $!"; + return undef; + } + + my ($code, $output); + $output = ""; + + READ: until ( $code) { + # escape infinite loop if read_line never returns any data: + $output = $self->_read_line or return undef; + + for my $o (@$output) { + + $self->_record($count,$o); # $o is a ref + # $self->_debug("Received from readline: ${\($o->[DATA])}<>\n"); + next unless $self->_is_output($o); + if ( $good eq '+' ) { + $o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)|^($qgood)/mi ; + $code = $1||$2 ; + } else { + ($code) = $o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)/mi ; + } + if ($o->[DATA] =~ /^\*\s+BYE/im) { + $self->State(Unconnected); + return undef ; + } + } + } + #print "$string: returned $code\n", memory_consumption(); + # $self->_debug("Command $string: returned $code\n"); + return $code =~ /^OK|$qgood/im ? $self : undef ; + +}; + +# capability 2.2.9 is stupid: it caches and return first imap CAPABILITY call +# but call imap CAPABILITY each time. +# Copy/paste from 3.25 +*Mail::IMAPClient::capability = sub { + my $self = shift; + + if ( $self->{CAPABILITY} ) { + my @caps = keys %{ $self->{CAPABILITY} }; + return wantarray ? @caps : \@caps; + } + + $self->_imap_command('CAPABILITY') + or return undef; + + my @caps = map { split } grep s/^\*\s+CAPABILITY\s+//, $self->History; + foreach (@caps) { + $self->{CAPABILITY}{ uc $_ }++; + $self->{ uc $1 } = uc $2 if /(.*?)\=(.*)/; + } + + return wantarray ? @caps : \@caps; +}; + +*Mail::IMAPClient::_read_line = sub { + my $self = shift; + my $sh = $self->Socket; + my $literal_callback = shift; + my $output_callback = shift; + + unless ($self->IsConnected and $self->Socket) { + $self->LastError("NO Not connected.\n"); + carp "Not connected" if $^W; + return undef; + } + + my $iBuffer = ""; + my $oBuffer = []; + my $count = 0; + my $index = $self->_next_index($self->Transaction); + my $rvec = my $ready = my $errors = 0; + my $timeout = $self->Timeout; + + my $readlen = 1; + my $fast_io = $self->Fast_io; # Remember setting to reduce future method calls + + if ( $fast_io ) { + + # set fcntl if necessary: + exists $self->{_fcntl} or $self->Fast_io($fast_io); + $readlen = $self->{Buffer}||4096; + } + until ( + # there's stuff in output buffer: + scalar(@$oBuffer) and + + # the last thing there has cr-lf: + $oBuffer->[-1][DATA] =~ /\x0d\x0a$/ and + + # that thing is an output line: + $oBuffer->[-1][TYPE] eq "OUTPUT" and + + # and the input buffer has been MT'ed: + $iBuffer eq "" + + ) { + #print memory_consumption(); + my $transno = $self->Transaction; # used below in several places + if ($timeout) { + vec($rvec, fileno($self->Socket), 1) = 1; + my @ready = $self->{_select}->can_read($timeout) ; + unless ( @ready ) { + $self->LastError("Tag $transno: " . + "Timeout after $timeout seconds " . + "waiting for data from server\n"); + $self->_record($transno, + [ $self->_next_index($transno), + "ERROR", + "$transno * NO Timeout after ". + "$timeout seconds " . + "during read from " . + "server\x0d\x0a" + ] + ); + $self->LastError( + "Timeout after $timeout seconds " . + "during read from server\x0d\x0a" + ); + return undef; + } + } + + #local($^W) = undef; # Now quiet down warnings + + # read "$readlen" bytes (or less): + # need to check return code from $self->_sysread + # in case other end has shut down!!! + my $ret = $self->_sysread( $sh, \$iBuffer, $readlen, length($iBuffer)) ; + # $self->_debug("Read so far: $iBuffer<>\n"); + redo if(! defined($ret)) ; + if(($timeout and ! defined($ret))) { # Blocking read error... + my $msg = "Error while reading data from server: $!\x0d\x0a"; + $self->LastError('Error while reading data from server'); + $self->State(Unconnected); + print $msg; + $self->_record($transno, + [ $self->_next_index($transno), + "ERROR", "$transno * NO $msg " + ]); + $@ = "$msg"; + + return undef; + } + elsif(defined($ret) and $ret == 0) { # Caught EOF... + my $msg="Socket closed while reading data from server [$!]\x0d\x0a"; + print "$msg"; + $self->LastError('Socket closed while reading data from server'); + $self->State(Unconnected); + $self->_record($transno, + [ $self->_next_index($transno), + "ERROR", "$transno * NO $msg " + ]); + $@ = "$msg"; + return undef; + } + + # successfully wrote to other end, keep going... + $count += $ret; + LINES: while ( $iBuffer =~ s/^(.*?\x0d?\x0a)// ) { + my $current_line = $1; + #print memory_consumption(); + + # $self->_debug("BUFFER: pulled from buffer: ${current_line}\n" . + # "and left with buffer contents of: ${iBuffer}\n"); + + LITERAL: if ($current_line =~ s/\{(\d+)\}\x0d\x0a$//) { + # This part handles IMAP "Literals", + # which according to rfc2060 look something like this: + # [tag]|* BLAH BLAH {nnn}\r\n + # [nnn bytes of literally transmitted stuff] + # [part of line that follows literal data]\r\n + + # Set $len to be length of impending literal: + my $len = $1 ; + + $self->_debug("LITERAL: received literal in line ". + "$current_line of length $len; ". + "attempting to ". + "retrieve from the " . length($iBuffer) . + " bytes in: $iBuffer\n"); + + # Xfer up to $len bytes from front of $iBuffer to $litstring: + my $litstring = substr($iBuffer, 0, $len); + $iBuffer = substr($iBuffer, length($litstring), + length($iBuffer) - length($litstring) ) ; + + # Figure out what's left to read (i.e. what part of + # literal wasn't in buffer): + my $remainder_count = $len - length($litstring); + my $callback_value = ""; + + if ( defined($literal_callback) ) { + if ( $literal_callback =~ /GLOB/) { + print $literal_callback $litstring ; + $litstring = ""; + } elsif ($literal_callback =~ /CODE/ ) { + # Don't do a thing + + } else { + $self->LastError( + ref($literal_callback) . + " is an invalid callback type; " . + "must be a filehandle or coderef\n" + ); + } + + + } + if ($remainder_count > 0 and $timeout) { + # If we're doing timeouts then here we set up select + # and wait for data from the the IMAP socket. + vec($rvec, fileno($self->Socket), 1) = 1; + unless ( CORE::select( $ready = $rvec, + undef, + $errors = $rvec, + $timeout) + ) { + # Select failed; that means bad news. + # Better tell someone. + $self->LastError("Tag " . $transno . + ": Timeout waiting for literal data " . + "from server\n"); + carp "Tag " . $transno . + ": Timeout waiting for literal data " . + "from server\n" + if $self->Debug or $^W; + return undef; + } + } + + fcntl($sh, F_SETFL, $self->{_fcntl}) + if $fast_io and defined($self->{_fcntl}); + while ( $remainder_count > 0 ) { # As long as not done, + $self->_debug("Still need $remainder_count to " . + "complete literal string\n"); + my $ret = $self->_sysread( # bytes read + $sh, # IMAP handle + \$litstring, # place to read into + $remainder_count, # bytes left to read + length($litstring) # offset to read into + ) ; + $self->_debug("Received ret=$ret and buffer = " . + "\n$litstring\nwhile processing LITERAL\n"); + if ( $timeout and !defined($ret)) { # possible timeout + $self->_record($transno, [ + $self->_next_index($transno), + "ERROR", + "$transno * NO Error reading data " . + "from server: $!\n" + ] + ); + return undef; + } elsif ( $ret == 0 and eof($sh) ) { + $self->_record($transno, [ + $self->_next_index($transno), + "ERROR", + "$transno * ". + "BYE Server unexpectedly " . + "closed connection: $!\n" + ] + ); + $self->State(Unconnected); + return undef; + } + # decrement remaining bytes by amt read: + $remainder_count -= $ret; + + if ( length($litstring) > $len ) { + # copy the extra struff into the iBuffer: + $iBuffer = substr( + $litstring, + $len, + length($litstring) - $len + ); + $litstring = substr($litstring, 0, $len) ; + } + + if ( defined($literal_callback) ) { + if ( $literal_callback =~ /GLOB/ ) { + print $literal_callback $litstring; + $litstring = ""; + } + } + + } + $literal_callback->($litstring) + if defined($litstring) and + defined($literal_callback) and $literal_callback =~ /CODE/; + + $self->Fast_io($fast_io) if $fast_io; + + # Now let's make sure there are no IMAP server output lines + # (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string + # (There shouldn't be but I've seen it done!), but only if + # EnableServerResponseInLiteral is set to true + + my $embedded_output = 0; + my $lastline = ( split(/\x0d?\x0a/,$litstring))[-1] + if $litstring; + + if ( $self->EnableServerResponseInLiteral and + $lastline and + $lastline =~ /^(?:\*|(\d+))\s(BAD|NO|OK)/i + ) { + $litstring =~ s/\Q$lastline\E\x0d?\x0a//; + $embedded_output++; + + $self->_debug("Got server output mixed in " . + "with literal: $lastline\n" + ) if $self->Debug; + + } + # Finally, we need to stuff the literal onto the + # end of the oBuffer: + push @$oBuffer, [ $index++, "OUTPUT" , $current_line], + [ $index++, "LITERAL", $litstring ]; + push @$oBuffer, [ $index++, "OUTPUT", $lastline ] + if $embedded_output; + + } else { + push @$oBuffer, [ $index++, "OUTPUT" , $current_line ]; + } + + } + #$self->_debug("iBuffer is now: $iBuffer<>\n"); + } + # _debug $self, "Buffer is now $buffer\n"; + _debug $self, "Read: " . join("",map {$_->[DATA]} @$oBuffer) ."\n" + if $self->Debug; + return scalar(@$oBuffer) ? $oBuffer : undef ; +}; + + + +} + +# End of sub override_imapclient (yes, very bad indentation) +} + +# IMAPClient 2.2.9 3.xx ads + +package Mail::IMAPClient; + +sub Split { + my $self = shift; + + if (@_) { + $self->{SPLIT} = shift; + $self->{Maxcommandlength} = 10 * $self->{SPLIT}; + } + return $self->{SPLIT}; +} + +sub Tls { + my $self = shift; + + if (@_) { $self->{TLS} = shift } + return $self->{TLS}; +} + +sub Reconnect_counter { + my $self = shift; + $self->{Reconnect_counter} = 0 if ( not defined( $self->{Reconnect_counter} ) ) ; + if (@_) { $self->{Reconnect_counter} = shift } + return $self->{Reconnect_counter}; +} + + +sub Banner { + my $self = shift; + + if (@_) { $self->{BANNER} = shift } + return $self->{BANNER}; +} + + +sub RawSocket2 { + my ( $self, $sock ) = @_; + defined $sock + or return $self->{Socket}; + + $self->{Socket} = $sock; + $self->{_select} = IO::Select->new($sock); + delete $self->{_fcntl}; + #$self->Fast_io( $self->Fast_io ); + $sock; +} + +sub capability_update { + my $self = shift; + + delete $self->{CAPABILITY}; + $self->capability; +} + diff --git a/W/paypal_reply/paypal_build_invoices b/W/paypal_reply/paypal_build_invoices index a3a24f5..fdb6b26 100755 --- a/W/paypal_reply/paypal_build_invoices +++ b/W/paypal_reply/paypal_build_invoices @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: paypal_build_invoices,v 1.43 2012/12/15 00:15:56 gilles Exp gilles $ +# $Id: paypal_build_invoices,v 1.45 2013/01/10 03:08:23 gilles Exp gilles $ # usage: sh paypal_build_invoices /g/var/paypal_invoices/???? @@ -32,7 +32,8 @@ cp /home/gilles/public_html/AGIL/factures/000/facture_imapsync-000.tex /g/var/pa #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 1963 /g/paypal/paypal_2012_09_complet.csv #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2047 /g/paypal/paypal_2012_10_complet.csv #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2133 /g/paypal/paypal_2012_11_complet.csv -/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2224 /g/paypal/paypal_2012_12_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2224 /g/paypal/paypal_2012_12_complet.csv +/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2299 /g/paypal/paypal_2013_01_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 147 /g/paypal/paypal_2010_11_complet.csv @@ -59,20 +60,23 @@ cp /home/gilles/public_html/AGIL/factures/000/facture_imapsync-000.tex /g/var/pa : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 1891 /g/paypal/paypal_2012_08_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 1963 /g/paypal/paypal_2012_09_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2047 /g/paypal/paypal_2012_10_complet.csv -set -x : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2133 /g/paypal/paypal_2012_11_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2224 /g/paypal/paypal_2012_12_complet.csv +set -x +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2299 /g/paypal/paypal_2013_01_complet.csv set +x # La totale -: || /g/public_html/imapsync/W/paypal_reply/paypal_bilan --bnc --debug \ - --first_in 147 --avoid_numbers '292 293 643 644 731 732 1093 1330 1331 1332 1333 1334 1652 1653 2131 2132' \ +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --bnc --debug \ + --first_in 147 --avoid_numbers '292 293 643 644 731 732 1093 1330 1331 1332 1333 1334 1652 1653 2131 2132 2295 2296 2297 2298' \ /g/paypal/paypal_201?_??_complet.csv -: || /g/public_html/imapsync/W/paypal_reply/paypal_bilan \ - --first_in 147 --avoid_numbers '292 293 643 644 731 732 1093 1330 1331 1332 1333 1334 1652 1653 2131 2132' \ +set -v +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --first_in 147 --avoid_numbers '292 293 643 644 731 732 1093 1330 1331 1332 1333 1334 1652 1653 2131 2132 2295 2296 2297 2298' \ /g/paypal/paypal_201?_??_complet.csv +set +v echo 'sh paypal_build_invoices /g/var/paypal_invoices/2???' diff --git a/W/paypal_reply/paypal_build_reply b/W/paypal_reply/paypal_build_reply index 8ecd969..8eb9003 100755 --- a/W/paypal_reply/paypal_build_reply +++ b/W/paypal_reply/paypal_build_reply @@ -1,6 +1,6 @@ #!/usr/bin/perl -# $Id: paypal_build_reply,v 1.19 2012/04/30 22:57:04 gilles Exp gilles $ +# $Id: paypal_build_reply,v 1.20 2013/02/07 17:00:41 gilles Exp gilles $ use warnings; use strict; @@ -40,10 +40,12 @@ while(<>) { while(<>) { if ( /^Vous avez re.*paiement d'un montant de (.*) de la part de (.*) \((.*)\)/) { ($amount, $name, $email) = ($1, $2, $3); + $debug and print "1 ($amount, $name, $email)\n" ; last; } if ( /^Vous avez re.*paiement d'un montant de (.*) de la part de (.*)/) { ($amount, $name, $email) = ($1, "", $2); + $debug and print "2 ($amount, $name, $email)\n" ; last; } } @@ -55,18 +57,20 @@ my $path_last = firstline( '/g/public_html/imapsync/dist/path_last.txt' ) ; $url = "http://ks.lamiral.info/imapsync/dist/$path_last/" ; -#print "[$amount] [$name] [$email] [$paypal_line]\n"; +$debug and print "[$amount] [$name] [$email] [$paypal_line]\n"; while(<>) { if ( /^Acheteur/ ) { $buyer .= "===== Acheteur =====\n"; + $debug and print "1 $buyer\n" ; last; } if ( /^Informations sur l'acheteur/ ) { $buyer .= "===== Acheteur =====\n"; chomp( $name = <> ); $buyer .= "$name\n" ; + $debug and print "2 $buyer\n" ; last; } } @@ -75,16 +79,17 @@ while(<>) { $buyer .= $_ if ( ! /^-----------------------------------/ ); last if ( /^-----------------------------------/ ); } +$debug and print "3 $buyer\n" ; - -while(<>) { - next if ( ! /^Description :(.*)/ ); +while(<>) { + $debug and print "Search Description [$_]\n" ; + next if ( ! /Description..?:(.*)/ ); $object = $1 ; $description = "===== Details =====\n"; $description .= $_; last; } - +$debug and print "[$object] [$description]\n"; while(<>) { @@ -97,7 +102,7 @@ while(<>) { my $address = 'gilles.lamiral@laposte.net'; my $address2 = 'gilles@lamiral.info'; -my $rcstag = '$Id: paypal_build_reply,v 1.19 2012/04/30 22:57:04 gilles Exp gilles $'; +my $rcstag = '$Id: paypal_build_reply,v 1.20 2013/02/07 17:00:41 gilles Exp gilles $'; my $download_info = "You will find the latest imapsync.exe binary (release $release_exe) and the latest imapsync source code (release $release) at the following link: diff --git a/W/paypal_reply/paypal_functions b/W/paypal_reply/paypal_functions index acf049c..65bf5c4 100755 --- a/W/paypal_reply/paypal_functions +++ b/W/paypal_reply/paypal_functions @@ -240,7 +240,6 @@ paypal_all_dev() { echo "Will send_reply $@" send_reply "$@" echo "Done send_reply $@" - } diff --git a/W/paypal_reply/paypal_run_dev b/W/paypal_reply/paypal_run_dev index 837eb21..749312c 100755 --- a/W/paypal_reply/paypal_run_dev +++ b/W/paypal_reply/paypal_run_dev @@ -7,7 +7,7 @@ set -e # Add path to commands at home PATH=$PATH:/g/public_html/imapsync/W/paypal_reply -PERL5LIB=/g/public_html/imapsync/Mail-IMAPClient-3.32/lib +PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.32/lib export PERL5LIB test -f /g/public_html/imapsync/W/paypal_reply/paypal_functions \ diff --git a/W/paypal_reply/paypal_run_laposte b/W/paypal_reply/paypal_run_laposte index 643a878..02f75d3 100755 --- a/W/paypal_reply/paypal_run_laposte +++ b/W/paypal_reply/paypal_run_laposte @@ -5,10 +5,9 @@ set -e #set -x - # Add path to commands at home PATH=$PATH:/g/public_html/imapsync/W/paypal_reply -PERL5LIB=/g/public_html/imapsync/Mail-IMAPClient-3.32/lib +PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.32/lib export PERL5LIB test -f /g/public_html/imapsync/W/paypal_reply/paypal_functions \ diff --git a/W/paypal_reply/paypal_run_petite b/W/paypal_reply/paypal_run_petite index 5ed89d0..ea7651f 100755 --- a/W/paypal_reply/paypal_run_petite +++ b/W/paypal_reply/paypal_run_petite @@ -7,12 +7,12 @@ set -e # Add path to commands at home -PATH=$PATH:/g/public_html/imapsync/paypal_reply -PERL5LIB=/g/public_html/imapsync/Mail-IMAPClient-3.28/lib +PATH=$PATH:/g/public_html/imapsync/W/paypal_reply +PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.32/lib export PERL5LIB -test -f /g/public_html/imapsync/paypal_reply/paypal_functions \ -&& . /g/public_html/imapsync/paypal_reply/paypal_functions +test -f /g/public_html/imapsync/W/paypal_reply/paypal_functions \ +&& . /g/public_html/imapsync/W/paypal_reply/paypal_functions DATE_1=`date` diff --git a/imapsync b/imapsync index dcaa954..73a7ef6 100755 --- a/imapsync +++ b/imapsync @@ -20,11 +20,11 @@ Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 44 different IMAP server softwares supported with success. -$Revision: 1.518 $ +$Revision: 1.525 $ =head1 SYNOPSIS -To synchronise imap account "foo" on "imap.truc.org" +To synchronize imap account "foo" on "imap.truc.org" to imap account "bar" on "imap.trac.org" with foo password "secret1" and bar password "secret2": @@ -143,16 +143,18 @@ time and restart it later, imapsync works well with bad connections. You can decide to delete the messages from the source mailbox -after a successful transfer (it is a good feature when migrating). +after a successful transfer, it can be a good feature when migrating +live mailboxes since messages will be only one side. In that case, use the --delete option. Option --delete implies also option --expunge so all messages marked deleted on host1 will be really deleted. (you can use --noexpunge to avoid this but I don't see any -real world scenario for the combinaison --delete --noexpunge). +good real world scenario for the combinaison --delete --noexpunge). -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 (--delete2 -may help) +You can also just synchronize a mailbox B from another mailbox A +in case you just want to keep a "live" copy of A in B. +In that case --delete2 can be used, it deletes messages in host2 +folder B that are not in host1 folder A. imapsync is not adequate for maintaining two active imap accounts in synchronization where the user plays independently on both sides. @@ -236,10 +238,10 @@ in a Bourne shell: =head1 LICENSE -imapsync is free, open source but not always gratis software cover by -the No Limit Public License (NLPL). -See COPYING file included in the distribution or the web site -http://imapsync.lamiral.info/COPYING +imapsync is free, open, public but not always gratis software +cover by the NOLIMIT Public License. +See the LICENSE file included in the distribution or just read this: +No limit to do anything with this work and this license. =head1 MAILING-LIST @@ -405,7 +407,7 @@ Success stories reported with the following 48 imap servers - Rockliffe Mailsite 5.3.11, 4.5.6 - Samsung Contact IMAP server 8.5.0 - Scalix v10.1, 10.0.1.3, 11.0.0.431, 11.4.6 - - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1]. + - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1], SmarterMail Professional 10.2 [host1]. - Softalk Workgroup Mail 7.6.4 [host1]. - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) - Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 @@ -443,15 +445,9 @@ Pay special attention to options --delete --delete2 --delete2folders ---expunge ---expunge1 ---expunge2 ---uidexpunge2 --maxage --minage --maxsize ---useheader ---fast --useuid --usecache @@ -488,7 +484,7 @@ Welcome in shell programming ! =head1 Hacking -Feel free to hack imapsync as the NLPL Licence permits it. +Feel free to hack imapsync as the NOLIMIT license permits it. =head1 Links @@ -517,7 +513,7 @@ Entries for imapsync: Feedback (good or bad) will often be welcome. -$Id: imapsync,v 1.518 2012/12/24 00:27:34 gilles Exp gilles $ +$Id: imapsync,v 1.525 2013/02/05 12:52:10 gilles Exp gilles $ =cut @@ -648,7 +644,7 @@ my( # global variables initialisation -$rcs = '$Id: imapsync,v 1.518 2012/12/24 00:27:34 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.525 2013/02/05 12:52:10 gilles Exp gilles $ '; $total_bytes_transferred = 0; $total_bytes_skipped = 0; @@ -746,7 +742,7 @@ $usecache = 1 if ( $useuid and ( ! defined( $usecache ) ) ) ; $cacheaftercopy = 1 if ( $usecache and ( ! defined( $cacheaftercopy ) ) ) ; $checkselectable = defined( $checkselectable ) ? $checkselectable : 1 ; -$checkmessageexists = defined( $checkmessageexists ) ? $checkmessageexists : 1 ; +$checkmessageexists = defined( $checkmessageexists ) ? $checkmessageexists : 0 ; $expungeaftereach = defined( $expungeaftereach ) ? $expungeaftereach : 1 ; $abletosearch = defined( $abletosearch ) ? $abletosearch : 1 ; $checkmessageexists = 0 if ( not $abletosearch ) ; @@ -886,9 +882,11 @@ $authuser2 ||= $user2; print "Info: will try to use $authmech1 authentication on host1\n"; print "Info: will try to use $authmech2 authentication on host2\n"; -$syncacls = (defined($syncacls)) ? $syncacls : 0; -$foldersizes = (defined($foldersizes)) ? $foldersizes : 1; -$foldersizesatend = (defined($foldersizesatend)) ? $foldersizesatend : 1; +$syncacls = (defined($syncacls)) ? $syncacls : 0 ; +$foldersizes = (defined($foldersizes)) ? $foldersizes : 1 ; +$foldersizesatend = (defined($foldersizesatend)) ? $foldersizesatend : $foldersizes ; + + $fastio1 = (defined($fastio1)) ? $fastio1 : 0; $fastio2 = (defined($fastio2)) ? $fastio2 : 0; @@ -968,7 +966,9 @@ exit_clean(0) if ($justlogin); my ( @h1_folders_all, %h1_folders_all, @h1_folders_wanted, %requested_folder, %h1_subscribed_folder, %h2_subscribed_folder, -@h2_folders_all, %h2_folders_all, @h2_folders_from_1_wanted, %h2_folders_from_1_wanted, +@h2_folders_all, %h2_folders_all, +@h2_folders_from_1_wanted, %h2_folders_from_1_wanted, +%h2_folders_from_1_several, @h2_folders_from_1_all, %h2_folders_from_1_all, ); @@ -1073,11 +1073,14 @@ print "Host2 separator and prefix: [$h2_sep][$h2_prefix]\n"; #exit ; -foreach my $h1_fold (@h1_folders_wanted) { - my $h2_fold; - $h2_fold = imap2_folder_name($h1_fold); - $h2_folders_from_1_wanted{$h2_fold}++; -} +foreach my $h1_fold ( @h1_folders_wanted ) { + my $h2_fold ; + $h2_fold = imap2_folder_name( $h1_fold ) ; + $h2_folders_from_1_wanted{ $h2_fold }++ ; + if ( 1 < $h2_folders_from_1_wanted{ $h2_fold } ) { + $h2_folders_from_1_several{ $h2_fold }++ ; + } +} @h2_folders_from_1_wanted = sort keys(%h2_folders_from_1_wanted); foreach my $h1_fold (@h1_folders_all) { @@ -1120,7 +1123,11 @@ print "++++ Looping on each folder\n"; my $begin_transfer_time = time ; -FOLDER: foreach my $h1_fold (@h1_folders_wanted) { + +my %uid_candidate_for_deletion ; +my %uid_candidate_no_deletion ; + +FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { last FOLDER if $imap1->IsUnconnected(); last FOLDER if $imap2->IsUnconnected(); @@ -1318,7 +1325,7 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { my $h2_msgs_duplicate_nb = scalar( @h2_msgs_duplicate ) ; $h2{ $h2_fold }{ 'duplicates_nb' } = $h2_msgs_duplicate_nb ; - print "Host2 selected: $h2_msgs_nb, duplicates: $h2_msgs_duplicate_nb\n" + print "Host2 folder $h2_fold selected: $h2_msgs_nb messages, duplicates: $h2_msgs_duplicate_nb\n" if ( $debug or $delete2duplicates or $h2_msgs_duplicate_nb ) ; $debug and print "Host2 whole time parsing headers took ", timenext(), " s\n"; @@ -1348,7 +1355,7 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { #next FOLDER ; - if( $delete2duplicates ) { + if( $delete2duplicates and not exists( $h2_folders_from_1_several{ $h2_fold } ) ) { my @h2_expunge ; foreach my $h2_msg ( @h2_msgs_duplicate ) { @@ -1370,7 +1377,8 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { } } - if($delete2) { + if( $delete2 and not exists( $h2_folders_from_1_several{ $h2_fold } ) ) { + # No host1 folders f1a f1b ... going all to same f2 (via --regextrans2) my @h2_expunge; foreach my $m_id (@h2_hash_keys_sorted_by_uid) { #print "$m_id "; @@ -1406,6 +1414,66 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { } } + if( $delete2 and exists( $h2_folders_from_1_several{ $h2_fold } ) ) { + print "Host2 folder $h2_fold $h2_folders_from_1_several{ $h2_fold } folders left to sync there\n" ; + my @h2_expunge; + foreach my $m_id ( @h2_hash_keys_sorted_by_uid ) { + my $h2_msg = $h2_hash{ $m_id }{ 'm' } ; + unless ( exists( $h1_hash{ $m_id } ) ) { + my $h2_flags = $h2_hash{ $m_id }{ 'F' } || "" ; + my $isdel = $h2_flags =~ /\B\\Deleted\b/ ? 1 : 0 ; + unless ( $isdel ) { + $debug and print "msg $h2_fold/$h2_msg candidate for deletion on host2 [$m_id]\n" ; + $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ; + } + }else{ + $debug and print "msg $h2_fold/$h2_msg will cancel deletion on host2 [$m_id]\n" ; + $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ; + } + } + foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) { + print "msg $h2_fold/$h2_msg candidate for deletion [not in cache] on host2\n"; + $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ; + } + + foreach my $h2_msg ( @h2_msgs_in_cache ) { + print "msg $h2_fold/$h2_msg will cancel deletion [in cache] on host2\n"; + $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ; + } + + + if ( 0 == $h2_folders_from_1_several{ $h2_fold } ) { + # last host1 folder going to $h2_fold + print "Last host1 folder going to $h2_fold\n" ; + foreach my $h2_msg ( keys %{ $uid_candidate_for_deletion{ $h2_fold } } ) { + $debug and print "msg $h2_fold/$h2_msg candidate for deletion on host2\n" ; + if ( exists( $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg } ) ) { + $debug and print "msg $h2_fold/$h2_msg canceled deletion on host2\n" ; + }else{ + print "msg $h2_fold/$h2_msg marked \\Deleted on host2 $dry_message\n"; + push( @h2_expunge, $h2_msg ) if $uidexpunge2 ; + unless ( $dry ) { + $imap2->delete_message( $h2_msg ) ; + $h2_nb_msg_deleted += 1 ; + } + } + } + } + + my $cnt = scalar @h2_expunge ; + if( @h2_expunge ) { + print "uidexpunge $cnt message(s) $dry_message\n" ; + $imap2->uidexpunge( \@h2_expunge ) if ! $dry ; + } + if ( $expunge2 ) { + print "Expunging host2 folder $h2_fold $dry_message\n" ; + $imap2->expunge( ) if ! $dry ; + } + + $h2_folders_from_1_several{ $h2_fold }-- ; + } + + my $h2_uidnext = $imap2->uidnext( $h2_fold ) ; $debug and print "Host2 uidnext: $h2_uidnext\n" ; $h2_uidguess = $h2_uidnext ; @@ -1419,7 +1487,11 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { # copy last FOLDER if $imap1->IsUnconnected(); last FOLDER if $imap2->IsUnconnected(); - copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ; + my $h2_msg = copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ; + if( $delete2 and exists( $h2_folders_from_1_several{ $h2_fold } ) and $h2_msg ) { + print "msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n" ; + $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ; + } last FOLDER if total_bytes_max_reached( ) ; next MESS; } @@ -1478,7 +1550,11 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { $debug and print "Copy by uid $h1_fold/$h1_msg\n" ; last FOLDER if $imap1->IsUnconnected(); last FOLDER if $imap2->IsUnconnected(); - copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ; + my $h2_msg = copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ; + if( $delete2 and exists( $h2_folders_from_1_several{ $h2_fold } ) and $h2_msg ) { + print "msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n" ; + $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ; + } last FOLDER if total_bytes_max_reached( ) ; } @@ -1990,8 +2066,8 @@ sub banner_imapsync { my @argv_copy = @_; my $banner_imapsync = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.518 $ ', - '$Date: 2012/12/24 00:27:34 $ ', + '$Revision: 1.525 $ ', + '$Date: 2013/02/05 12:52:10 $ ', "\n",localhost_info(), "\n", "Command line used:\n", "$0 ", command_line_nopassword(@argv_copy), "\n", @@ -2975,12 +3051,14 @@ sub copy_message { } } #print "PRESS ENTER" and my $a = <> ; + return( $new_id ) ; } } else{ $nb_msg_skipped_dry_mode += 1; $h1_nb_msg_processed +=1 ; } + return( ) ; } sub eta { @@ -3656,14 +3734,7 @@ sub stats { } sub thank_author { - return("Homepage: http://imapsync.lamiral.info/\n"); - - # used to be - return(join("", "Happy with this free, open and gratis NLPL software?\n", - "Encourage the author (Gilles LAMIRAL) by giving him a book\n", - "or just money via paypal:\n", - "http://imapsync.lamiral.info/\n")); } sub get_options { @@ -3986,7 +4057,7 @@ sub check_last_release { } sub imapsync_version { - my $rcs = '$Id: imapsync,v 1.518 2012/12/24 00:27:34 gilles Exp gilles $ '; + my $rcs = '$Id: imapsync,v 1.525 2013/02/05 12:52:10 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; my $VERSION = ($1) ? $1: "UNKNOWN"; return($VERSION); @@ -4100,69 +4171,84 @@ usage: $0 [options] Several options are mandatory. ---host1 : "from" imap server. Mandatory. ---port1 : port to connect on host1. Default is 143. ---user1 : user to login on host1. Mandatory. ---domain1 : domain on host1 (NTLM authentication). ---authuser1 : user to auth with on host1 (admin user). +--dry : Makes imapsync doing nothing, just print what would + be done without --dry. + +--host1 : Source or "from" imap server. Mandatory. +--port1 : Port to connect on host1. Default is 143. +--user1 : User to login on host1. Mandatory. +--showpasswords : Shows passwords on output instead of "MASKED". + Useful to restart a complete run by just reading a log. +--password1 : Password for the user1. +--host2 : "destination" imap server. Mandatory. +--port2 : Port to connect on host2. Default is 143. +--user2 : User to login on host2. Mandatory. +--password2 : Password for the user2. + +--passfile1 : Password file for the user1. It must contain the + password on the first line. This option avoids to show + the password on the command line like --password1 does. +--passfile2 : Password file for the user2. Contains the password. +--domain1 : Domain on host1 (NTLM authentication). +--domain2 : Domain on host2 (NTLM authentication). +--authuser1 : User to auth with on host1 (admin user). Avoid using --authmech1 SOMETHING with --authuser1. +--authuser2 : User to auth with on host2 (admin user). --proxyauth1 : Use proxyauth on host1. Requires --authuser1. Required by Sun/iPlanet/Netscape IMAP servers to - be able to use an administrative user ---password1 : password for the user1. Dangerous, use --passfile1 ---showpasswords : shows passwords on output instead of "MASKED". - Useful to restart a complete run by just reading a log. ---passfile1 : password file for the user1. Contains the password. ---host2 : "destination" imap server. Mandatory. ---port2 : port to connect on host2. Default is 143. ---user2 : user to login on host2. Mandatory. ---domain2 : domain on host2 (NTLM authentication). ---authuser2 : user to auth with on host2 (admin user). + be able to use an administrative user. --proxyauth2 : Use proxyauth on host2. Requires --authuser2. Required by Sun/iPlanet/Netscape IMAP servers to be able to use an administrative user ---password2 : password for the user2. Dangerous, use --passfile2 ---passfile2 : password file for the user2. Contains the password. + --authmd51 : Use MD5 authentification for host1. --authmd52 : Use MD5 authentification for host2. ---authmech1 : auth mechanism to use with host1: +--authmech1 : Auth mechanism to use with host1: PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. ---authmech2 : auth mechanism to use with host2. See --authmech1 ---ssl1 : use an SSL connection on host1. ---ssl2 : use an SSL connection on host2. ---tls1 : use an TLS connection on host1. ---tls2 : use an TLS connection on host2. ---folder : sync this folder. +--authmech2 : Auth mechanism to use with host2. See --authmech1 +--ssl1 : Use an SSL connection on host1. +--ssl2 : Use an SSL connection on host2. +--tls1 : Use an TLS connection on host1. +--tls2 : Use an TLS connection on host2. + +--folder : Sync this folder. --folder : and this one, etc. ---folderrec : sync this folder recursively. +--folderrec : Sync this folder recursively. --folderrec : and this one, etc. ---include : sync folders matching this regular expression +--include : Sync folders matching this regular expression --include : or this one, etc. in case both --include --exclude options are use, include is done before. ---exclude : skips folders matching this regular expression +--exclude : Skips folders matching this regular expression Several folders to avoid: --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. --exclude : or this one, etc. ---tmpdir : where to store temporary files and subdirectories. - Will be created if it doesn't exist. - Default is system specific and should be ok. ---pidfile : the file where imapsync pid is written. ---pidfilelocking : Abort if pidfile already exists. Usefull to avoid - concurrent transfers on the same mailbox. ---prefix1 : remove prefix to all destination folders - (usually INBOX. for cyrus imap servers) - you can use --prefix1 if your source imap server - does not have NAMESPACE capability. ---prefix2 : 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 : Apply the whole regex to each destination folders. --regextrans2 : 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 + Then, when happy, remove --dry, remove --justfolders. + Have in mind that --regextrans2 is applied after prefix + and separator inversion. + +--tmpdir : Where to store temporary files and subdirectories. + Will be created if it doesn't exist. + Default is system specific, Unix is /tmp but + it's often small and deleted at reboot. + --tmpdir /var/tmp should be better. +--pidfile : The file where imapsync pid is written. +--pidfilelocking : Abort if pidfile already exists. Usefull to avoid + concurrent transfers on the same mailbox. + +--prefix1 : Remove prefix to all destination folders + (usually INBOX. or INBOX/ or an empty string "") + you have to use --prefix1 if host1 imap server + does not have NAMESPACE capability, all other + cases are bad. +--prefix2 : Add prefix to all host2 folders. See --prefix1 +--sep1 : Host1 separator in case NAMESPACE is not supported. +--sep2 : Host2 separator in case NAMESPACE is not supported. + --regexmess : Apply the whole regex to each message before transfer. Example: 's/\\000/ /g' # to replace null by space. --regexmess : and this one. @@ -4170,23 +4256,22 @@ Several options are mandatory. --regexflag : Apply the whole regex to each flags list. Example: 's/\"Junk"//g' # to remove "Junk" flag. --regexflag : and this one, etc. ---sep1 : host1 separator in case namespace is not supported. ---sep2 : idem for host2. ---delete : Deletes messages on host1 server after - a successful transfer. Useful in case you - want to migrate from one server to another one. - With imapsync, --delete tags messages as deleted and - they are really deleted unless --noexpunge is used. ---delete2 : delete messages in host2 that are not in + +--delete : Deletes messages on host1 server after a successful + transfer. Option --delete has the following behavior: + it marks messages as deleted with the IMAP flag + \\Deleted, then messages are really deleted with an + EXPUNGE IMAP command. +--delete2 : Delete messages in host2 that are not in host1 server. Useful for backup or pre-sync. ---delete2duplicates : delete messages in host2 that are duplicates. +--delete2duplicates : Delete messages in host2 that are duplicates. Works only without --useuid since duplicates are detected with header part of each message. --delete2folders : Delete folders in host2 that are not in host1 server. For safety, first try it like this (it is safe): --delete2folders --dry --justfolders --nofoldersizes ---delete2foldersonly : delete only folders matching regex. ---delete2foldersbutnot : do not delete folders matching regex. +--delete2foldersonly : Deleted only folders matching regex. +--delete2foldersbutnot : Do not delete folders matching regex. Example: --delete2foldersbutnot "/Tasks|Contacts|Foo/" --noexpunge : Do not expunge messages on host1. Expunge really deletes messages marked deleted. @@ -4198,17 +4283,19 @@ Several options are mandatory. --expunge2 : Expunge messages on host2 after messages transfer. --uidexpunge2 : uidexpunge messages on the host2 account that are not on the host1 account, requires --delete2 ---syncinternaldates : sets the internal dates on host2 same as host1. + +--syncinternaldates : Sets the internal dates on host2 same as host1. Turned on by default. Internal date is the date a message arrived on a host (mtime). ---idatefromheader : sets the internal dates on host2 same as the +--idatefromheader : Sets the internal dates on host2 same as the "Date:" headers. ---maxsize : skip messages larger (or equal) than bytes ---minsize : skip messages smaller (or equal) than bytes ---maxage : skip messages older than days. + +--maxsize : Skip messages larger (or equal) than bytes +--minsize : Skip messages smaller (or equal) than bytes +--maxage : Skip messages older than days. final stats (skipped) don't count older messages see also --minage ---minage : skip messages newer than days. +--minage : Skip messages newer than days. final stats (skipped) don't count newer messages You can do (+ are the messages selected): past|----maxage+++++++++++++++>now @@ -4216,47 +4303,55 @@ Several options are mandatory. past|----maxage+++++minage---->now (intersection) past|++++minage-----maxage++++>now (union) --search : Select messages returned by this IMAP SEARCH command. + --exitwhenover : Stop syncing when total bytes transferred reached. Gmail per day allows 2500000000 down 500000000 upload. + --useheader : Use this header to compare messages on both sides. Ex: Message-ID or Subject or Date. --useheader and this one, etc. ---dry : do nothing, just print what would be done. ---subscribed : transfers subscribed folders. ---subscribe : subscribe to the folders transferred on the + +--subscribed : Transfers subscribed folders. +--subscribe : Subscribe to the folders transferred on the host2 that are subscribed on host1. On by default. ---subscribe_all : subscribe to the folders transferred on the +--subscribe_all : Subscribe to the folders transferred on the host2 even if they are not subscribed on host1. + --nofoldersizes : Do not calculate the size of each folder in bytes and message counts. Default is to calculate them. --nofoldersizesatend : Do not calculate the size of each folder in bytes and message counts at the end. Default is on. ---justfoldersizes : exit after printed the folder sizes. ---syncacls : synchronises acls (Access Control Lists). ---nosyncacls : does not synchronise acls. This is the default. +--justfoldersizes : Exit after having printed the folder sizes. + +--syncacls : Synchronises acls (Access Control Lists). +--nosyncacls : Does not synchronize acls. This is the default. + Acls in IMAP are not standardized, be careful. + --usecache : Use cache to speedup. --nousecache : Do not use cache. Caveat: --useuid --nousecache creates duplicates on multiple runs. ---useuid : Use uid instead of header as a criterium to sync. - --usecache is then implied unless --nousecache is - used. ---debug : debug mode. ---debugcontent : debug content of the messages transfered. ---debugflags : debug flags. ---debugimap1 : imap debug mode for host1. imap debug is very verbose. ---debugimap2 : imap debug mode for host2. ---debugimap : imap debug mode for host1 and host2. ---version : print software version. ---noreleasecheck : do not check for new imapsync release (a http request). ---justconnect : just connect to both servers and print useful +--useuid : Use uid instead of header as a criterium to recognize + messages. Option --usecache is then implied unless + --nousecache is used. + +--debug : Debug mode. +--debugcontent : Debug content of the messages transfered. +--debugflags : Debug flags. +--debugimap1 : IMAP debug mode for host1. imap debug is very verbose. +--debugimap2 : IMAP debug mode for host2. +--debugimap : IMAP debug mode for host1 and host2. + +--version : Print software version. +--noreleasecheck : Do not check for new imapsync release (a http request). +--justconnect : Just connect to both servers and print useful information. Need only --host1 and --host2 options. ---justlogin : just login to both host1 and host2 with users +--justlogin : Just login to both host1 and host2 with users credentials, then exit. ---justfolders : just do things about folders (ignore messages). ---fast : be faster, equivalent to --nofoldersizes +--justfolders : Do only things about folders (ignore messages). + --help : print this help. -Example: to synchronise imap account "foo" on "imap.truc.org" +Example: to synchronize imap account "foo" on "imap.truc.org" to imap account "bar" on "imap.trac.org" with foo password "secret1" and bar password "secret2" diff --git a/index.shtml b/index.shtml index 7b9c368..8785034 100644 --- a/index.shtml +++ b/index.shtml @@ -5,7 +5,7 @@ Imapsync: an IMAP migration tool ( release <!--#exec cmd="cat ./VERSION"--> ) - + @@ -31,7 +31,7 @@ @@ -43,50 +43,56 @@

What is imapsync?

-

imapsync software is a command line tool allowing incremental and +

imapsync software is a command line tool that allows incremental and recursive IMAP transfers from one mailbox to another, both anywhere on the internet -or in your local network. "Incremental" means you can stop the transfer at any time -and restart it later efficiently. "Recursive" means all folders hierarchy can be copied. -"Command line" means it's not a graphical tool, imapsync on Windows has to be run in a DOS box +or in your local network. + +"Incremental" means you can stop the transfer at any time +and restart it later efficiently. + +"Recursive" means the complete folders hierarchy can be copied. + +"Command line" means it's not a graphical tool, on Windows you have to run imapsync in a DOS box (cmd.exe) or from a batch file.

-

imapsync is useful for imap account migration or imap account backup. +

+The purpose of imapsync is to migrate imap accounts or to backup imap accounts.

-

imapsync is not adequate for maintaining two active imap accounts -in synchronization where the user plays independently on both sides. +

+imapsync is not suitable for maintaining a synchronization between two active imap accounts while the user +is working on both sides. + Use offlineimap (written by John Goerzen) or mbsync (written by Michael R. Elkins) -for 2 ways synchronizations. +for bidirectionnal (2 ways) synchronizations.

Alternatives to imapsync are listed in the Similar softwares section.

-

Some numbers for 2011 and 2012

+

Facts and figures for 2011 and 2012

    -
  • Number of imapsync users per month: between 3000 and 4000 users -(34000 users a year)
    • +
  • 3000 to 4000 users (34000 users a year)
    • -
  • Number of imapsync transfers between -5 and 25 millions mailboxes transfers per month, +
  • 5 to 25 millions mailboxes transfers per month, total is 93 millions for 2011, 90 millions for 2012.
    • -
  • Percentage between operating systems users running imapsync: +
  • Operating systems run by imapsync users:
      -
    • Linux: 67 %
      • -
    • Win32: 16 %
      • -
    • Darwin: 9 %
      • -
    • FreeBSD: 7 %
      • -
    • Solaris: 0.3 %
      • -
    • OpenBSD: 0.03 %
      • -
    • Other: 0.67 %
      • +
    • Linux: 67%
      • +
    • Win32: 16%
      • +
    • Darwin: 9%
      • +
    • FreeBSD: 7%
      • +
    • Solaris: 0.3%
      • +
    • OpenBSD: 0.03%
      • +
    • Other: 0.67%
    • -
  • Biggest user usage: about 21 millions of IMAP mailbox transfers (in one month)
    • +
  • Highest use rate: about 21 millions of IMAP mailbox transfers (in a single month)
@@ -122,7 +128,7 @@ total is 93 millions for 2011, 90 millions for 2012.
  • 1.518
  • Bug fix: When identtifying with header, change tabulations to spaces -(Gmail bug on with "Received:" on multilines).
    • +(Gmail bug with "Received:" header on multilines).
  • Bug fix: Bugfix. Automatic --nocheckmessageexists when --noabletosearch is set.
    • @@ -254,18 +260,19 @@ by ignoring PERMANENTFLAGS (Exchange tests)

    Simple transfer on Windows

    -See imapsync_example.bat -batch file example that you can easily adapt with your parameters. +Batch file example imapsync_example.bat +that you can easily adapt with your parameters.

    Massive transfers (many mailboxes)

    -In order to migrate many mailboxes a good way is to use a loop over a csv -file containing only the data credentials. -A example of this file is file.txt, -it can be used by the two following command scripts.
    +In order to migrate many mailboxes, you should use a loop over a csv +file containing only the data credentials. + +An example of this file is file.txt, +it can be used with the two following command scripts.
    On Windows, see sync_loop_windows.bat batch example.
    @@ -301,13 +308,14 @@ any Unix, Linux, Windows, or Mac OS operating system.

    -+ Two years of imapsync updates without extra payment.
    ++ Lifetime of imapsync updates without extra payment.
    + 30 days money-back guarantee! (any reason qualifies)
    ++ Standalone imapsync.exe.

    Payment by Paypal account and credit card accepted.
    -Price 42 EUR is equal to around 50 USD, +Price 42 EUR is equal to around 55 USD, no problem to pay in USD (or any currency) via paypal:

    @@ -334,7 +342,7 @@ name="submit" alt="PayPal - The safer, easier way to pay online!"/>

    -

    You will receive a download link just after the payment.
    +

    You will receive a download link just after the payment from gilles.lamiral@laposte.net (can fall in Spam folder sometimes).
    You will also receive a gpg signed invoice within a few days by email.
    Please give a delivery postal address where the invoice will be needed (your company for example), since reedit is not easy (and forbidden by law). @@ -350,13 +358,14 @@ buying the latest win32 standalone imapsync.exe for 42 EUR

    -+ Two years of imapsync updates without extra payment.
    ++ Lifetime of imapsync updates without extra payment.
    + 30 days money-back guarantee! (any reason qualifies)
    ++ Source code of imapsync.

    Payment by Paypal account and credit card accepted.
    -Price 42 EUR is equal to around 50 USD, +Price 42 EUR is equal to around 55 USD, no problem to pay in USD (or any currency) via paypal:

    @@ -382,7 +391,7 @@ name="submit" alt="PayPal - The safer, easier way to pay online!"/>

    -

    You will receive a download link just after the payment.
    +

    You will receive a download link just after the payment, from gilles.lamiral@laposte.net (can fall in Spam folder sometimes).
    You will also receive a gpg signed invoice within a few days by email.
    Please give a delivery postal address where the invoice will be needed (your company for example), since reedit is not easy (and forbidden by law). @@ -406,7 +415,7 @@ done by the imapsync designer/developper.

    Payment by Paypal account and credit card accepted.
    -90 EUR is equal to around 110 USD, +90 EUR is equal to around 120 USD, no problem to pay in USD (or any currency) with paypal:

    @@ -435,7 +444,8 @@ It's 2 letters followed by 11 digits, for example mine is FR74429303332.

    -

    You will also receive a gpg signed invoice within a few days by email.
    +

    You will receive instructions to contact me just after the payment, from gilles.lamiral@laposte.net (can fall in Spam folder sometimes).
    +You will also receive a gpg signed invoice within a few days by email.
    Please give a delivery postal address where the invoice will be needed (your company for example), since reedit is not easy (and forbidden by law).

    @@ -465,13 +475,13 @@ lists what may be coded or done in the future. CREDITS file.

    -

    What you can do with imapsync is listed in COPYING. +

    What you're allowed to do with imapsync is listed in the LICENSE file (well worth it).

    The imapsync mailing list

    - The public mailing-list may be the best way to get free support.
    + The public mailing-list may be the best way to get free and gratis support (not as quick as the professional support).
    You can write to the mailing-list even if you're not subscribed to it.
    In that case you will receive a confirmation message each time you post (to avoid spam).

    @@ -527,6 +537,7 @@ Don't hesitate to have a try, I will help you and make efforts to switch them to
    • DBMail 0.9, 2.0.7 (GPL). But most other DBMail releases are supported (see below)
      • +
    • Hotmail since hotmail.com does not provide IMAP access
    • Imail 7.04 (maybe).
    • MailEnable 1.54 (Proprietary) but MailEnable 4.23 is supported.
    • (2011) MDaemon 12.0.3 as host2 @@ -607,7 +618,7 @@ Don't hesitate to have a try, I will help you and make efforts to switch them to
    • Rockliffe Mailsite 5.3.11, 4.5.6 (http://www.mailsite.com/)
    • Samsung Contact IMAP server 8.5.0
    • Scalix v10.1, 10.0.1.3, 11.0.0.431, 11.4.6 (http://www.scalix.com/)
      • -
    • SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1]. (http://www.smartertools.com/)
      • +
    • SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1], SmarterMail Professional 10.2 [host1]. (http://www.smartertools.com/)
    • Softalk Workgroup Mail 7.6.4 [host1] (http://www.softalkltd.com/products/download_wm_v7.asp).
    • SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) (http://www.oracle.com/)
    • Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 (http://www.oracle.com/)
      • @@ -685,7 +696,7 @@ alt="Viewable With Any Browser" /> This document last modified on -($Id: index.shtml,v 1.141 2012/12/24 01:03:07 gilles Exp gilles $) +($Id: index.shtml,v 1.148 2013/02/08 06:28:18 gilles Exp gilles $)

      diff --git a/tests.sh b/tests.sh index 089f2bd..d986e15 100644 --- a/tests.sh +++ b/tests.sh @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: tests.sh,v 1.209 2012/12/24 02:24:09 gilles Exp gilles $ +# $Id: tests.sh,v 1.212 2013/01/28 02:52:34 gilles Exp gilles $ # Example 1: # CMD_PERL='perl -I./Mail-IMAPClient-3.32/lib' sh -x tests.sh @@ -309,6 +309,15 @@ ll_folder() { --folder INBOX.yop --folder INBOX.Trash } +ll_star() { + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --folder 'INBOX.backstar\*' --dry --justfolders --debugimap1 --regextrans2 's#\\|\*#_#g' +} + ll_folder_noexist() { @@ -1103,15 +1112,15 @@ ll_include() --include '^INBOX.yop' } -ll_exclude() -{ - $CMD_PERL ./imapsync \ - --host1 $HOST1 --user1 tata \ - --passfile1 ../../var/pass/secret.tata \ - --host2 $HOST2 --user2 titi \ - --passfile2 ../../var/pass/secret.titi \ - --exclude '^INBOX.yop' --justfolders --nofoldersizes -} +ll_exclude() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --exclude '^(?i)INBOX.YOP' --justfolders --nofoldersizes +} ll_exclude_2() { @@ -1249,6 +1258,57 @@ ll_regextrans2_archive_per_month() } + +ll_regextrans2_ALLIN() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --nofoldersizes \ + --regextrans2 's/.*/INBOX.ALLIN/' \ + --folderrec 'INBOX.yop' --delete2 +} + +ll_regextrans2_ALLIN_usecache() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --regextrans2 's/.*/INBOX.ALLIN/' \ + --folderrec 'INBOX.yop' --delete2 --usecache --nodelete2duplicates +} + +ll_regextrans2_ALLIN_fake() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --regextrans2 's/.*/INBOX.ALLIN/' \ + --foldersizes \ + --folderrec 'INBOX.yop' --delete2 +} + + +ll_regextrans2_ALLIN_useuid() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --foldersizes \ + --regextrans2 's/.*/INBOX.ALLIN/' \ + --folderrec 'INBOX.yop' --delete2 --useuid +} + + + ll_sep2() { $CMD_PERL ./imapsync \