From 3f8607bd963d427a0c025cd15b5102c271b03465 Mon Sep 17 00:00:00 2001 From: Nick Bebout Date: Sat, 12 Mar 2011 02:45:02 +0000 Subject: [PATCH] 1.366 --- CONCEPTION | 26 + CREDITS | 51 +- ChangeLog | 81 +- FAQ | 23 +- INSTALL | 17 +- Makefile | 31 +- README | 19 +- TIME | 17 + TODO | 26 +- VERSION | 2 +- VERSION_EXE | 2 +- build_exe.bat | 4 +- freshmeat_submition.inp | 11 +- freshmeat_submition.json | 28 +- imapsync | 2352 +++++++++-------- index.shtml | 125 +- learn/imapclient3xx_skeleton_test | 2 +- learn/io_socket_get | 0 learn/memory_consumption | 57 + learn/message_string_raw | 110 + learn/message_string_raw_pb | 209 ++ learn/mi2 | 4 + learn/mi3 | 4 + logo_imapsync.png | Bin 0 -> 38832 bytes logo_imapsync_2.svg | 149 ++ logo_imapsync_s.png | Bin 0 -> 3957 bytes memo | 19 + patches/imapsync_minsize | 4079 +++++++++++++++++++++++++++++ test.bat | 15 +- test_exe.bat | 5 +- test_exe_2.bat | 2 + tests.sh | 394 +-- 32 files changed, 6408 insertions(+), 1456 deletions(-) create mode 100644 CONCEPTION mode change 100644 => 100755 learn/io_socket_get create mode 100755 learn/memory_consumption create mode 100755 learn/message_string_raw create mode 100755 learn/message_string_raw_pb create mode 100755 learn/mi2 create mode 100755 learn/mi3 create mode 100644 logo_imapsync.png create mode 100644 logo_imapsync_2.svg create mode 100644 logo_imapsync_s.png create mode 100644 patches/imapsync_minsize create mode 100644 test_exe_2.bat diff --git a/CONCEPTION b/CONCEPTION new file mode 100644 index 0000000..a786035 --- /dev/null +++ b/CONCEPTION @@ -0,0 +1,26 @@ + +===== Synopsis ===== + +$mailbox_1 = Mail::imapsync::mailbox->new(); +$mailbox_2 = Mail::imapsync::mailbox->new(); + + +$mailbox_1->host('imap1.lala.org'); +$mailbox_1->user('toto1'); +... + +$mailbox_2->host('imap2.lala.org'); +$mailbox_2->user('toto2'); +... + + +$transfer = Mail::imapsync::transfer->new(); +$transfer->sync($mailbox_1, $mailbox_2); + + +- an object for mailbox +- an object for a transfer +- ?an object for a folder? +- ?an object for a message? + + diff --git a/CREDITS b/CREDITS index 881a2f5..1acafef 100644 --- a/CREDITS +++ b/CREDITS @@ -1,7 +1,8 @@ #!/bin/cat -# $Id: CREDITS,v 1.144 2010/09/06 01:08:41 gilles Exp gilles $ +# $Id: CREDITS,v 1.150 2010/10/24 23:54:09 gilles Exp gilles $ -If you want to make a donation to the author, Gilles LAMIRAL: +If you want to make a donation to the author, Gilles LAMIRAL, +use any of the following ways: a) you can use the imapsync wishlist : http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ @@ -14,12 +15,50 @@ b) If you can read french, please use the following wishlist : c) its paypal account : gilles.lamiral@laposte.net http://www.linux-france.org/prj/imapsync/paypal.html -Here are the persons who helped me to develop imapsync. -Feel free to tell me if a name is missing or if you want -to remove one. +d) If you prefer making your donation with +cash or cheque then my postal address is: + +Gilles LAMIRAL +4 La Billais +35580 Baulon +FRANCE + +Here are the persons who helped me to develop and maintain imapsync. +Feel free to tell me if a name is missing or if you want to remove one. I thank very much all of these people. +Roger Schmid +Contributed by giving money 100 USD + +Danny Schulz +Contributed by giving money 15 USD + +Christian Kowarzik +Contributed by giving money 90 USD +for --deletefolder2 option. + +Harald Petrovitsch +Contributed by giving the book +29.95 "Families and How to Survive Them" + +Tobias Fink +Contributed by giving money 5 Eur + +Yanick Cyr +Contributed by giving money 25 USD + +Trony Tigno +Contributed by giving money 5 USD + +Paul Garner +Contributed by giving money 5 USD + +Kevin Kretz +Contributed by giving the books +15.25 "Tres Cubano: A Complete Guide To Playing The Cuban Tres Guitar (Book & CD)" +24.00 "Creative Clowning" + Kirk Ismay Contributed by giving money 50 USD @@ -907,6 +946,8 @@ Eric Yung Total amount of book prices : c \ +29.95 +\ 11.20+\ 24.95+\ 13.57+\ diff --git a/ChangeLog b/ChangeLog index 53083e3..b2e7178 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,90 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.350 +head: 1.366 branch: locks: strict - gilles: 1.350 + gilles: 1.366 access list: symbolic names: keyword substitution: kv -total revisions: 350; selected revisions: 350 +total revisions: 366; selected revisions: 366 description: ---------------------------- -revision 1.350 locked by: gilles; +revision 1.366 locked by: gilles; +date: 2010/10/25 17:15:52; author: gilles; state: Exp; lines: +11 -12 +Permit host* to have change the case of headers. +---------------------------- +revision 1.365 +date: 2010/10/25 11:42:41; author: gilles; state: Exp; lines: +131 -157 +Fix tls getline pb (read too early) +Changes place of starttls() myconnect() and other functions. +---------------------------- +revision 1.364 +date: 2010/10/25 09:56:27; author: gilles; state: Exp; lines: +10 -15 +Fix STARTTLS capability detection bug. +---------------------------- +revision 1.363 +date: 2010/10/24 17:16:43; author: gilles; state: Exp; lines: +99 -48 +Added --delete2folders option. Deletes folders in host2 that are not in host1. +---------------------------- +revision 1.362 +date: 2010/10/22 19:23:34; author: gilles; state: Exp; lines: +24 -8 +Added imapsync basename to see how imapsync.exe is used. +---------------------------- +revision 1.361 +date: 2010/10/19 22:58:06; author: gilles; state: Exp; lines: +28 -8 +Added --nomodules_version option to avoid Roger libeay32.dll missing problem. +Added test to ckeck if the release number from lfo VERSION file is a number. +---------------------------- +revision 1.360 +date: 2010/10/19 22:08:23; author: gilles; state: Exp; lines: +8 -7 +Better documentation to subscribe to the imapsync list. +---------------------------- +revision 1.359 +date: 2010/10/08 01:17:29; author: gilles; state: Exp; lines: +15 -9 +Fixed "Your vendor has not defined POSIX macro SIGALRM" bug on win32. +---------------------------- +revision 1.358 +date: 2010/10/08 00:40:42; author: gilles; state: Exp; lines: +97 -18 +Add memory_consumption for win32. +---------------------------- +revision 1.357 +date: 2010/10/04 21:50:56; author: gilles; state: Exp; lines: +10 -10 +Suppressed ref passage in foldersizes() sub. +---------------------------- +revision 1.356 +date: 2010/10/04 02:44:00; author: gilles; state: Exp; lines: +1270 -1251 +Move all subroutines below main. +Changed "local $SIG{ALRM}" to "POSIX::sigaction(SIGALRM" +---------------------------- +revision 1.355 +date: 2010/09/21 01:50:34; author: gilles; state: Exp; lines: +39 -19 +Added tests_max() max() functions. +Added memory consumption. +Added memory consumption ratio to biggest message transfered. +---------------------------- +revision 1.354 +date: 2010/09/16 00:25:20; author: gilles; state: Exp; lines: +27 -15 +Added memory_consumption_ratio() +Added memory_consumption_of_pid() +Removed memory_consumption +---------------------------- +revision 1.353 +date: 2010/09/14 22:46:33; author: gilles; state: Exp; lines: +19 -9 +Added --minsize option. +---------------------------- +revision 1.352 +date: 2010/09/14 21:53:55; author: gilles; state: Exp; lines: +48 -12 +Added memory_consumption() +Added tests_memory_consumption() +Started to analyse memory consumption. +---------------------------- +revision 1.351 +date: 2010/09/06 16:28:17; author: gilles; state: Exp; lines: +9 -7 +Fixed PERL_VERSION format in imapsync_version_lfo() +---------------------------- +revision 1.350 date: 2010/09/06 01:05:09; author: gilles; state: Exp; lines: +33 -24 Added --noreleasecheck option. Added User-agent information (OS, perl version, Mail::IMAPClient version) diff --git a/FAQ b/FAQ index 748460b..a571592 100644 --- a/FAQ +++ b/FAQ @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ,v 1.73 2010/08/08 23:09:04 gilles Exp gilles $ +# $Id: FAQ,v 1.75 2010/10/19 23:31:10 gilles Exp gilles $ +------------------+ | FAQ for imapsync | @@ -595,6 +595,14 @@ Examples: 3) to substitute all characters dot "." by underscores "_" --regextrans2 's/\./_/g' +4) to change folder names like this: +[mail/Sent Items] -> [Sent] +[mail/Test] -> [INBOX/Test] +[mail/Test2] -> [INBOX/Test2] + + --regextrans2 's#^mail/Sent Items$#Sent#' \ + --regextrans2 's#^mail/#INBOX/#' + ======================================================================= Q. I would like to move emails from InBox to a sub-folder called, say "2005-InBox" based on the date (Like all emails received in the @@ -755,13 +763,16 @@ Q. Synchronising from Gmail to XXX R. Gmail needs SSL ./imapsync \ - --host1 imap.gmail.com --ssl1 \ + --host1 imap.gmail.com \ + --ssl1 \ + --authmech1 LOGIN \ --user1 gilles.lamiral@gmail.com \ - --passfile1 /var/tmp/secret.gilles_gmail \ + --password1 gmailsecret \ --host2 localhost - --user2 tata@est.belle \ - --passfile2 /var/tmp/secret.tata \ - --useheader="X-Gmail-Received" --skipsize + --user2 tata \ + --password2 tatasecret \ + --useheader="X-Gmail-Received" \ + --useheader 'Message-Id' If your destination imap server doesn't like "[Gmail]" name, just add option: diff --git a/INSTALL b/INSTALL index 412fca8..bd1b070 100644 --- a/INSTALL +++ b/INSTALL @@ -1,4 +1,4 @@ -# $Id: INSTALL,v 1.17 2010/07/16 22:01:57 gilles Exp gilles $ +# $Id: INSTALL,v 1.18 2010/10/25 09:32:49 gilles Exp gilles $ # # INSTALL file for imapsync # imapsync : IMAP sync or copy tool. @@ -84,9 +84,6 @@ Here is some individual module help: - IO:Socket:SSL.pm perl -mIO::Socket::SSL -e '' -- Date::Manip - perl -mDate::Manip -e '' - - File::Spec perl -mFile::Spec -e '' @@ -98,7 +95,7 @@ Here is some individual module help: Everything in one command: - perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mDate::Manip -mFile::Spec -mDigest::HMAC_MD5 -e '' + perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mFile::Spec -mDigest::HMAC_MD5 -e '' INSTALLING ---------- @@ -115,10 +112,14 @@ or copy the file imapsync where you want it to be. WINDOWS ------- +a) Simplest way: + +- Use imapsync.exe + +b) Hard way: + - Install Perl if it isn't already installed. - ActivePerl from ActiveState is a good candidate if - you understand nothing at free/open software - and want to run imapsync with success. + Strawberry Perl is a good candidate - Use PPM to install modules listed in the PREREQUISITES section. PPM is Perl Package Manager. diff --git a/Makefile b/Makefile index 8f657ab..932d96f 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.37 2010/08/24 01:46:36 gilles Exp gilles $ +# $Id: Makefile,v 1.42 2010/10/24 23:52:31 gilles Exp gilles $ .PHONY: help usage all @@ -15,6 +15,7 @@ usage: @echo "make all " @echo "make upload_index" @echo "make imapsync.exe" + @echo "make upload_imapsync_exe" DIST_NAME=imapsync-$(VERSION) @@ -137,6 +138,9 @@ upload_index: index.shtml ../../public_html/www.linux-france.org/html/prj/imapsync/ sh $(HOME)/memo/lfo-rsync + + + .dosify_bat: build_exe.bat test_exe.bat test.bat unix2dos build_exe.bat test.bat test_exe.bat touch .dosify_bat @@ -149,18 +153,39 @@ dosify_bat: .dosify_bat imapsync_cidone: .imapsync_cidone +copy_win32: + scp imapsync Admin@c:'C:/msys/1.0/home/Admin/imapsync/' + +tests_win32: dosify_bat + scp imapsync test.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' + ssh Admin@c 'perl C:/msys/1.0/home/Admin/imapsync/imapsync --tests_debug' +# ssh Admin@c 'perl C:/msys/1.0/home/Admin/imapsync/imapsync' +# ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test.bat' +# ssh Admin@c 'tasklist /FI "PID eq 0"' +# ssh Admin@c 'tasklist /NH /FO CSV' + +upload_imapsync_exe: + rsync -avH imapsync.exe \ + ../../public_html/www.linux-france.org/html/prj/imapsync/ + #sh $(HOME)/memo/lfo-rsync test_imapsync_exe: dosify_bat scp test_exe.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' time ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test_exe.bat' imapsync.exe: imapsync imapsync_cidone dosify_bat + (date "+%s"| tr "\n" " "; echo -n "BEGIN " $(VERSION) ": "; date) >> .BUILD_EXE_TIME scp imapsync build_exe.bat test_exe.bat \ Admin@c:'C:/msys/1.0/home/Admin/imapsync/' time ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/build_exe.bat' time ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test_exe.bat' scp Admin@c:'C:/msys/1.0/home/Admin/imapsync/imapsync.exe' . ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/imapsync.exe --version' > VERSION_EXE + (date "+%s"| tr "\n" " "; echo -n "END " $(VERSION) ": "; date) >> .BUILD_EXE_TIME + +zzz: + (date "+%s"| tr "\n" " "; echo -n "BEGIN " $(VERSION) ": "; date) >> .BUILD_EXE_TIME + (date "+%s"| tr "\n" " "; echo -n "END " $(VERSION) ": "; date) >> .BUILD_EXE_TIME lfo: dist niouze_lfo upload_lfo @@ -173,10 +198,10 @@ upload_lfo: sh ~/memo/lfo-rsync niouze_lfo : VERSION - . memo && lfo_announce + . ./memo && lfo_announce niouze_fm: VERSION - . memo && fm_announce + . ./memo && fm_announce public: niouze_fm diff --git a/README b/README index d6be304..6709d9c 100644 --- a/README +++ b/README @@ -3,7 +3,7 @@ NAME Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 36 different IMAP server softwares supported with success. - $Revision: 1.350 $ + $Revision: 1.366 $ SYNOPSIS To synchronise imap account "foo" on "imap.truc.org" to imap account @@ -16,12 +16,13 @@ SYNOPSIS INSTALL imapsync works fine under any Unix OS with perl. - imapsync works fine under Windows (2000, XP) with ActiveState's 5.8 Perl - or as a standalone binary software. + imapsync works fine under Windows (2000, XP) + with Strawberry Perl 5.10 or 5.12 + or as a standalone binary software imapsync.exe imapsync is already available directly on the following distributions - (at least): FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva - and OpenBSD (yeah!). + (at least): FreeBSD, Debian, Ubuntu, Gentoo, Fedora, NetBSD, Darwin, + Mandriva and OpenBSD (yeah!). Get imapsync at http://www.linux-france.org/prj/imapsync/ @@ -70,6 +71,7 @@ USAGE [--syncacls] [--regexmess ] [--regexmess ] [--maxsize ] + [--minsize ] [--maxage ] [--minage ] [--skipheader ] @@ -185,8 +187,9 @@ MAILING-LIST To write on the mailing-list, the address is: - To subscribe, send a message to: - + To subscribe, send any message (even empty) to: + then just reply to the + confirmation message. To unsubscribe, send a message to: @@ -401,5 +404,5 @@ SIMILAR SOFTWARES Feedback (good or bad) will often be welcome. - $Id: imapsync,v 1.350 2010/09/06 01:05:09 gilles Exp gilles $ + $Id: imapsync,v 1.366 2010/10/25 17:15:52 gilles Exp gilles $ diff --git a/TIME b/TIME index da48536..10aaed3 100644 --- a/TIME +++ b/TIME @@ -1,3 +1,20 @@ + 90 Permit host* to change the case of headers. 1.366 release. +120 Fix tls capability. 1.365 release. +150 1.363 public release. +240 Added --delete2folders option. +150 Try to fix again win32 libeay32.dll issue. Upload 1.361 and .exe +270 Draw imapsync logo with inkscape. Had a crash after 2 hours of drawing and saved file was also buggy... +120 Bugfix win32. Email. Added and tested linkage with --link libeay32.dll --link ssleay32.dll +120 Bugfix about POSIX alarm on win32. imapsync 1.359 public release. +160 Added memory consumption for win32. imapsync 1.358 +300 Local environment. Tests. Moved subroutines below main. Changed alarm call. + 90 Memory consumption on Win32 + 50 Better memory consumption statistics + 35 Added memory consumption to final stats. +240 Wrote a message_string_raw() function. Tests. +120 Thinking about performance. Email to italian compagny. +100 Tracking memory consumption. Wrote learn/memory_consumption. Sent bug report to bug-Mail-IMAPClient [at] rt.cpan.org. +180 Tracking memory consumption. 360 Date::Manip away. good_date() rewriting. release check on lfo 210 Better output when copying messages. Profiling memory. 80 Gmail efficiency. Wanted! on homepage, email on list. diff --git a/TODO b/TODO index 4463230..689e8df 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: TODO,v 1.85 2010/09/06 01:08:14 gilles Exp gilles $ +# $Id: TODO,v 1.86 2010/10/08 00:43:09 gilles Exp gilles $ TODO file for imapsync ---------------------- @@ -13,6 +13,8 @@ Start a wiki for imapsync. Add a best practice migration tips document. +Write a Mail::imapsync package and use it. + 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,19 +23,11 @@ Evaluate http://www.rackspace.com/apps/email_hosting/migrations http://www.yippiemove.com/ -Evaluate memory consumption with (or better): -print qx{ ps o pid,pcpu,comm,vsz,rss,size $$ }, "\n" -Search memory leaks with -Test-Weaken Test-Memory-Cycle Devel-Cycle Devel-Leak Test-Weaken -sh -x tests.sh ll_bigmail -is a good candidate to stress memory. - Suggestion: it's very difficult to track down messages which are behaving funny during the sync. It would be great - and presumably easy to code - to have an option to have imapsync display e.g. the subject of an e-mail when it gets synced, rather than just the message ID and the date/time. - Add --noauthmd51 --noauthmd52 to permit noauthmd5 by host Add a well described problem for each problem detected @@ -109,13 +103,14 @@ Add a --skipheaderinfolder option Fix this: > - Erreur avec la traditionnelle différence entre Windows -> et LInux sur les retour-chariots : le calcul de la +> et Linux sur les retour-chariots : le calcul de la > longueur du message ou des entêtes à envoyer au serveur > cible n'est pas bon sur une machine Windows. > Ci-dessous la modif : > > # No NL Count on Windows my $length = ( -s $file ) + $bare_nl_count; > my $length = ( -s $file ); +I wonder if it is Windows or the imap server used. Add stdin/stdout filter before transfer: @@ -170,6 +165,17 @@ Explain expunge behavior. =========================================================================== +DONE. Evaluate memory consumption with (or better): +print qx{ ps o pid,pcpu,comm,vsz,rss,size $$ }, "\n" +Search memory leaks with +Test-Weaken Test-Memory-Cycle Devel-Cycle Devel-Leak Test-Weaken +sh -x tests.sh ll_bigmail +sh -x tests.sh ll_memory_consumption +are good candidate to stress memory. +No memory leak detected just up to 8 memory copies of the same data +in Mail::IMAPClient. +Wrote ./learn/memory_consumption to show that it is a Mail::IMAPClient issue. + DONE.Be more effiscient with large mailboxes Write a Mail::IMAPClient::fetch_hash allowing selecting messages to fetch 4 hours estimated time coding. Time spent 4h30 (with public release and emails) diff --git a/VERSION b/VERSION index 0b73934..f014005 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.350 +1.366 diff --git a/VERSION_EXE b/VERSION_EXE index bcdbccd..a31af01 100644 --- a/VERSION_EXE +++ b/VERSION_EXE @@ -1 +1 @@ -1.350 +1.366 diff --git a/build_exe.bat b/build_exe.bat index f100900..2022c35 100755 --- a/build_exe.bat +++ b/build_exe.bat @@ -1,10 +1,10 @@ -REM $Id: build_exe.bat,v 1.3 2010/09/06 02:16:24 gilles Exp gilles $ +REM $Id: build_exe.bat,v 1.6 2010/10/24 23:51:48 gilles Exp gilles $ echo Building imapsync.exe cd C:\msys\1.0\home\Admin\imapsync perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mFile::Spec -mDigest::HMAC_MD5 -e '' -pp -o imapsync.exe -M Term::ReadKey -M IO::Socket::SSL -M Digest::HMAC_MD5 imapsync +pp -o imapsync.exe -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL -M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey imapsync echo Done building imapsync.exe diff --git a/freshmeat_submition.inp b/freshmeat_submition.inp index 4268236..4d8a193 100644 --- a/freshmeat_submition.inp +++ b/freshmeat_submition.inp @@ -3,8 +3,8 @@ #RELEASE_FOCUS="Initial freshmeat announcement" #RELEASE_FOCUS="Documentation" #RELEASE_FOCUS="Code cleanup" -#RELEASE_FOCUS="Minor feature enhancements" -RELEASE_FOCUS="Major feature enhancements" +RELEASE_FOCUS="Minor feature enhancements" +#RELEASE_FOCUS="Major feature enhancements" #RELEASE_FOCUS="Minor bugfixes" #RELEASE_FOCUS="Major bugfixes" #RELEASE_FOCUS="Minor security fixes" @@ -12,9 +12,4 @@ RELEASE_FOCUS="Major feature enhancements" #TEXT_BODY="Syntax cleanup" #TEXT_BODY="Updated documentation" -TEXT_BODY=" -Since 1.350: -Bug fixes. -Many thanks to the freshmeat folk that correct my bad and poorly English! -" - +TEXT_BODY="Since last public release 1.350: Added --minsize option to transfer messages bigger than a given size. Added memory consumption to know how much concurent imapsync can run in parallel on a system. Thanks to the freshmeat guy who corrects my bad and poorly English!" diff --git a/freshmeat_submition.json b/freshmeat_submition.json index 8b2c6e6..0088346 100644 --- a/freshmeat_submition.json +++ b/freshmeat_submition.json @@ -1,31 +1,9 @@ { "release": { - "tag_list": "Major feature enhancements", - "version": "1.350", + "tag_list": "stable, Minor feature enhancements", + "version": "1.359", "hidden_from_frontpage": false, - "changelog": " -Since 1.286: -Added --noreleasecheck option. -Added new release checking. -Removed Date::Manip dependancy. -Better output when copying messages. -More effiscient with large mailboxes. -Clarity: print capability after authenticated state. -Duplicate messages on host2 are now deleted with --delete2 ---skipsize turned on by default. -Usability fix: examples with --password1 instead of --passfile1 -Added --debugimap1 --debugimap2 to permit imap outpout with only one host. -Added reconnect statistics. -Added reconnect behavior with Mail::IMAPClient 2.2.9 -Added statistic about messages deleted. -Added statistic about average bandwith rate. -Flags are now exactly synced from host1 to host2 -(Previous releases just added flags). -Added TLSv1 support. -Filter flags sync with the list given by PERMANENTFLAGS on --host2 -and bug fixes. -Many thanks to the freshmeat folk that correct my bad and poorly English! -" + "changelog": "Since last public release 1.350: Added --minsize option to transfer messages bigger than a given size.Added memory consumption to know how much concurent imapsync can run in parallel on a system. Many thanks to the freshmeat folk that correct my bad and poorly English!" } } diff --git a/imapsync b/imapsync index 37bcfe5..f20a9dd 100755 --- a/imapsync +++ b/imapsync @@ -20,7 +20,7 @@ tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 36 different IMAP server softwares supported with success. -$Revision: 1.350 $ +$Revision: 1.366 $ =head1 SYNOPSIS @@ -36,12 +36,14 @@ To synchronise imap account "foo" on "imap.truc.org" =head1 INSTALL imapsync works fine under any Unix OS with perl. - imapsync works fine under Windows (2000, XP) with ActiveState's 5.8 Perl - or as a standalone binary software. + imapsync works fine under Windows (2000, XP) + with Strawberry Perl 5.10 or 5.12 + or as a standalone binary software imapsync.exe imapsync is already available directly on the following distributions (at least): -FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva and OpenBSD (yeah!). +FreeBSD, Debian, Ubuntu, Gentoo, Fedora, +NetBSD, Darwin, Mandriva and OpenBSD (yeah!). Get imapsync at http://www.linux-france.org/prj/imapsync/ @@ -91,6 +93,7 @@ The option list: [--syncacls] [--regexmess ] [--regexmess ] [--maxsize ] + [--minsize ] [--maxage ] [--minage ] [--skipheader ] @@ -228,8 +231,9 @@ The public mailing-list may be the best way to get support. To write on the mailing-list, the address is: -To subscribe, send a message to: +To subscribe, send any message (even empty) to: +then just reply to the confirmation message. To unsubscribe, send a message to: @@ -471,7 +475,7 @@ Entries for imapsync: Feedback (good or bad) will often be welcome. -$Id: imapsync,v 1.350 2010/09/06 01:05:09 gilles Exp gilles $ +$Id: imapsync,v 1.366 2010/10/25 17:15:52 gilles Exp gilles $ =cut @@ -489,7 +493,8 @@ use Digest::MD5 qw(md5_base64); #use IO::Socket::SSL; use MIME::Base64; use English; -use POSIX qw(uname); +use File::Basename; +use POSIX qw(uname SIGALRM); use Fcntl; use File::Spec; use File::Path qw(mkpath rmtree); @@ -500,6 +505,14 @@ 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( @@ -516,7 +529,7 @@ my( $usedatemanip, $syncacls, $fastio1, $fastio2, - $maxsize, $maxage, $minage, + $maxsize, $minsize, $maxage, $minage, $skipheader, @useheader, $skipsize, $allowsizemismatch, $foldersizes, $buffersize, $delete, $delete2, @@ -554,13 +567,16 @@ my( $allow3xx, $justlogin, $tmpdir, $releasecheck, + $max_msg_size_in_bytes, + $modules_version, + $delete2folders, ); # main program # global variables initialisation -$rcs = '$Id: imapsync,v 1.350 2010/09/06 01:05:09 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.366 2010/10/25 17:15:52 gilles Exp gilles $ '; $total_bytes_transferred = 0; $total_bytes_skipped = 0; @@ -573,6 +589,7 @@ $h1_nb_msg_noheader = $h2_nb_msg_noheader = 0; $h1_total_bytes_duplicate = $h2_total_bytes_duplicate = 0; $nb_errors = 0; +$max_msg_size_in_bytes = 0; unless(defined(&_SYSEXITS_H)) { # 64 on my linux box. @@ -584,6 +601,8 @@ my @argv_copy = @ARGV; get_options(); +$modules_version = defined($modules_version) ? $modules_version : 1; + $releasecheck = defined($releasecheck) ? $releasecheck : 1; my $warn_release = ($releasecheck) ? check_last_release() : ''; @@ -602,7 +621,8 @@ print "Temp directory is $tmpdir\n"; is_valid_directory($tmpdir); write_pidfile($pidfile) if ($pidfile); -print "Modules version list:\n", modules_VERSION(), "\n"; +$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.0.25 or superior \n"; @@ -623,19 +643,6 @@ $debugimap1 = $debugimap2 = 1 if ($debugimap); # By default, don't take size to compare $skipsize = (defined $skipsize) ? $skipsize : 1; -sub connect_imap { - my($host, $port, $debugimap, $ssl, $tls) = @_; - my $imap = Mail::IMAPClient->new(); - $imap->Server($host); - $imap->Port($port); - $imap->Debug($debugimap); - $imap->Ssl($ssl) if ($ssl); - $imap->Tls($tls) if ($tls); - #$imap->connect() - myconnect($imap) - or die_clean("Can not open imap connection on [$host]: $@\n"); -} - if ($justconnect) { justconnect(); @@ -693,19 +700,6 @@ $reconnectretry2 = (defined($reconnectretry2)) ? $reconnectretry2 : 3; print "Host1: imap server [$host1] port [$port1] user [$user1]\n"; print "Host2: imap server [$host2] port [$port2] user [$user2]\n"; - -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; -} - - $password1 || $passfile1 || do { $password1 = ask_for_password($authuser1 || $user1, $host1); }; @@ -740,6 +734,820 @@ $debug and print "Host1 Buffer I/O: ", $imap1->Buffer(), "\n"; $debug and print "Host2 Buffer I/O: ", $imap2->Buffer(), "\n"; + +die_clean() unless $imap1->IsAuthenticated(); +print "Host1: state Authenticated\n"; +die_clean() 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); + +$split1 and $imap1->Split($split1); +$split2 and $imap2->Split($split2); + +# +# Folder stuff +# + +my ( +@h1_folders_all, %h1_folders_all, @h1_folders_wanted, %requested_folder, %subscribed_folder, +@h2_folders_all, %h2_folders_all, @h2_folders_from_1, %h2_folders_from_1, +); + + +# Make a hash of subscribed folders in source server. +map { $subscribed_folder{$_} = 1 } $imap1->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 (%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 + +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_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_namespace = $imap1->namespace(); +#my $h2_namespace = $imap2->namespace(); +#$debug and print "Host1 namespace:\n", Data::Dumper->Dump([$h1_namespace]); +#$debug and print "Host2 namespace:\n", Data::Dumper->Dump([$h2_namespace]); + +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"; + + +foreach my $h1_fold (@h1_folders_wanted) { + my $h2_fold; + $h2_fold = imap2_folder_name($h1_fold); + $h2_folders_from_1{$h2_fold}++; +} + +@h2_folders_from_1 = sort keys(%h2_folders_from_1); + +if ($foldersizes) { + foldersizes("Host1", $imap1, @h1_folders_wanted); + foldersizes("Host2", $imap2, @h2_folders_from_1); +} + + +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(%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"; + +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); + + printf("%-35s -> %-35s\n", "[$h1_fold]", "[$h2_fold]"); + unless ($imap1->select($h1_fold)) { + warn + "Host1 folder $h1_fold: Could not select: ", + $imap1->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + + if ( ! exists($h2_folders_all{$h2_fold})) { + print "Host2 folder $h2_fold does not exist\n"; + print "Creating folder [$h2_fold]\n"; + unless ($dry){ + unless ($imap2->create($h2_fold)){ + warn "Couldn't create [$h2_fold]: ", + $imap2->LastError,"\n"; + $nb_errors++; + next FOLDER; + } + } + else{ + next FOLDER; + } + } + + acls_sync($h1_fold, $h2_fold); + + unless ($imap2->select($h2_fold)) { + warn + "Host2 folder $h2_fold: Could not select: ", + $imap2->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + my @select_results = $imap2->Results(); + + #print "%%% @select_results\n"; + my $permanentflags2 = permanentflags(@select_results); + + if ($expunge){ + print "Expunging host1 $h1_fold\n"; + unless($dry) { $imap1->expunge() }; + #print "Expunging host2 $h2_fold\n"; + #unless($dry) { $imap2->expunge() }; + } + + if (($subscribe and exists $subscribed_folder{$h1_fold}) or $subscribe_all) { + 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 = select_msgs($imap1); + + $debug and print "LIST Host1: ", scalar(@h1_msgs), " messages [@h1_msgs]\n"; + # internal dates on host2 are after the ones on host1 + # normally... + my @h2_msgs = select_msgs($imap2); + + $debug and print "LIST Host2: ", scalar(@h2_msgs), " messages [@h2_msgs]\n"; + + my %h1_hash = (); + my %h2_hash = (); + + $debug and print "Host1 folder [$h1_fold] parsing headers\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my ($h1_heads_ref, $h1_fir_ref) = ({}, {}); + $h1_heads_ref = $imap1->parse_headers([@h1_msgs], @useheader) if (@h1_msgs); + $debug and print "Time headers: ", timenext(), " s\n"; + last FOLDER if $imap1->IsUnconnected(); + + @$h1_fir_ref{@h1_msgs} = (undef); + $h1_fir_ref = $imap1->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref) + if (@h1_msgs); + $debug and print "Time fir: ", timenext(), " s\n"; + unless ($h1_fir_ref) { + warn + "Host1 folder $h1_fold: Could not fetch_hash_2 ", + scalar(@h1_msgs), " msgs: ", $imap1->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + last FOLDER if $imap1->IsUnconnected(); + + + my @h1_msgs_duplicate; + foreach my $m (@h1_msgs) { + my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, "F", \%h1_hash); + if (! defined($rc)) { + my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + print "+ Skipping msg #$m:$h1_size on host1 folder $h1_fold (no header so we ignore this message)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + $h1_nb_msg_noheader +=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; + } + } + $debug and print "Time parsing headers on host1: ", timenext(), " s\n"; + + $debug and print "Host2 folder [$h2_fold] parsing headers\n"; + + my ($h2_heads_ref, $h2_fir_ref) = ({}, {}); + $h2_heads_ref = $imap2->parse_headers([@h2_msgs], @useheader) if (@h2_msgs); + $debug and print "Time headers: ", timenext(), " s\n"; + last FOLDER if $imap2->IsUnconnected(); + + @$h2_fir_ref{@h2_msgs} = (undef); # fetch_hash_2 can select by uid with last arg as ref + $h2_fir_ref = $imap2->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref) + if (@h2_msgs); + $debug and print "Time fir: ", timenext(), " s\n"; + last FOLDER if $imap2->IsUnconnected(); + + my @h2_msgs_duplicate; + foreach my $m (@h2_msgs) { + my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, "T", \%h2_hash); + if (! defined($rc)) { + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + print "+ Skipping msg #$m:$h2_size in host2 folder $h2_fold (no header so we ignore this message)\n"; + $h2_nb_msg_noheader += 1 ; + } elsif(0 == $rc) { + # duplicate + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + $h2_nb_msg_duplicate += 1; + $h2_total_bytes_duplicate += $h2_size; + push(@h2_msgs_duplicate, $m); + } + } + $debug and print "Time parsing headers on host2: ", 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($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 deleted on host2 [$m_id]\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_duplicate) { + print "msg $h2_fold/$h2_msg deleted [duplicate] on host2\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 and !$imap2->can("uidexpunge")) { + warn "uidexpunge not supported (< IMAPClient 3.17)\n"; + } + elsif(@h2_expunge) { + print "uidexpunge $cnt message(s)\n"; + $imap2->uidexpunge(\@h2_expunge) if !$dry; + } + } + + MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) { + my $h1_size = $h1_hash{$m_id}{'s'}; + my $h1_msg = $h1_hash{$m_id}{'m'}; + my $h1_idate = $h1_hash{$m_id}{'D'}; + + if (defined $maxsize and $h1_size >= $maxsize) { + print "msg $h1_fold/$h1_msg skipping ($h1_size exceeds maxsize limit $maxsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + next MESS; + } + if (defined $minsize and $h1_size <= $minsize) { + print "msg $h1_fold/$h1_msg skipping ($h1_size smaller than minsize $minsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + next MESS; + } + + unless (exists($h2_hash{$m_id})) { + # copy + $debug and print "msg $h1_fold/$h1_msg copying to $h2_fold\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + my $string; + #print "Message_string Beg\n", memory_consumption(); + $string = $imap1->message_string($h1_msg); + #print "Message_string End\n", memory_consumption(); + unless (defined($string)) { + warn + "- msg $h1_fold/$h1_msg could not fetch [$m_id $h1_size]: ", + $imap1->LastError, "\n"; + $nb_errors++; + $total_bytes_error += $h1_size; + next MESS; + } + + #my $message_file = "tmp_imapsync_$$"; + #$imap1->select($h1_fold); + #unlink($message_file); + #$imap1->message_to_file($message_file, $h1_msg) or do { + # warn "Could not put message #$h1_msg to file $message_file", + # $imap1->LastError; + # $nb_errors++; + # $total_bytes_error += $h1_size; + # next MESS; + #}; + #$string = file_to_string($message_file); + #print "AAA1[$string]ZZZ\n"; + #unlink($message_file); + if (@regexmess) { + $string = regexmess($string); + + #string_to_file($string, $message_file); + } + + + $debug 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"; + } + + my $h1_flags = $h1_hash{$m_id}{'F'} || ""; + # 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 = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); + + my $new_id; + $debug and print "msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + $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'; + warn "- msg $h1_fold/$h1_msg couldn't append (Subject:[". + $imap1->subject($h1_msg)."]) to folder $h2_fold: ", + $imap2->LastError, "\n"; + $nb_errors++; + $total_bytes_error += $h1_size; + next MESS; + } + else{ + # good + # $new_id is an id if the IMAP server has the + # UIDPLUS capability else just a ref + print "msg $h1_fold/$h1_msg copied to $h2_fold/$new_id\n"; + $total_bytes_transferred += $h1_size; + $nb_msg_transferred += 1; + if($delete) { + print "msg $h1_fold/$h1_msg deleted on host1\n"; + unless($dry) { + $imap1->delete_message($h1_msg); + $h1_nb_msg_deleted += 1; + last FOLDER if $imap1->IsUnconnected(); + $imap1->expunge() if ($expunge); + last FOLDER if $imap1->IsUnconnected(); + } + } + } + } + else{ + $nb_msg_skipped_dry_mode += 1; + } + #unlink($message_file); + next MESS; + } + else{ + #my $h2_size = $h2_hash{$m_id}{'s'}; + my $h2_msg = $h2_hash{$m_id}{'m'}; + #my $h2_idate = $h2_hash{$m_id}{'D'}; + $debug and print "msg $h1_fold/$h1_msg equals $h2_fold/$h2_msg\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + } + + $fast and next MESS; + #$debug and print "MESSAGE $m_id\n"; + my $h2_size = $h2_hash{$m_id}{'s'}; + my $h2_msg = $h2_hash{$m_id}{'m'}; + + # used cached flag values for efficiency + my $h1_flags = $h1_hash{$m_id}{'F'} || ""; + my $h2_flags = $h2_hash{$m_id}{'F'} || ""; + + # 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 = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); + + + # 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 and $debug and print "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)") ) { + warn "- msg $h2_fold/$h2_msg could not add flags @h1_flags", + $imap2->LastError, "\n"; + #$nb_errors++; + } + last FOLDER if $imap2->IsUnconnected(); + + $debug and do { + my @h2_flags = @{ $imap2->flags($h2_msg) || [] }; + last FOLDER if $imap2->IsUnconnected(); + + print "host1 flags: $h1_flags\n", + "host2 flags: @h2_flags\n"; + + print "Looking dates\n"; + #my $h1_idate = $imap1->internaldate($h1_msg); + #my $h2_idate = $imap2->internaldate($h2_msg); + my $h1_idate = $h1_hash{$m_id}{'D'}; + my $h2_idate = $h2_hash{$m_id}{'D'}; + print + "host1 internal date: $h1_idate\n", + "host2 internal date: $h2_idate\n"; + + #unless ($h1_idate eq $h2_idate) { + # print "!!! Dates differs !!!\n"; + #} + }; + unless ($skipsize or ($h1_size == $h2_size)) { + # Bad size + print + "- msg $h1_fold/$h1_msg size diff $h1_size != $h2_size $h2_fold/$h2_msg\n"; + $nb_errors++; + } + else { + # Good + $debug and print + "msg $h1_fold/$h1_msg sizes ok $h1_size <=> $h2_size $h2_fold/$h2_msg\n"; + 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); + } + } + } + } + if ($expunge1){ + print "Expunging host1 folder $h1_fold\n"; + unless($dry) { $imap1->expunge() }; + } + if ($expunge2){ + print "Expunging host2 folder $h2_fold\n"; + unless($dry) { $imap2->expunge() }; + } + +$debug and print "Time: ", timenext(), " s\n"; +} + +print "++++ End looping on each folder\n"; +#print memory_consumption(); + +my $memory_consumption = memory_consumption(); +my $memory_ratio = ($max_msg_size_in_bytes) ? + sprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : "NA"; + + +$imap1->logout(); +$imap2->logout(); + +my $host1_reconnect_count = $imap1->Reconnect_counter() || 0; +my $host2_reconnect_count = $imap2->Reconnect_counter() || 0; + + +$timeend = time(); +$timediff = $timeend - $timestart; + +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 check_lib_version { + $debug and print "IMAPClient $Mail::IMAPClient::VERSION\n"; + if ($Mail::IMAPClient::VERSION eq '2.2.9') { + override_imapclient(); + 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::SSL +Digest::MD5 +Digest::HMAC_MD5 +Term::ReadKey)) + { + 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; + 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'); + + +} + +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 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 ($self->Tls) { + starttls($self); + } + + $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, "\n"; + 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 login_imap { my($host, $port, $user, $password, $debugimap, $timeout, $fastio, @@ -750,7 +1558,7 @@ sub login_imap { $imap->Ssl($ssl) if ($ssl); $imap->Tls($tls) if ($tls); - $imap->Clear(5); + $imap->Clear(1); $imap->Server($host); $imap->Port($port); $imap->Fast_io($fastio); @@ -806,6 +1614,7 @@ sub login_imap { return($imap); } + sub plainauth() { my $code = shift; my $imap = shift; @@ -822,29 +1631,70 @@ sub server_banner { return $banner; } -die_clean() unless $imap1->IsAuthenticated(); -print "Host1: state Authenticated\n"; -die_clean() unless $imap2->IsAuthenticated(); -print "Host2: state Authenticated\n"; -print "Host1 capability: ", join(" ", $imap1->capability_update()), "\n"; -print "Host2 capability: ", join(" ", $imap2->capability_update()), "\n"; +sub banner_imapsync { + + my @argv_copy = @_; + my $banner_imapsync = join("", + '$RCSfile: imapsync,v $ ', + '$Revision: 1.366 $ ', + '$Date: 2010/10/25 17:15:52 $ ', + "\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); +} -exit_clean(0) if ($justlogin); -$split1 and $imap1->Split($split1); -$split2 and $imap2->Split($split2); -# -# Folder stuff -# +sub write_pidfile { + my $pidfile = shift; + + print "PID file is $pidfile\n"; + if (-e $pidfile) { + warn "$pidfile already exists, overwriting it\n"; + } + open(PIDFILE, ">$pidfile") or do { + warn "Could not open $pidfile for writing"; + return undef; + }; + + print PIDFILE $PROCESS_ID; + close PIDFILE; + return($PROCESS_ID); +} + +sub exit_clean { + my $status = shift; + + 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"); +} + -my (@h1_folders, %requested_folder, -@h2_folders, @h2_folders_list, %h2_folders_list, %subscribed_folder, %h2_folders); sub tests_folder_routines { - ok( !give_requested_folders() ,"no requested folders" ); ok( !is_requested_folder('folder_foo') ); ok( add_to_requested_folders('folder_foo') ); ok( is_requested_folder('folder_foo') ); @@ -857,20 +1707,8 @@ sub tests_folder_routines { ok( is_requested_folder('folder_toto') ); ok( remove_from_requested_folders('folder_toto') ); ok( !is_requested_folder('folder_toto') ); - ok( init_requested_folders() , 'empty requested folders'); - ok( !give_requested_folders() , 'no requested folders' ); } -sub give_requested_folders { - return(keys(%requested_folder)); -} - -sub init_requested_folders { - - %requested_folder = (); - return(1); - -} sub is_requested_folder { my ( $folder ) = @_; @@ -897,74 +1735,6 @@ sub remove_from_requested_folders { return( keys(%requested_folder) ); } - -# Make a hash of subscribed folders in source server. -map { $subscribed_folder{$_} = 1 } $imap1->subscribed(); - - - - -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 (%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)) { - my @all_source_folders = sort $imap1->folders(); - add_to_requested_folders(@all_source_folders); - } -} - - -# consider (optional) includes and excludes -if (scalar(@include)) { - my @all_source_folders = sort $imap1->folders(); - foreach my $include (@include) { - my @included_folders = grep /$include/, @all_source_folders; - 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 - -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 = @requested_folder; - sub compare_lists { my ($list_1_ref, $list_2_ref) = @_; @@ -1029,6 +1799,7 @@ sub tests_compare_lists { 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]) @@ -1048,21 +1819,6 @@ sub tests_compare_lists { } -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_namespace = $imap1->namespace(); -#my $h2_namespace = $imap2->namespace(); -#$debug and print "Host1 namespace:\n", Data::Dumper->Dump([$h1_namespace]); -#$debug and print "Host2 namespace:\n", Data::Dumper->Dump([$h2_namespace]); - -my($h1_prefix,$h2_prefix); -$h1_prefix = get_prefix($imap1, $prefix1, "--prefix1"); -$h2_prefix = get_prefix($imap2, $prefix2, "--prefix2"); sub get_prefix { my($imap, $prefix_in, $prefix_opt) = @_; @@ -1118,99 +1874,6 @@ sub get_separator { } } - -print "Host1 separator and prefix: [$h1_sep][$h1_prefix]\n"; -print "Host2 separator and prefix: [$h2_sep][$h2_prefix]\n"; - - -sub foldersizes { - - my ($side, $imap, $folders_r) = @_; - my $tot = 0; - my $tmess = 0; - my @folders = @{$folders_r}; - print "++++ Calculating sizes\n"; - foreach my $folder (@folders) { - my $stot = 0; - my $smess = 0; - printf("$side folder %-35s", "[$folder]"); - unless($imap->exists($folder)) { - print("does not exist yet\n"); - next; - } - unless ($imap->examine($folder)) { - warn - "$side Folder $folder: Could not examine: ", - $imap->LastError, "\n"; - $nb_errors++; - next; - } - - my $hash_ref = {}; - my @msgs = select_msgs($imap); - $smess = scalar(@msgs); - @$hash_ref{@msgs} = (undef); - unless ($smess == 0) { - $imap->fetch_hash_2("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; - } - - printf(" Size: %9s", $stot); - printf(" Messages: %5s\n", $smess); - $tot += $stot; - $tmess += $smess; - } - print "Total size: $tot\n"; - print "Total messages: $tmess\n"; - print "Time: ", timenext(), " s\n"; -} - - -foreach my $h1_fold (@h1_folders) { - my $h2_fold; - $h2_fold = imap2_folder_name($h1_fold); - $h2_folders{$h2_fold}++; -} - -@h2_folders = sort keys(%h2_folders); - -if ($foldersizes) { - foldersizes("Host1", $imap1, \@h1_folders); - foldersizes("Host2", $imap2, \@h2_folders); -} - - -sub timenext { - my ($timenow, $timerel); - # $timebefore is global, beurk ! - $timenow = time; - $timerel = $timenow - $timebefore; - $timebefore = $timenow; - return($timerel); -} - -exit_clean(0) if ($justfoldersizes); - -# needed for setting flags -my $imap2hasuidplus = $imap2->has_capability("UIDPLUS"); - - -@h2_folders_list = sort @{$imap2->folders()}; -foreach my $folder (@h2_folders_list) { - $h2_folders_list{$folder}++; -} - -print - "++++ Listing folders\n", - "Host1 folders list:\n", map("[$_]\n",@h1_folders),"\n", - "Host2 folders list:\n", map("[$_]\n",@h2_folders_list),"\n"; - -print - "Host1 subscribed folders list: ", - map("[$_] ", sort keys(%subscribed_folder)), "\n" - if ($subscribed); - sub separator_invert { # The separator we hope we'll never encounter: 00000000 my $o_sep="\000"; @@ -1283,6 +1946,60 @@ sub imap2_folder_name { return($h2_fold); } + +sub foldersizes { + + my ($side, $imap, @folders) = @_; + my $tot = 0; + my $tmess = 0; + + print "++++ Calculating sizes\n"; + foreach my $folder (@folders) { + my $stot = 0; + my $smess = 0; + printf("$side folder %-35s", "[$folder]"); + unless($imap->exists($folder)) { + print("does not exist yet\n"); + next; + } + unless ($imap->examine($folder)) { + warn + "$side Folder $folder: Could not examine: ", + $imap->LastError, "\n"; + $nb_errors++; + next; + } + + my $hash_ref = {}; + my @msgs = select_msgs($imap); + $smess = scalar(@msgs); + @$hash_ref{@msgs} = (undef); + unless ($smess == 0) { + $imap->fetch_hash_2("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; + } + + printf(" Size: %9s", $stot); + printf(" Messages: %5s\n", $smess); + $tot += $stot; + $tmess += $smess; + } + print "Total size: $tot\n"; + print "Total messages: $tmess\n"; + print "Time: ", timenext(), " s\n"; +} + +sub timenext { + my ($timenow, $timerel); + # $timebefore is global, beurk ! + $timenow = time; + $timerel = $timenow - $timebefore; + $timebefore = $timenow; + return($timerel); +} + + sub tests_flags_regex { my $string; @@ -1477,712 +2194,6 @@ sub flags_filter { } -# folder loop -print "++++ Looping on each folder\n"; - -FOLDER: foreach my $h1_fold (@h1_folders) { - - last FOLDER if $imap1->IsUnconnected(); - last FOLDER if $imap2->IsUnconnected(); - - my $h2_fold = imap2_folder_name($h1_fold); - - printf("%-35s -> %-35s\n", "[$h1_fold]", "[$h2_fold]"); - unless ($imap1->select($h1_fold)) { - warn - "Host1 folder $h1_fold: Could not select: ", - $imap1->LastError, "\n"; - $nb_errors++; - next FOLDER; - } - - if ( ! exists($h2_folders_list{$h2_fold})) { - print "Host2 folder $h2_fold does not exist\n"; - print "Creating folder [$h2_fold]\n"; - unless ($dry){ - unless ($imap2->create($h2_fold)){ - warn "Couldn't create [$h2_fold]: ", - $imap2->LastError,"\n"; - $nb_errors++; - next FOLDER; - } - } - else{ - next FOLDER; - } - } - - acls_sync($h1_fold, $h2_fold); - - unless ($imap2->select($h2_fold)) { - warn - "Host2 folder $h2_fold: Could not select: ", - $imap2->LastError, "\n"; - $nb_errors++; - next FOLDER; - } - my @select_results = $imap2->Results(); - - #print "%%% @select_results\n"; - my $permanentflags2 = permanentflags(@select_results); - - if ($expunge){ - print "Expunging host1 $h1_fold\n"; - unless($dry) { $imap1->expunge() }; - #print "Expunging host2 $h2_fold\n"; - #unless($dry) { $imap2->expunge() }; - } - - if (($subscribe and exists $subscribed_folder{$h1_fold}) or $subscribe_all) { - 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 = select_msgs($imap1); - - $debug and print "LIST Host1: ", scalar(@h1_msgs), " messages [@h1_msgs]\n"; - # internal dates on host2 are after the ones on host1 - # normally... - my @h2_msgs = select_msgs($imap2); - - $debug and print "LIST Host2: ", scalar(@h2_msgs), " messages [@h2_msgs]\n"; - - my %h1_hash = (); - my %h2_hash = (); - - $debug and print "Host1 folder [$h1_fold] parsing headers\n"; - last FOLDER if $imap1->IsUnconnected(); - last FOLDER if $imap2->IsUnconnected(); - - my ($h1_heads_ref, $h1_fir_ref) = ({}, {}); - $h1_heads_ref = $imap1->parse_headers([@h1_msgs], @useheader) if (@h1_msgs); - $debug and print "Time headers: ", timenext(), " s\n"; - last FOLDER if $imap1->IsUnconnected(); - - @$h1_fir_ref{@h1_msgs} = (undef); - $h1_fir_ref = $imap1->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref) - if (@h1_msgs); - $debug and print "Time fir: ", timenext(), " s\n"; - unless ($h1_fir_ref) { - warn - "Host1 folder $h1_fold: Could not fetch_hash_2 ", - scalar(@h1_msgs), " msgs: ", $imap1->LastError, "\n"; - $nb_errors++; - next FOLDER; - } - last FOLDER if $imap1->IsUnconnected(); - - - my @h1_msgs_duplicate; - foreach my $m (@h1_msgs) { - my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, "F", \%h1_hash); - if (! defined($rc)) { - my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; - print "+ Skipping msg #$m:$h1_size on host1 folder $h1_fold (no header so we ignore this message)\n"; - $total_bytes_skipped += $h1_size; - $nb_msg_skipped += 1; - $h1_nb_msg_noheader +=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; - } - } - $debug and print "Time parsing headers on host1: ", timenext(), " s\n"; - - $debug and print "Host2 folder [$h2_fold] parsing headers\n"; - - my ($h2_heads_ref, $h2_fir_ref) = ({}, {}); - $h2_heads_ref = $imap2->parse_headers([@h2_msgs], @useheader) if (@h2_msgs); - $debug and print "Time headers: ", timenext(), " s\n"; - last FOLDER if $imap2->IsUnconnected(); - - @$h2_fir_ref{@h2_msgs} = (undef); # fetch_hash_2 can select by uid with last arg as ref - $h2_fir_ref = $imap2->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref) - if (@h2_msgs); - $debug and print "Time fir: ", timenext(), " s\n"; - last FOLDER if $imap2->IsUnconnected(); - - my @h2_msgs_duplicate; - foreach my $m (@h2_msgs) { - my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, "T", \%h2_hash); - if (! defined($rc)) { - my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; - print "+ Skipping msg #$m:$h2_size in host2 folder $h2_fold (no header so we ignore this message)\n"; - $h2_nb_msg_noheader += 1 ; - } elsif(0 == $rc) { - # duplicate - my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; - $h2_nb_msg_duplicate += 1; - $h2_total_bytes_duplicate += $h2_size; - push(@h2_msgs_duplicate, $m); - } - } - $debug and print "Time parsing headers on host2: ", 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($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 deleted on host2 [$m_id]\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_duplicate) { - print "msg $h2_fold/$h2_msg deleted [duplicate] on host2\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 and !$imap2->can("uidexpunge")) { - warn "uidexpunge not supported (< IMAPClient 3.17)\n"; - } - elsif(@h2_expunge) { - print "uidexpunge $cnt message(s)\n"; - $imap2->uidexpunge(\@h2_expunge) if !$dry; - } - } - - MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) { - my $h1_size = $h1_hash{$m_id}{'s'}; - my $h1_msg = $h1_hash{$m_id}{'m'}; - my $h1_idate = $h1_hash{$m_id}{'D'}; - - if (defined $maxsize and $h1_size > $maxsize) { - print "msg $h1_fold/$h1_msg skipping ($h1_size exceeds maxsize limit $maxsize bytes)\n"; - $total_bytes_skipped += $h1_size; - $nb_msg_skipped += 1; - next MESS; - } - unless (exists($h2_hash{$m_id})) { - # copy - $debug and print "msg $h1_fold/$h1_msg copying to $h2_fold\n"; - last FOLDER if $imap1->IsUnconnected(); - last FOLDER if $imap2->IsUnconnected(); - my $string; - $string = $imap1->message_string($h1_msg); - unless (defined($string)) { - warn - "- msg $h1_fold/$h1_msg could not fetch [$m_id $h1_size]: ", - $imap1->LastError, "\n"; - $nb_errors++; - $total_bytes_error += $h1_size; - next MESS; - } - - #my $message_file = "tmp_imapsync_$$"; - #$imap1->select($h1_fold); - #unlink($message_file); - #$imap1->message_to_file($message_file, $h1_msg) or do { - # warn "Could not put message #$h1_msg to file $message_file", - # $imap1->LastError; - # $nb_errors++; - # $total_bytes_error += $h1_size; - # next MESS; - #}; - #$string = file_to_string($message_file); - #print "AAA1[$string]ZZZ\n"; - #unlink($message_file); - if (@regexmess) { - $string = regexmess($string); - - #string_to_file($string, $message_file); - } - - - - 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); - } - - $debug 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"; - } - - my $h1_flags = $h1_hash{$m_id}{'F'} || ""; - # 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 = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); - - my $new_id; - $debug and print "msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"; - last FOLDER if $imap1->IsUnconnected(); - last FOLDER if $imap2->IsUnconnected(); - $h1_date = undef if ($h1_date eq ""); - unless ($dry) { - - if ($OSNAME eq "MSWin32") { - $new_id = $imap2->append_string($h2_fold, $string, $h1_flags, $h1_date); - } - else { - # just back to append_string since append_file 3.05 does not work. - #$new_id = $imap2->append_file($h2_fold, $message_file, "", $h1_flags, $d); - # append_string 3.05 does not work too some times with $d unset. - $new_id = $imap2->append_string($h2_fold, $string, $h1_flags, $h1_date); - } - unless($new_id){ - no warnings 'uninitialized'; - warn "- msg $h1_fold/$h1_msg couldn't append (Subject:[". - $imap1->subject($h1_msg)."]) to folder $h2_fold: ", - $imap2->LastError, "\n"; - $nb_errors++; - $total_bytes_error += $h1_size; - next MESS; - } - else{ - # good - # $new_id is an id if the IMAP server has the - # UIDPLUS capability else just a ref - print "msg $h1_fold/$h1_msg copied to $h2_fold/$new_id\n"; - $total_bytes_transferred += $h1_size; - $nb_msg_transferred += 1; - if($delete) { - print "msg $h1_fold/$h1_msg deleted on host1\n"; - unless($dry) { - $imap1->delete_message($h1_msg); - $h1_nb_msg_deleted += 1; - last FOLDER if $imap1->IsUnconnected(); - $imap1->expunge() if ($expunge); - last FOLDER if $imap1->IsUnconnected(); - } - } - } - } - else{ - $nb_msg_skipped_dry_mode += 1; - } - #unlink($message_file); - next MESS; - } - else{ - #my $h2_size = $h2_hash{$m_id}{'s'}; - my $h2_msg = $h2_hash{$m_id}{'m'}; - #my $h2_idate = $h2_hash{$m_id}{'D'}; - $debug and print "msg $h1_fold/$h1_msg equals $h2_fold/$h2_msg\n"; - $total_bytes_skipped += $h1_size; - $nb_msg_skipped += 1; - } - - $fast and next MESS; - #$debug and print "MESSAGE $m_id\n"; - my $h2_size = $h2_hash{$m_id}{'s'}; - my $h2_msg = $h2_hash{$m_id}{'m'}; - - # used cached flag values for efficiency - my $h1_flags = $h1_hash{$m_id}{'F'} || ""; - my $h2_flags = $h2_hash{$m_id}{'F'} || ""; - - # 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 = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); - - - # 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 and $debug and print "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)") ) { - warn "- msg $h2_fold/$h2_msg could not add flags @h1_flags", - $imap2->LastError, "\n"; - #$nb_errors++; - } - last FOLDER if $imap2->IsUnconnected(); - - $debug and do { - my @h2_flags = @{ $imap2->flags($h2_msg) || [] }; - last FOLDER if $imap2->IsUnconnected(); - - print "host1 flags: $h1_flags\n", - "host2 flags: @h2_flags\n"; - - print "Looking dates\n"; - #my $h1_idate = $imap1->internaldate($h1_msg); - #my $h2_idate = $imap2->internaldate($h2_msg); - my $h1_idate = $h1_hash{$m_id}{'D'}; - my $h2_idate = $h2_hash{$m_id}{'D'}; - print - "host1 internal date: $h1_idate\n", - "host2 internal date: $h2_idate\n"; - - #unless ($h1_idate eq $h2_idate) { - # print "!!! Dates differs !!!\n"; - #} - }; - unless ($skipsize or ($h1_size == $h2_size)) { - # Bad size - print - "- msg $h1_fold/$h1_msg size diff $h1_size != $h2_size $h2_fold/$h2_msg\n"; - $nb_errors++; - } - else { - # Good - $debug and print - "msg $h1_fold/$h1_msg sizes ok $h1_size <=> $h2_size $h2_fold/$h2_msg\n"; - 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); - } - } - } - } - if ($expunge1){ - print "Expunging host1 folder $h1_fold\n"; - unless($dry) { $imap1->expunge() }; - } - if ($expunge2){ - print "Expunging host2 folder $h2_fold\n"; - unless($dry) { $imap2->expunge() }; - } - -$debug and print "Time: ", timenext(), " s\n"; -} - -print "++++ End looping on each folder\n"; - - -# FOLDER loop is exited any time a connection is lost be sure to log it! -# Example: -# lost_connection($imap1,"host1 [$host1]"); -# -# can be tested with a "killall /usr/bin/imapd" (or equivalent) in command line. -# -sub _filter { - my $str = shift or return ""; - my $sz = 64; - my $len = length($str); - if ( ! $debug and $len > $sz*2 ) { - my $beg = substr($str, 0, $sz); - my $end = substr($str, -$sz, $sz); - $str = $beg . "..." . $end; - } - $str =~ s/\012?\015$//; - return "(len=$len) " . $str; -} - -sub lost_connection { - my($imap, $error_message) = @_; - if ( $imap->IsUnconnected() ) { - $nb_errors++; - my $lcomm = $imap->LastIMAPCommand || ""; - my $einfo = $imap->LastError || @{$imap->History}[-1] || ""; - - # if string is long try reduce to a more reasonable size - $lcomm = _filter($lcomm); - $einfo = _filter($einfo); - warn("error: last command: $lcomm\n") if ($debug && $lcomm); - warn("error: lost connection $error_message", $einfo, "\n"); - return(1); - }else{ - return(0); - } -} - -$imap1->logout(); -$imap2->logout(); - -my $host1_reconnect_count = $imap1->Reconnect_counter() || 0; -my $host2_reconnect_count = $imap2->Reconnect_counter() || 0; - -$timeend = time(); - -$timediff = $timeend - $timestart; - -stats(); - -exit_clean(1) if($nb_errors); - -exit_clean(0); - -# END of main program - -# subroutines - -sub check_lib_version { - $debug and print "IMAPClient $Mail::IMAPClient::VERSION\n"; - if ($Mail::IMAPClient::VERSION eq '2.2.9') { - override_imapclient(); - 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::SSL -Digest::MD5 -Digest::HMAC_MD5 -Term::ReadKey)) - { - 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; - 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'); - - -} - -sub banner_imapsync { - - my @argv_copy = @_; - my $banner_imapsync = join("", - '$RCSfile: imapsync,v $ ', - '$Revision: 1.350 $ ', - '$Date: 2010/09/06 01:05:09 $ ', - "\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) { - warn "$pidfile already exists, overwriting it\n"; - } - open(PIDFILE, ">$pidfile") or do { - warn "Could not open $pidfile for writing"; - return undef; - }; - - print PIDFILE $PROCESS_ID; - close PIDFILE; - return($PROCESS_ID); -} - -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 exit_clean { - my $status = shift; - - 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_msgs { my ($imap) = @_; @@ -2214,6 +2225,85 @@ sub select_msgs { return(@msgs); } + + + +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 stats { print "++++ Statistics\n"; print "Transfer time : $timediff sec\n"; @@ -2237,6 +2327,8 @@ sub stats { 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 MB\n", $memory_consumption / 1024 / 1024); + print "Memory/biggest message ratio : $memory_ratio\n"; print "Detected $nb_errors errors\n\n"; print $warn_release, "\n"; @@ -2291,10 +2383,12 @@ sub get_options { "regexflag=s" => \@regexflag, "delete!" => \$delete, "delete2!" => \$delete2, + "delete2folders!" => \$delete2folders, "syncinternaldates!" => \$syncinternaldates, - "idatefromheader!" => \$idatefromheader, + "idatefromheader!" => \$idatefromheader, "syncacls!" => \$syncacls, "maxsize=i" => \$maxsize, + "minsize=i" => \$minsize, "maxage=i" => \$maxage, "minage=i" => \$minage, "buffersize=i" => \$buffersize, @@ -2340,6 +2434,7 @@ sub get_options { "tmpdir=s" => \$tmpdir, "pidfile=s" => \$pidfile, "releasecheck!" => \$releasecheck, + "modules_version!" => \$modules_version, ); $debug and print "get options: [$opt_ret]\n"; @@ -2399,20 +2494,19 @@ sub parse_header_msg { $val =~ s/[\x80-\xff]/X/g; # remove the first blanks (dbmail bug ?) - # and uppercase header keywords - # (dbmail and dovecot) $val =~ s/^\s*(.+)$/$1/; + + # and uppercase header line + # (dbmail and dovecot) - #my $H = uc($h); - my $H = "$h: $val"; + my $H = uc("$h: $val"); # show stuff in debug mode - $debug and print "${s}H $H:", $val, "\n"; + $debug and print "${s}H $H", "\n"; if ($skipheader and $H =~ m/$skipheader/i) { $debug and print "Skipping header $H\n"; next; } - #$headstr .= "$H:". $val; $headstr .= "$H"; } } @@ -2480,11 +2574,26 @@ sub string_to_file { 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'); - return('') if ($public_release eq 'unknown'); + return('unknown') if ($public_release eq 'unknown'); + return('unknown') if (! is_a_release_number($public_release)); + return('timeout') if ($public_release eq 'timeout'); my $imapsync_here = imapsync_version(); @@ -2496,17 +2605,32 @@ sub check_last_release { } sub imapsync_version { - my $rcs = '$Id: imapsync,v 1.350 2010/09/06 01:05:09 gilles Exp gilles $ '; + my $rcs = '$Id: imapsync,v 1.366 2010/10/25 17:15:52 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 $agent_info = "$OSNAME system, perl $PERL_VERSION, Mail::IMAPClient $Mail::IMAPClient::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 => 'linux-france.org', PeerPort => '80', @@ -2524,23 +2648,42 @@ sub imapsync_version_lfo { } sub not_long { - + #print "Entering not_long\n"; my ($func) = @_; my $val; - eval { + + # 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" }; - alarm 3; + }else{ + + POSIX::sigaction(SIGALRM, + POSIX::SigAction->new(sub { die "alarm" })) + or warn "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; + alarm(0); }; if ($@) { + if ($@ =~ /alarm/) { # timed out - return('unknown') unless $@ eq "alarm\n"; # propagate unexpected errors - + return('timeout'); + }else{ + alarm(0); + return('unknown'); # propagate unexpected errors + } }else { # didn't return($val); @@ -2566,7 +2709,8 @@ sub localhost_info { sub usage { my $localhost_info = localhost_info(); my $thank = thank_author(); - my $warn_release = check_last_release(); + my $warn_release =''; + $warn_release = check_last_release() if (not defined($releasecheck)); print < : sets the size of a block of I/O. ---maxsize : skip messages larger than bytes +--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 @@ -2767,6 +2915,115 @@ sub good_date { return($d); } +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 @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 tests_good_date { ok('' eq good_date(), 'good_date no arg'); @@ -2780,11 +3037,65 @@ sub tests_good_date { } + +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, \%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) { + + my $res = $dry; # always success in dry mode! + $res = $imap2->delete($folder) if ( ! $dry ) ; + if ($res) { + print "Delete $folder", "$dry_message", "\n"; + }else{ + print "Delete $folder failure", "\n"; + } + } +} + sub tests_debug { SKIP: { skip "No test in normal run" if (not $tests_debug); - tests_good_date(); + tests_list_keys_in_2_not_in_1(); } } @@ -2801,6 +3112,12 @@ sub tests { 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(); } } @@ -3333,14 +3650,18 @@ use constant NonFolderArg => 1; # Value to pass to Massage to "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. @@ -3426,6 +3747,8 @@ no warnings 'once'; 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) @@ -3472,7 +3795,7 @@ no warnings 'once'; } $self->LastError( join( "; ", @info ) ); } - + #print "@_ End _imap_command:\n", memory_consumption(); return $rc; }; @@ -3495,8 +3818,9 @@ no warnings 'once'; $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) { @@ -3514,6 +3838,7 @@ no warnings 'once'; $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); @@ -3529,7 +3854,7 @@ no warnings 'once'; } } } - + #print "$string: returned $code\n", memory_consumption(); # $self->_debug("Command $string: returned $code\n"); return $code =~ /^OK|$qgood/im ? $self : undef ; @@ -3600,6 +3925,7 @@ no warnings 'once'; $iBuffer eq "" ) { + #print memory_consumption(); my $transno = $self->Transaction; # used below in several places if ($timeout) { vec($rvec, fileno($self->Socket), 1) = 1; @@ -3663,6 +3989,7 @@ no warnings 'once'; $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"); @@ -3841,93 +4168,6 @@ no warnings 'once'; # End of sub override_imapclient (yes, very bad indentation) } -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 ($self->Tls) { - $debug and print "Calling starttls\n"; - - my $banner = starttls($self); - $debug and print "End starttls: $banner\n"; - } - - $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"; - my $banner = $self->Banner(); - $debug and print $banner; - unless ($banner =~ /^\* OK \[CAPABILITY.*STARTTLS.*\]/) { - die_clean( "No STARTTLS capability: $banner" ); - } - print $socket, "\n"; - print $socket "z00 STARTTLS\015\012"; - my $txt = $socket->getline(); - $debug and print "Read: $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"; - } - $banner; -} - # IMAPClient 2.2.9 3.xx ads package Mail::IMAPClient; diff --git a/index.shtml b/index.shtml index a8f015d..35f2adc 100644 --- a/index.shtml +++ b/index.shtml @@ -5,7 +5,7 @@ imapsync <!--#exec cmd="cat VERSION" --> - + @@ -13,15 +13,37 @@ + + + + + +
+imapsync logo +
+ + +

imapsync web site

What is imapsync?

imapsync software is a command line tool allowing incremental and -recursive imap transfers from one mailbox to another, both anywhere on the internet. +recursive imap transfers from one mailbox to another, both anywhere on the internet +or in your local network.

imapsync is useful for imap account migration or imap account backup. @@ -36,26 +58,37 @@ where the user plays independently on both sides. Use offlineimap

AUTHOR

Gilles LAMIRAL
- Email: lamiral@linux-france.org

+ Email: gilles.lamiral@laposte.net

-

Feedback good or bad is often welcome.

+

Good feedback is always welcome, bad feedback is often welcome.

-

A good place to talk about imapsync is the public +

A nice place to talk about imapsync is the public imapsync mailing-list (see below).

-

Gilles LAMIRAL earns his living writing, installing, configuring and - teaching free, open and gratis softwares.
- Do not hesitate to pay him for that services.

-

If you use imapsync as a professionnal worker you may read this call - for feedback. + for rewarding.

+

Other ways to consider the situation:

+
    +
  • stop beeing a + leech. +
    • +
  • think about + helping back + a software developper and helper. +
    • +
+ +

imapsync call for donation

Are you happy with this free, open and gratis software?

-

Then you can help the author to maintain imapsync and support happy (or unhappy) users: YOU!

+

Then you can help me back to maintain imapsync +and support you!
+I will personally thank each donation +with an email and add an entry in the imapsync CREDITS file.

@@ -68,10 +101,25 @@ where the user plays independently on both sides. Use offlineimap

-Or offer him a book on his +You can also offer me a book on my imapsync amazon wishlist
+

-Thanks in advance!

+

+If you prefer making your donation with cash or cheque then my postal address is:
+Gilles LAMIRAL
+4 La Billais
+35580 Baulon
+FRANCE
 +

+

+My phone numbers are:
++33 951 84 42 42 (home/work)
++33 620 79 76 06 (mobile)
++33 956 84 42 42 (fax)
+

+ +

Thanks in advance!

Latest release @@ -85,13 +133,13 @@ Or offer him a book on his

Standalone imapsync executable for win32, -thanks to Strawberry Perl 5.12 and Par::Packed module.
-(imapsync.exe built time is )

+thanks to Strawberry Perl 5.12 and Par::Packer module.
+The imapsync.exe built time is .
+The build system for imapsync.exe is XP Pro SP2 on a Intel Celeron 400 MHz 256 Mo RAM. +

imapsync installation

- -

README

Frequently Asked Questions

@@ -100,7 +148,9 @@ thanks to Strawberry Perl 5.12 and Par::Packed module.

MAILING-LIST

- The public mailing-list may be the best way to get support.
+ The public mailing-list may be the best way to get free 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).

To write on the mailing-list, the address is: @@ -123,17 +173,24 @@ thanks to Strawberry Perl 5.12 and Par::Packed module.

- The list archives may be available at + The list archives are available at http://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.
-

+
+

Search in the imapsync list archives: + + + (change the keywords with your own request and press Enter) +

+
+

-Thank you for your participation! +Thank you for your participation to the imapsync mailing-list!

@@ -142,22 +199,24 @@ thanks to Strawberry Perl 5.12 and Par::Packed module.
WANTED -

I code new features for free when I have time and when I find it useful.
-If you really want a feature you can donate money and I'll code it.
+

I code new features and fix bugs for free when I have time and when I find it useful.
+If you really want a feature or a fix you can donate money and my next development time +will be to code it or fix it.

Some features and their time/money to be done evaluation

- - - - - - - - + + + + + + + + +
DONEFeature Time guessedTime spentMoney receivedMoney needed
NoEfficient Gmail backup 8 hours 80 min 0 $ 240 $
NoSpeedup 50% 10 hours 80 min 10 $ 300 $
NoBackup to files 8 hours 60 min 0 $ 240 $
No--deletefolder2 3 hours 30 min 0 $ 90 $
NoNTLM auth 3 hours 60 min 0 $ 90 $
YesWin32 imapsync.exe 8 hours 520 min 0 $ 240 $
YesFix capability changes 1 hour 80 min 0 $ 30 $
YesLarge mailbox --maxage 4 hours 270 min 0 $ 120 $
NoEfficient Gmail backup 8 hours 80 min 0 $ 240 $
NoSpeedup 50% 10 hours 80 min 10 $ 300 $
NoBackup to files 8 hours 60 min 0 $ 240 $
Yes--delete2folders 3 hours 270 min 90 $ 0 $
NoNTLM auth 3 hours 60 min 0 $ 90 $
YesWin32 imapsync.exe 8 hours 520 min 0 $ 240 $
YesWin32 bug fixes various 370 min 100 $ 85 $
YesFix capability changes 1 hour 80 min 0 $ 30 $
YesLarge mailbox --maxage 4 hours 270 min 0 $ 120 $

COPYING

@@ -175,8 +234,8 @@ If you really want a feature you can donate money and I'll code it.
This document last modified
-$Id: index.shtml,v 1.22 2010/08/21 13:39:35 gilles Exp gilles $ +$Id: index.shtml,v 1.31 2010/10/25 00:05:35 gilles Exp gilles $

- \ No newline at end of file + diff --git a/learn/imapclient3xx_skeleton_test b/learn/imapclient3xx_skeleton_test index f6114fd..5524e44 100644 --- a/learn/imapclient3xx_skeleton_test +++ b/learn/imapclient3xx_skeleton_test @@ -13,7 +13,7 @@ my $imap = Mail::IMAPClient->new(); $imap->Debug(1); $imap->Server($host); $imap->connect() or die; -$imap->isUnconnected(); +$imap->IsUnconnected(); $imap->User($user); $imap->Password($password); $imap->login() or die; diff --git a/learn/io_socket_get b/learn/io_socket_get old mode 100644 new mode 100755 diff --git a/learn/memory_consumption b/learn/memory_consumption new file mode 100755 index 0000000..1a4c6bd --- /dev/null +++ b/learn/memory_consumption @@ -0,0 +1,57 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use English; +use Mail::IMAPClient; + +$ARGV[3] or die "usage: $0 host user password folder\n"; + +my $host = $ARGV[0]; +my $user = $ARGV[1]; +my $password = $ARGV[2]; +my $folder = $ARGV[3]; + +my $imap = Mail::IMAPClient->new(); +$imap->Debug(0); +$imap->Server($host); +$imap->connect() or die; +$imap->User($user); +$imap->Password($password); +$imap->login() or die; +$imap->Uid(1); +$imap->Peek(1); +$imap->Clear(1); + +#print map {"$_\n"} $imap->folders(); + +$imap->select($folder) or die; +my @msgs = $imap->messages or die "Could not messages: $@\n"; +print "@msgs\n"; +print memory_consumption(); +foreach my $msg (@msgs) { + my $size = $imap->size($msg); + print "message size of $msg = $size bytes\n"; + my $string = $imap->message_string($msg); + print memory_consumption(); + $imap->append('INBOX.Trash', $string); + print memory_consumption(); +} +$imap->close(); +print memory_consumption(); + + +sub memory_consumption { + + my @PID = (@_) ? @_ : ($PROCESS_ID); + my $val; + + my ($package, $filename, $line, $subroutine) = caller(0); + $val = "$package $filename line $line: "; + my @ps = qx{ ps o vsz @PID }; + my $vsz = $ps[1]; + chomp($vsz); + $val .= $vsz * 1024 . " bytes\n"; + #$val .= '-' x 80 . "\n"; + return($val); +} diff --git a/learn/message_string_raw b/learn/message_string_raw new file mode 100755 index 0000000..25ec062 --- /dev/null +++ b/learn/message_string_raw @@ -0,0 +1,110 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use English; +use Mail::IMAPClient; +use Socket; + +$ARGV[3] or die "usage: $0 host user password folder\n"; + +my $host = $ARGV[0]; +my $user = $ARGV[1]; +my $password = $ARGV[2]; +my $folder = $ARGV[3]; + +my $imap = Mail::IMAPClient->new(); +$imap->Debug(0); +$imap->Server($host); +$imap->connect() or die; +$imap->User($user); +$imap->Password($password); +$imap->login() or die; +$imap->Uid(1); +$imap->Peek(1); +$imap->Clear(1); + +#print map {"$_\n"} $imap->folders(); + +$imap->select($folder) or die; +my @msgs = $imap->messages or die "Could not messages: $@\n"; +print "@msgs\n"; +print memory_consumption_ratio(), "\n"; + +my $size_max = 0; +foreach my $msg (@msgs) { + my $size = $imap->size($msg); + $size_max = ($size_max > $size) ? $size_max : $size; + print "message size of $msg = $size bytes\n"; + my $string_raw = $imap->message_string_raw($msg); + print "ms raw: ", memory_consumption_ratio($size_max), "\n"; + my $string = $imap->message_string($msg); + print "ms nor: ", memory_consumption_ratio($size_max), "\n"; + print "NOT EQUAL\n" if ($string_raw ne $string); + #print substr($string_raw, 0, 80), "]\n"; + #print substr($string_raw, -80, 80), "]\n"; + $imap->append('INBOX.Trash', $string_raw); + $imap->append('INBOX.Trash', $string); +} +$imap->close(); +print "ap nor: ", memory_consumption_ratio($size_max), "\n"; + + +sub memory_consumption_of_pid { + + my @PID = (@_) ? @_ : ($PROCESS_ID); + my $val; + + my @ps = qx{ ps o vsz @PID }; + shift @ps; + chomp @ps; + my @val = map { $_ * 1024 } @ps; + return(@val); +} + +sub memory_consumption_ratio { + + my ($base) = @_; + $base ||= 1; + my ($consu) = memory_consumption_of_pid(); + return($consu / $base); +} + +package Mail::IMAPClient; + +sub message_string_raw { + + my $self = shift; + my ($msg) = @_; + my $sock = $self->{Socket}; + print "Socket:[$sock]\n"; + my $count = $self->Count($self->Count+1); + + print $sock "$count UID FETCH 1 BODY.PEEK[]\r\n"; + my $buf; + my $line; + CORE::select( undef, undef, undef, 0.025 ); + my $expected_size; + + local $/ = "\r\n"; + $line = <$sock>; + print $line; + + if ( $line =~ m/.*{(\d+)\}\r\n/o ) { + $expected_size = $1; + print "\nEXPECT $expected_size\n"; + } + + #local $/; + while ($buf .= <$sock> and (length $buf <= $expected_size)){ + #print length $buf, "\n"; + #CORE::select( undef, undef, undef, 0.025 ); + } + $line = <$sock>; + print $line; + if ( $line =~ m/$count OK FETCH.*\r\n/o ) { + return(substr($buf, 0, $expected_size)) + }else{ + return(undef); + } +} diff --git a/learn/message_string_raw_pb b/learn/message_string_raw_pb new file mode 100755 index 0000000..19652c0 --- /dev/null +++ b/learn/message_string_raw_pb @@ -0,0 +1,209 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use English; +use Mail::IMAPClient; +use Socket; + +$ARGV[3] or die "usage: $0 host user password folder\n"; + +my $host = $ARGV[0]; +my $user = $ARGV[1]; +my $password = $ARGV[2]; +my $folder = $ARGV[3]; + +my $imap = Mail::IMAPClient->new(); +$imap->Debug(0); +$imap->Server($host); +$imap->connect() or die; +$imap->User($user); +$imap->Password($password); +$imap->login() or die; +$imap->Uid(1); +$imap->Peek(1); +$imap->Clear(1); + +#print map {"$_\n"} $imap->folders(); + +$imap->select($folder) or die; +my @msgs = $imap->messages or die "Could not messages: $@\n"; +print "@msgs\n"; +print memory_consumption_ratio(), "\n"; + +my $size_max = 0; +foreach my $msg (@msgs) { + my $size = $imap->size($msg); + $size_max = ($size_max > $size) ? $size_max : $size; + print "message size of $msg = $size bytes\n"; + my $string_raw = $imap->message_string_raw($msg); + print "ms raw: ", memory_consumption_ratio($size_max), "\n"; + + #$imap->append_string('INBOX.Trash', $string_raw); + my $uid_raw = $imap->append_string_raw('INBOX.Trash', $string_raw); + print "ap raw $uid_raw: ", memory_consumption_ratio($size_max), "\n"; + my $string = $imap->message_string($msg); + print "ms nor: ", memory_consumption_ratio($size_max), "\n"; + print "NOT EQUAL\n" if ($string_raw ne $string); + #print substr($string_raw, 0, 80), "]\n"; + #print substr($string_raw, -80, 80), "]\n"; + my $uid_nor = $imap->append_string('INBOX.Trash', $string_raw); + print "ap nor $uid_nor: ", memory_consumption_ratio($size_max), "\n"; + $imap->select('INBOX.Trash') or die; + $string_raw = $imap->message_string_raw($uid_raw); + print "msraw $uid_raw D:", substr($string_raw, 0, 80), "]\n"; + print "msraw $uid_raw F:", substr($string_raw, -80, 80), "]\n"; + $string = $imap->message_string_raw($uid_nor); + print "msraw $uid_nor D:", substr($string, 0, 80), "]\n"; + print "msraw $uid_nor F:", substr($string, -80, 80), "]\n"; + print "NOT EQUAL app\n" if ($string_raw ne $string); + print "eq: ", memory_consumption_ratio($size_max), "\n"; +} +$imap->close(); + + +sub memory_consumption_of_pid { + + my @PID = (@_) ? @_ : ($PROCESS_ID); + my $val; + + my @ps = qx{ ps o vsz @PID }; + shift @ps; + chomp @ps; + my @val = map { $_ * 1024 } @ps; + return(@val); +} + +sub memory_consumption_ratio { + + my ($base) = @_; + $base ||= 1; + my ($consu) = memory_consumption_of_pid(); + return($consu / $base); +} + +package Mail::IMAPClient; +use Errno qw(EAGAIN EPIPE ECONNRESET); + +sub message_string_raw { + + my $self = shift; + my ($msg) = @_; + my $sock = $self->{Socket}; + my $io_sel= IO::Select->new($sock); + my $count = $self->Count($self->Count+1); + + print "$count UID FETCH $msg BODY.PEEK[]\r\n"; + print $sock "$count UID FETCH $msg BODY.PEEK[]\r\n"; + my $buf; + my $line; + CORE::select( undef, undef, undef, 0.025 ); + my $expected_size; + + local $/ = "\r\n"; + $line = <$sock>; + print "msr <> [$line]"; + + if ( $line =~ m/.*{(\d+)\}\r\n/o ) { + $expected_size = $1; + print "\nEXPECT $expected_size\n"; + } + + #local $/; + while ($buf .= <$sock> and (length $buf <= $expected_size)){ + } + CORE::select( undef, undef, undef, 0.025 ); + $line = <$sock>; + print "[$line][$count OK FETCH]\n"; + if ( $line =~ m/$count OK FETCH/o ) { + print "GOOD\n"; + return(substr($buf, 0, $expected_size)) + }else{ + print "BAD\n"; + return(undef); + } +} + + +sub append_string_raw { + my $self = shift; + + my $folder = $self->Massage(shift); + my ( $text, $flags, $date ) = @_; + defined $text or $text = ''; + + my $sock = $self->{Socket}; + my $io_sel = IO::Select->new($sock); + + my($count, $line); + + 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/\r\n/og; + + my $command = + "APPEND $folder " + . ( $flags ? "$flags " : "" ) + . ( $date ? "$date " : "" ) . "{" + . length($text) + . "}\r\n"; + + local $/ = "\r\n"; + + #print $command; + + $count = $self->Count($self->Count+1); + my $string = "$count ". $command . $text . "\r\n"; + $io_sel->can_write(); + $self->_send_bytes_2(\$string); + $io_sel->can_read(); + $line = <$sock>; + #print "APP 1 [$line]\n"; + + $io_sel->can_read(); + $line = <$sock>; + print "APP 2 [$line]\n"; + + my $ret; + # OK [APPENDUID ] APPEND completed + if ($line =~ m{^$count\s+OK\s+\[APPENDUID\s+\d+\s+(\d+)\]}) { + $ret = $1; + }else{ + $ret = undef; + } + return($ret); +} + +sub _send_bytes_2 { + my ( $self, $byteref ) = @_; + my ( $total ) = ( 0 ); + + local $SIG{PIPE} = 'IGNORE'; # handle SIGPIPE as normal error + + while ( $total < length $$byteref ) { + my $written = + syswrite( $self->Socket, $$byteref, length($$byteref) - $total, + $total ); + + if ( defined $written ) { + $total += $written; + next; + } + + next if ( $! == EAGAIN ) ; + + return undef; # no luck + } + $self->_debug("Sent $total bytes"); + return $total; +} diff --git a/learn/mi2 b/learn/mi2 new file mode 100755 index 0000000..ba00318 --- /dev/null +++ b/learn/mi2 @@ -0,0 +1,4 @@ +#!/bin/sh + +perl -I../Mail-IMAPClient-2.2.9 "$@" + diff --git a/learn/mi3 b/learn/mi3 new file mode 100755 index 0000000..1636ebe --- /dev/null +++ b/learn/mi3 @@ -0,0 +1,4 @@ +#!/bin/sh + +perl -I../Mail-IMAPClient-3.25/lib "$@" + diff --git a/logo_imapsync.png b/logo_imapsync.png new file mode 100644 index 0000000000000000000000000000000000000000..4c196fd40b3bf14cc34d5814b1763942b145476c GIT binary patch literal 38832 zcmXtg1yoes_ckS6LpL&%_|n~=4qXx>-QC?S2tzyM&?-m_NQyL!bR#X2N=Y|Jf0y5X zeXKQWhP%$(d-gf|Jp0+t-Vpa%Q;7(l4j&B-jYvfqqJxHpz6rcUaIt|af)cMZfj2Dg zmnwR=z)uLS4Gj1l&qLYJ8yG+L_(FgAEH?nSNb93u;G^qq=i_hbWsBzT@6YS#=Im{4 z>0!(3?q#2QAWesc_7qJ8@w;C&(q#)d8uDM@2* zAyor~HfHViacAPk|9t(e*9wmwyVX1S53^kRV`a0j199BgX7NuV;004YD#}l#huAYo_lLs zYe4oAf<&vfAoP}2q_r>!kg79CcB$-lsWtec2+@g{iy$XA*%5;7GjwGFUt!u6Fy_vL z{F5US8$!#66uaW?8gMH~&+-FTn@Hg=P?RjZj@|QA1fuD#z#ZfvSO)l5$6lA1<`_2- znDUrUIjzDzBblgwaqwiaQvAmcnE%I;@ILVbeHBmL>!%BJiBf_KED}LH7E~IiObs<9 zy|4pD;{ETjDA<6og$G_%JGx0V^1qNOF8LDVJ>u^@FfUqX1P_(kQ%EuI5#@V^wYt&> zg6XjD2HcUggXUBT?9aMkuIc9Jyk8aPt>Q@jH}>^)4`PAHqy&jG>?8!Ne2mD*>(c5gYaeXT`4R?DSZ?MLeT%bLvkeB^#E+YyL<-g+AkRt8(o6JoBj4I3 z0gMH0}AuTCT>JQM82 zT!W6_0%x#pPDbFdEFmS1V#Up<|Erf08EXez82521&(XkwMv!I94m7tXJLuUc7;HEh z$0;^o;Z&j695v^XD4@>?9|gQT>T$7pKT!Wzv2A<$=kS$P+db(Kh6nl&dfmBO+*%nE zbS7VEPxG>!WE$t$^VZ~EtK&z%{%plRV;#~2vylit-1i)H`A~r@C`W1`ca)IV?$CBR z2mCh1wGP(^XUqfNr2eMIhu|7?yVRx&f>XJ`Yu2Vk$b^UuUfpe)Luz#%FJYkwma*NX z**kO^VrkIYg;>0DhQUpORe68FFq$(kO_E2WRPjLDJm80(ykXh>zlQx*@%;gjuxTtO zNK!SnV#Us~L4ss{0dKc)b_JD(Cth$u&oI9~NlgqeWfU-Fb{oh#8ORVj1TBw5&$nbJ z<4C94;5X}{`@1)J`wWF$0Vi%I+xF?kyd&t(oqq!y&6$h!x-yWU^*4&5#sBXlGZtTt-i- zyp-fElhE-+4&Pbxh;YjBvgY_B3~~O?fHYV?;r&>0vI$>&j%)oN0{{n}QoaQV_5P5_TZCFv!siUyYM)C?>Ug zKJHr>Rsh|lhYvHzaeeKaFF4U2&AzAozl05%emc8hfmoOi1w1yQI+8?zjdSE2>PuhK zZ;Mn!1EuIk6k3gN=2?73nqwR`spH*u%{xavVVVj{8{no=qX4F#j0a(R1>vQHYekIn zC(%1u8Bxl<#&0}3$q5w+dOgD|u!S02ex7R6qXP z@)h4H?+$qgc1%bo1fqx^M>%%DV3BVS5V&coP~4C*r}bTifq2&Wo57#1$LU5+DgB$I z$&%&(XS`~&rP&&J=x)9Ad^VZI9t(SVU9hjzgGX@G@! zE)7m)1BXJ^Ni#};P9hgi zTI!cNKc9aWx+EWy#l7vdZoz&u8^e;Q{&N=?JOf$RR0q$vtSYLXWM%~@knuMa7qde{ znf|5p`{=K>{PPQ;!Hcc?Se8~gC-Zik|{@Mb1vw}cf(6-@ZLjJG) z&LDMt941W*_bTzhpiZJ-(}d4$wK4NLA4%axh%trECv|HkC6Mkt8}gOE0;W#_gvWxZ z$>IU`mOa?ehem$%tkh2=llJZu872A6TZ!S32}>kwtNp2tRrT$pFtdmVSbR!skRwJ2 zKB2Nl`Pwa;XZg+=iZEsSJNP6aKx{SLe%~t_$pS7%pOeIDTNT(Bo8F5pXId*wP>x%n zM7H2r=e7ScHhAs~p2Tm$JM|EhOcdeCjDIUKl8GNlo_a^Us#G*j64u_95V6GM9ZmuN zV0osz*k;GF=yBlyDyQoYa%+oiwKpRX|Gq`ni76U5B7$|F>(CB>ua)3;g6@Cz>~#gb zIun3f>1YSwrUg(^*dc6s7@4Nx3X)>{#wwBCkqx}MP+TrNZo=`!IEq`rKK9Uv z@?*OWse&7}51~CrKWfg$crs6V=DM4^%XP*42grq@+AFxXcMtJ)mBWqj*P6>(?;_C)$lP@0D>LnAXzH zF3Mj#7y;|aedbStl*I8LZTs@ zzegX(U}rbvIwJY-8CmcVsU=}J)61u~RE-pZ`hG$N#hEp=yWx3M_xlvlc-P|208nma zkv*(O=iwyn9CXyy-{ihliZn-?OZPA|PV~G_%Zl_f^3m-3n&oonm-H$e6emVzS*!P~ zM|#nSdm{=a+`IJZKN|vmO{n$rpm$%hgw@{!;ACyTl4tHOI%{1PUu<6tNA5(6U;a~D z730-CEZcb>FzeH-#AyK^p4R;Et%zdN|BDK0UY5^10)BDJR75jNUAA#)hLVSdilNQ{ z7TFUtl6g|1l-SIO`ccO}gobP(A)l1}E0`Y*-zC)9q40Y~-!>kB15?h&n&o*3mFr#- z8b^CO3pS6&dvWuTz(bIOP&URw5de{N9wh=`frfIa1UB7tX98`%k;_Bn`lQHPWfZ5o z_$)cYKO!s88dp>VJ%ZYHTUO7}NXy)Q9akx#|3|(I7jv!&TFflMr62kh@F%^*2lZFi zzdz)P4?PpZTW_Y~UTi=njA(INumP{^P+0kyE(3e{xJS6dKfJ%6ki(&sx|Eky8o7ER zZijCmRX9vO+1K*Wo4!`JX&Iy6Zt9m9zIn1^FJ>!Zw-**gqxTg~h&kyWH`NPN0m`jDOW%2bhANGCp)mu|muzrH_XDs(EO1iLi=|sVZQf`_*$JGV$ z2*|a-lTC`q%6EHxT+?SAqLjD$Zcrnjko-XtLif+0NSF+TT5yOl9N*o@CW&iIDni~D zBdINS;GOZ-aju9>)~I}(bOcP<859VGTv!Gvj(Y_K8FN!o0ayi>j+0O$jz{aHgqP;0 z7Cj9J?AtI)Ln0RhSVF|=j@-OyRQ}>w5cBpo>Js=Z?-Y#B&Wsnp7?>+4bk z7+$0ZAg^Cf|5K75fA4l$hP;-EQh;=z87UGSVj-nM-wsojDxG;H{#6iO!ElB8=Jq>R ze|PXyI;Dr+LEqlckx1_gHoSzs8VvIbyKsNTn;nGfu*aEak|S<*m_%bZ7vnZ3?6z1i zJ*`@4CbQytO+Ru&{cL#Aic6!iKZNipI0Isn2UG9P+rFQeVB*a?d>NofyGjOX7Db)A zHznGl9gC*mQgS*Ds+raC9?2(WWzEtGp*jVYErnenY+}*p1mPFkyt*nh?YmwtAd;|w zTtwl+C4_ckC_`v_=|-=rc~gbA{cK#=^;fL}ugqOdRoZ!E1KzjGuLduB={AcPKoZQ> z3?*n$0$blb0-l|)F{_2*ghcpPFF7!IbghL2ELq=b%Gs*eMj|!)f(ywZHWB?Mj`;#> z0fA=0@&9@MihA9nNTvYMfvk&yuILO13E7d0RgP1dd7gc)>UsajSe48a@+CDAzD(6x z%dYh^Uo09h8t{NeRoySC62dDjWv{P5r@iE(O}IsKD{Bq$D!9%_q%X9gnl*8PVoDGE zCf`$#f3TGEgsEoORys@E$xaQfc05KEt`3__j&#zOG5gargQrF$+8U#l&$>9Es-))L((v7HzmI zUf6&;&VuN4V%)ijK8-`3Z|jiJbo0{E2g&z(<{VCrY%zoK^*PX2Cwm?;BtBJ9*Yo9D z#(R?jP3KdC-jOu{M27tU-|jQ*P|VLm_hoNpV|51!^iKg*PFKH$j^8UCRhQO};S-keq#QN>Jh)mK|)sg4sF!NjQ#O(8v+s0@w&Dpudwt753R_#wA(qUcIXG-jKKLh(*$$ z38Jd{z5^WVJtm>=xe}@c&oi+()fFgg)b`|as%3+TjPzrhnIr92&2$9Spvv89mQvHA}i=JmvcGfM%|*r5`&{vtIw@PfB(b1LRHxD(}OkAIp<9+siIC z7a2?!3OFaESQ~dYYWrZFlD$dld3U4Ucy|8frESV~O|N2D*E(h%uCV@$xs*1!IZU|) zw#W(2g8!{L;d(jt=k?n4?~^rNxbJQ%+qXeQfN+n%f-`H zsxE3#D-JB<-YVso8~OPm?ahZb>mhb_M4IBi zUEJC{1-A+xa3p>H>N_oaa!dLS*-sW{Pa}PQ3Qg^UPZ|YR5;qV4UU|JF%xBP8d59m- z0U5G^Pa*3>pk{SQmt+)HTFtucQ}FT9m;R^~tCx9hChOhK1(=KZt4vnfl&42WdY`tc zkuA7~IB=F^LF)7{JJEp7P6@g2s4Rs; zl`!@rG!a5WmI!RT6>-HDg-@5hZS->H+;|PfK0&m><$`a;?itvkLher!cCP3DQNU>Pky7J*{ zl^Xkbl${#_`~A+cxQXAV|7LR7#}918aRd39<;!1gmP>Sqf*D)T5cc7v|5unE-j!MG zZ<}5@Hn5yU&g(O_KR4`LTydhVK>}g7?#)-5TeQ;uLh9=O`-X4##ppcXV*YY_noG_r z;63?F-AaC@PIp+-5E`hQ8=PV}7Py<~(@p>t=)28;3`ORpvQ^*rzl%Q4{+HArz^?xC zjXFb=7&iGV@2DabNxbq)B4)jF*41&QsV6i~gv4GZE%XJ13*pXMFNlE!A&^Zg!9UgP zsoTXFsTd0BGZU~bn3)w?D&lw~h zUM0U~P#GeLOn7N>#>RiJ;!4DtQJz3F5f*2=JI5@@2gAVQF5B&Top;@zuv>9tIcvk2Jr%? z8K=N1{fTlN_9!Lh(EJxs#JaJrM3s2;gyU9R#d}jsDJ+m;mJ<5|PZr)_>>6DN@ASVQ zKh5tnAil2KPt7Fa%eHMS94v!#5_LuVeg!a-q>1w}Oi2qcUWR~K0Dj3H$NW_=(I>%h zYkm_5wz%Pj=SO5KWZf$9V|?F#syYDt=l=*b0Prdl!X^S2&9TZ!T_p0^*s^=3u)aS1 zIrtLfv+GA@Xz0c$m|`+H`TY2(o6qxRpZaL0Vw{3l3~e?}x%DZ#HIJBoYAyPYM|6E?dP>J0sN4 zIVU#d(v!7$*XO_|=1^0ze&6{6$&hYl7@pJL>pQn*m;1k?U z`-^z0GfFtI=e;azGy0U`lsoSWnU{cE68W0HS7LlxS40l_{cVAXLr5sM^S+@B$wzL$0uE#e3F8Kcb9dihUKkzu!Rc_2IQk7YIXYYZdQ1~8T@@yNePh^ z{Sjg`4*uwoqea0pz`GMVOer(7h+ZkiFbbc*Qr@zsZ=~IOf$=#Dki=& zrg{~b-G^cRGGlQ%lAGv9SkSwgyheM8uG$!hkRZ&`tF{Y~RbJ>_kE;&kgkN#Ag2+^C z)oyk9DZSpz4EO|Zvr;r?2dpDiDJ0bY`i}n8mU(nO9d4QYb36$=N#swo?X9pL0~xc- z5584{m|^!_H?_H(aacbEm!kVy{0gV4|0d!j%qAC(W!g$y*ys>(VTz~wGtxouhgf9tnIMpqUdJIX`lBh@$=bu9 zI;J%^wN5#~y@-U^@SsG0U$XTfx@w&&m#&-nYE=7@weSYmmmS=ouwDqR!wdkW;k>p< z*VWP4o_2gnZT3$IU^leMa$$KQL%fN!-b^GiXBg$>3K_bCsBne#Jg>#f4cvaZ&G%d% zKcb=P<@riCrw?=dEy+3-k19$iM+uq|tmOa2TrswdYY(>_enF0*gkO8C^}IhgW>mav zWgD8drh;RD4Bu`K`O0b={%dd&vHN#43~-bz8nFZ79I-<$_1MZgew%@E>FdAFdQ~P3 z9?$Rs`pUsI1{mH5ODcE{*sJ|co;^{YXWJDix$O9n8W$Rh|4%Mun?Ql>{T850u9?~| zN(~sv9{A!0%vcBcATIGy-ArpAY3$ITp>&rg<;to{)>KpV*R-H{Jn7iMpUFqbQv;)n zBMQ_qBffJo8Y>;80PA?;=)PO_Nx%BL^wqkQjqL^nG2T%P?6&3B&sIW5#WR`-+d8MS zFj3|CwGMNzmJo7O{A*->rwE3#f4X)iLo?SpKtV`L?+7=y&8zr0ypio zZ4?j1A*KnLF2C>h2_I^>YV!3PgIjw4-fDDk>PMv1tF|oW63gYAzh&BDAeEHH?o0w| zOtqsb5L&(?@4l79*rFXFNoZHK=`)4ga67ZpngpD9WjLBwit%A^tP!4r*_-Jk? z4?~A8#Hnlty3s5)3LTY5$-ZY%gZKx!X1UJ+dA$=hfqG-J-MAc8UT(Vn z*N`)MjirM|;0znj?nZK#2_+>RfgIK7>APpRnptd( zI-l6OzHFFjxxC1FEn^3Adlc(T9>#!1xk*$xg7T;VUr|Fr;gsU{)?>~*4o=KxxwwG&tJP3dt@ECnf zU|`||n9GY0R7^{B5@85=R|L7)#D}qnjV0-8VsJ~*= z@EoH!w9RFF?_ORilp`A4h zo48uY&%1GkG(YKh3grO)07NNkjEYigO z3CSnfxiYzW$h1a{Z3uz-uP$Bwo0gY)er4tyacEM4_4h!~%n7D!+cq<=`X6ZYKOZwI z3*4wbHbM4F6HoKd6V)L-HVaWXp_1()yW#qtG#l zEAU;Sw$*J{o+kYF?xSk8$7Z=w!1#n3znKk~0;XKKo_}JM-2cx3ghxkr9`rEI`;IfX z`ucZB%JJkM3e;{wZ6#5CX+JkuA2#5mUbvwfmn!P|4qms&n?w>GK! znC`Ye3;^RB6mx_n#T-qk&gbVq-p#@1&UU`rh##Jn`9noh^Y>+Ec;?86OF{4f-@9&+ z$QjMkbiQHF;7okQVliRL%erKYp$Yy3W$1{ZJ(2p-wlvgqcg^=p1TTv#EA78l*cor{ zkFS7kOPnU{!+THm4ujSXy2J{uwn|<8)EwbKbgG(i{8U5kPoIiI-dq2-b8hMy!H!4R z%|I8y|Mdc_W)7n#1IsptF}JE+HB)0re{!lcQ9dOJ8eiLJki-&M}&~TiOVMEZaE{{6+qH8udF1K^0W4?VTXNq*W=jXke=?6(MI? z3>HHp5>OGQCWYFOy&zF{xOJBekB;_eTdU{CpnQ>5BPlVu5Ou3m__o!O31p{BpkC5K zf3Cn*F3cRl;QQ5{|E;9ih|1SE1;REXlL9c9{GXxH2iVye@=?ZkT+W?_XP;dShf%t4)W z+biN|Eat`ppC(aYaHMCTBvXzl)Y;|LA?sS2qi%6?iftt&utg$n)^FM|9z~cFE*CV_ zO6l5ei%l{BJ`n&eIr4X6&Y&nH-ShrR%wt?8B`wcH5A8kn2o>CNqlriD35#T{{c}10 z<@p2ws}yTC4mC#3iNBP$1e$pf+Pid{lN4PVFMfxk#H;Unk=O5FXI<&<8+@DD=vjjU zW5@5F05YqEpj#+?K20JkN*3zdIfXp3%G!2@tbYs;?l3*5@11b*`>)J3!m)}pp^#ss zH8wBjM&vG*Rlcq2A&nuMRa0IKB705hnT0dp&F1eZD<9BAK{uELaUo*Z4kLr>S~IRhImkxJt`uEN%)uw zjW2HtXcU`Cp?5DJeOA(bVr!nCVYe@!;e<_ET6s9BE9hd;4IDovB^pnV`M%cp2Qkf} zn~68$ANNLZgPZQ$c6Cp#4k&=~*w<3(-?K&!JT9YdO2r#giO+ML6NZb6ZTgbivy&OM zp0aN!^S-UYvi$qEh>P( zE8v)|&)IKHvUHt;kcqt`286@^g+ggiwpq-4wQRHgl5g7{ znx={{J{Zge_KJmt5OJf@zcOC%ui1uN?h{mGXKW}Jt7R=qpN<4imw6g6=d>#HRLoRt zJS!O?tcQK|PHpMHUXGszC|YK8n#C-7(HUhv|2Jjmk|cfLpReI(JGjtXQoRYty5wqG z1fOvnUXrNJjIQ2!C!(O!E#8Poz!e-ty6duQ1}bOrkP&Nh3cdZ7O*qBxj?*WZn(fH~ zUV_+2azMhxv2mm6^mo&P=pll zRLd9+#p;NSfCV)nvRyVI<|!%><-@-v7fatG8W{!^Xe?ut?Rx9qBgcBby7;iN98L@# zba0~7ma$`yJD$j(P9zn(ibQ^e*?EBJ2OM0^IJcyJ9}RV(_f4MZ$zIYWq0LE}v_Jnq zE`HZw4Cq6viH!@y;f1Xb8&(c<*QcQ6TG)?I3i^FXH?kAFi2-Ir~GiOI8=4 zT!5yL^VRB+2f2qK-Y!Uh|FGveOW<=6q+DTrC>;(c{tlxYT8i3s4UzE>I^wRWjt*Aj z*+bT4C0x z9&hsFobaB!o6QPj)@s~;;K^5zkO#g8%mmNnbj7uez)A z!{s|x4pQAbOdQo~W#eSZomtm`VwHM_xdZ;u{NKq@))Lsy2)g%_VizhRzkAC&LuFn; znRRC5%60-0BOcCZE)$6x-A+4~y0vF6BebMT)=qL5kFP6Kn_S2_5<<$5yvMbBK8dxk z5)Ssc14Z)Tzj#M^uz$<;Y|U1{-s)Z^C1t+U1x4L<^mxzQvfL;|n3{kNCf&DTA&K!#3Ix{P<} zz4RuCZTdTn3`|1rHWIPy!5io~RpS%rxf)0UPuDxBDn$lM(%kPiA4->Zt&dNc-vsZ zT*27QA+zkQRGQ<9_xfVz(FnNj3U)88R1NU#0C`tEH?0WD+U@Q<8l5(|)yEpsuV# z$~|sCe({|#%4Q5_68{afF=scLbn5w;o4Rl@;wkJn`E+ocStVDrU0Lt zHS>eG&DtXN_Qso5-<}5CUvXwjc;nw)GfwQUs3oPR>m784lVxYmAS4^gcIrh-O1*=D zEI%1&h~s+XasG)ry6CS*X?ao8j5lCKwPb7{Zhv=a@hgf-%1BvN^^@-|6QCp&`|cL7v0teT{%rN$wg10|U#R#6+1xg=u>Sk2n_ zy2ct+T+DXRcIs|pXLp(sep}_yL|3B&X~EL4`l{z*MQ5kH=Fszagkdtj>Iq_{H$BrvA*m4rH-VmO3h|5qp6dOT zLT5F{8VUt96HT!U5>;0oeh82;Nn~Z{ZhLx^9Dhm+P!~ZDL4Gcj(Ku!}%KRcs(j)D3 z>uDeVjg0sbt%rG}=k)49FT^3rqQy5%;E?xOz7)xyC4aTqcch>e zf0E}U=Jzi1b#Ti6WUUsy@c~lcYBYIrY4Bx;QG=7(XVv?}%27y43Ld%JqZ-$G(2@x7 zjmRtFyVsDIe%&C0Bs9Doplpe1f`BV8fF>NJYj%aJ@B>gX@px7K{wl4b*?VU zIM&&E=o%z64AZA~{>wdyzRPUiz5laYoiBg?M>9}>_pr;u1ts-ev)jq-fDnoOObq;rx)CK zf41Ph03Ezi2Q`aWG^?xNDcq2&qg`Y6rVZi`vUczXf;4F-1l3`psY3|Jx2+J~bD|%= zY!}sDN#f>OjSzw0bm(crC4bxyx{+~+DuXx=Qr%=KI&kW{`8mVeJZf!-j*g(~!Ucz1 zI0cWfpVm()zaqbVj_EH8dG4L(WZF^KM9J1aYkrUqzp_1CHsvh{`Nc{TsmCr%m zaPyYgtDB4b!7<`j`7>mE04?BvR@ixtidfIL`ja4V# zUGoL6q~o+3?ef2JEKcp}?I)`*K20MSV%~qS^h0!w%T%y(p*k(iBDEn2C0ra7`M4|n z2(@0DSve|;_ALI-RuhF8W4C#v;sOKMMNJd%pXxLq+INGY1HHXz)n@HX0MdOhZcG~( z;SMc&jnlk5hTKjt^>!`@kN&|sd-(4zjUF=%2b9aWmnRufj4j$-pxNc(ZIW3h3w_%3NkSY;ZE_m2JtT}#~HsfaX_lK%1?S8yGXt`mix z$^jQtqbxXiN^ebeL?YaW7i(~k>#Orz7N8seRnG>!HfuhhI@`10E@zgGm6@Kdo+~P| zz4G8fCvx(9i&FV{J)3=|Bs*Fu8G}PJvx>T(01_QWJa%z$U7OP%;2O0mwt?%nh+!8 z4ialt5vm_IARW({P8n2GJM<0zSa760GM4NoQxi?;v+FqJQ0Vzi>t3H801fCKrO4$& zX%88-#ExzdLr=i(M(m&6mau_xM9`&XlR*-l2pynXzpXNjg~Q>dd*`+<{QMZ{M4bAo zOcx%56d)e+kZZ}{?#}U9UY(HSCGJS(1?{N#94@D2@}vODw{lLzXKBZUZv<%^qkrBK z#2oE6DqsYO!IU+iGSv)?c5#@UF@d5-l)arkyA~~wcJkGNaZHlc15ZBV@~T zx5wM#9CDEm3&M$M|$gxvQt-Q@c_5)hmMD)Sz-tSUI7f})it)jD6HVch-8z550{ zsR5OP&Rjx@c|7t@`_)XDvQBH8DgIaH?Vf`9Ha07EpE}VaN zmNG-+p$pHsl?%h@`LhnfdfntRX^*I3A9Nt7Aj4R}LY{KgPrPOG94^k-7KygDqpcAH z!>~`CS6Za-7B~;>((4&luprJ~dJ!nm-zWjI<3F4YO%Z4@hESjZp5{B=tsMTb#p^47~efv2M^{=~mK1PKFL^Iu%gYV&U#hXzVL~e8?p#Mlhj`+Pu`D@Abc+;S3&O5VACG-um}IL*Qwl5udmZUSGsB#z)6;1AW=2b4o#1H;j;APp zq6HHAF1y2R5*`?kC4Kc0Di%L*gWwMqwzul~7$-=1xk>xvpU{Z=YQaadr(m%%r`0zZ z;8chwqgx}XFpbvbGTLxw%wSH6+xi6QX#~iCrjH0DK~O|7OGSOy1fZ|NvggLogmLZO zQfqE+!iw$wuPc<Uk+I07Q@Qm?5a9;^yl0?@-Y~%^xHs)CO5Koq*0`MdRy3}H) zP=|KuhscPm5MWGxo2um5eFZ-FB0zv^fyn=sTCHQU(B|=_iKren-5t6R6 zGhU|^%EfbNs7{tjT!?$DqN!z#S#1oF%y&L0<%qiWDNyHYnVGrg2p^}~HZtrNm+Eiw zg$HKjy359jEeCw`Xrisrg#79`J#y!we@nN?)kMFk4c37|{ht^(KL?nEF@tmSv7llT z_}71jdtcSmo|#l3R}uz%R(s00z6TTuBz1bbJzyPlj^{$wwV_F$|7^q<<5b%V{9bj4 zn)|-3UN4Ngel)l=ZeZp`+AL(98bSAWZEZSdsOLlbGN=Wb8E@AcpJMRMg{sxh z^^;k9OCr5krdfM(sqd~ICHQzW0TYM#Xf0(yB7h&xpp?K2_)y?#B$thi-dZp9gSNN{ z&Xj0fKGKaFVE59vHVCM1v$rNFv`n8e?O0j_RV6spQ6{?(wG4h;=PB8km4tsAyPT#2!}rLtY(a-%EpC`C=v=S z{)#7rT}n4TY!Wo1Vv3e~-F+r55!Qd<;3Hc` z9#F%x(8U-B5uxP@>n~UB;IJM1*q$ar23 zScQnhtS(i{3YnZrkXg{9x!7OmZ}F`F_7Tr}E37AzXJKH_QNGo$omQ|IQ||sB=2VG> z?O>|be5ai9oSvHWV!+xRP!K!%@k+t#0V z5IU={6h_mMIpmHkD3DzDEmeN}!b`{r#nINcd=~_nXy8wcS zXu|q#Ju?0gq~wxHH2ojXK|TSm!cMGZ=*-<~3bKL-IPJNYfW6e^PfqZIS5-<08f(Cx ztn4PvFM;Qu!=lQ@4WqEX3=Y#PY>i=l@n`scu(XgZb|^AiWs3UvDtP;+Kvw-&ONLqd zwRXju{FCJZ&fv=f%NgXj;a3OQ!VtkMAkt{p+mU;D$4<6gjSmJbG(MpEl6DOmobc#H zD_@Fa8#UximX6O;YJ&D1>=v8U21hFUzBJy0>x5>cz+NrL`wE~c&LW#an>a_|iufKf zc=KqvKIA^Bd@0F}0guiu_7Q`Gigw-C);np?ll~eltmU23%dvbij{F`#K(=Ms)guL2 zrypq!A!pw003Ba)F}NW*dj_(w1K+=dlEe)VG;!uozFy>~4(~6%)T75Wu{CDJhk(hw=MeFd|LD7sIhG44(QEN%VPrQ z(tqGX^of{ENhhITv%E>UxTetYMs0cHmF- zfVuros^RSR$)yWOeu@HIq@+G%7HvYIEMpt8lQ1wl<*kF>A?)L?!Uj_04|CC5R0_{OjDmWYd>Qa~xCm zJz8;Tu@FcnHeugVvw|u!-UBHUfKEUYSQXw+#^EHfNLK_|v@+dVy?sO4=P=1Wa$nsY z{H`oSYVqIT9@}(<;&;d@DtHjcH$^vc!GxDNR%Aq>(zp>3cxtwGbEvP|?8S~vBpJu@ zO7VTxT*B9{@pB2Z7B?4PxQ)Ldn!V+0?r*ik1717)tP$ysF@XbmN3FV|Swe31_1|?jiszT}a*ww& zR5381E>or*6}HEXK0IR)i=`$CG!_| z*Q03S9u{%{w%F|d+Tb=8P1#>)eEnHfBS&-}lETys=s_pGR$N*+V(#7RgZ0g;Z&@nM z&Glxbzi)3#mq=gwag$v>utAregWa{;rb}O6Js+U$liM-1lCe6G#Mj@HICtNj%)PZm)#%&r~SMk-Q-kbzkmDWhb~= zjk>(rtA8R-H=5&XvG;Sg+<0!C>R{oL+>RVKrVAPM_VVpIx3~6Rtm@( zm6>f=GWrE~f`t+p)0;X%wTdlZJwWt6YA4g^$bTj#nBU z*7|JQv#~=zDI|)}AVjC(5la-+MWdAPHNEpwG-r+8CH@pL zc;bNiig@I$&ALNpvOsUjwh|=>-a=zxULLm3j_^o)Cxi8)hB+Rtxdv1SkG|u$ zQxp4RzmdHD6(=c>Nv1r&uY?7HMg^ z4lDNokAff25}zU$1_X2$7A~%ATA|s~K6<{Ry?T;*n?dR7jWqtkxCerk>i9txD(-;( z!Lns#KR@Eq0?Eveuau^mz4g`Eje7r7RL|CX{FYu0^{4w!pO=$|Cu%Kux9=VGedf+g zlEL6u{(?cdh^y-~7cBL6l`3*A$ zy~mCp>i~L;RgW^p8e3<3a&WuV4U$c1R9?iWfnd{HS*xEIu4{lkBQ!Rrmb(SVSxEhvMY)CN;|R1(jm7jUN?Uyx=TNslL8s! z3iJ|5B(A7NgiA?n*BBh%-Z%k^rGCh7kkuK2d#Xh+SixN zU4JJUJ#UYr%1oNAX4a6;o#(3lOlfWLTlX1PnzrT)Wq1Se14rLH^ogM%hsJ6wbH~P7 z%8KP+sss?a-mb5!PFMIdL}8mklISL`GJ*fO0Ca78KeiWSWQ?Y1$r^~8FdDFfn~^Oo z42}N(kEX8-r~+x*RzX@)IwhsMOF+a!cSuQ#bazXafOI!VcXxL;(%s$h4*PuH5BJCJ z;+ZpX-&f5r8Cj|mhI+y^Vo?9;#0+q?`~bQfM-e|oNtsoqthL4vkF+CIio#>VII-Zb zm`eW$+xcBTkY+M1Ss7(Cu7j%^zyBv;$<;LN;9LIr zdUztReP{|)Jla$E1;=xwV1ZyAo8-9mac?^GXhg1=fX6lfpjT#xBUpgZV6;6RDb&=e zb|&)~*Sr5oPyJQPqrvAa-kgwGHdt++GhM9py11aj<2>r6&JCd;>);41CGR$feT@7$ zWnH_SQh-3FzZ*BK=%d6Q(hP&;Uy5{Y8&Yjoly};V6W@pOrjQ*|K@fikM9d5RF4qs< zeo=~ba(wxkXSy_$i988begt7wamVwv#z;t`;ovl#7t->K<_gpEwosBiqtN{BQOOlw5CC@d2I)9!lhtue0U= z=ONu<`8-d)ONt0&ms0`J@eT?3xoE#|>-)T{;Dt-dqO8>MHLVIYQYY*qX8oc;{eQCE zOi-^zn%JZw`WOHEh+57&R#11r24xQ57z}c9j3;QH7X|X?%5~gELq~tUyaMf5+4?KM zo5yRdDq+6Xg2*?p8`=gFE)C1-pkVuJ%GXBIp^I=>uY`>6Y;ga0ELr|_?LxDpU_2csW$)CT)GWtVbKW|8`Ag2+^ zEm{4m9|9h&sQD4<_(UeJTnrJ}m-p{+wY&xa*u%gE9vylMf-FcWyX zQK~k7OsK3B55cp;qe^v!;di;Bpw3@o3z=>45KMLBNJSBF4Bwqt24#f#;8{-y5yBLjl4fNU6(uaRpN_10d3+7v9vi85_>PSB$;_ zFBW#)hOT8!?Zx!&95!wXek@Y#bVsh`)kDNupa{5j56Sq#;HN?)<3Pvw<&C!g=rJzX zzdmvb_!5f8+m)5JJ-kGsnO`=^teJm|z6i>pa+$-17dtjUUUtFl9}!F)IGAHBHJ-pz zL}7M3vFr|eBz(M2{R-6AT%FFR$9up_^bCg*+Ael2%G~ZbUiwZrQRdEs5p;fj^v!NA zzw2q25uGMaEIxhr4uPd8%+oQ|9NfF5h@erL?tS zGdiYksGP()o$5Y6kefQZ`gomte$-%54q{iJjS087=T0jfgU#scuuNX%ynwI#k_+9;pZk(?vXyddwuN3yWFepRegluq zArwK^p%7e|3j4!1fTBzLBiAju-}8qMaK|LD(@Im1rtrJOaUP2p4mt*3FS#Uw%_f^G z%?g7;BvYbA6_J!Q2rvmad04?%Lx#KKGF-M_^OXvy-R|B4aLXCy`IB{kSvnZ&(DA4a z1(@w^rn9n&)2@N*+^JeAF1+&aQ%pS{G5cZs&?K+U3|1K5TX@XQMf_4feLnc-pb@?O zujh2c4H+NV<@f`>oUA47(OdJ(KuQi?w{bS(c}l5;O5;RZKFxTUi5v(UGc%<*8y+l8 z8c7gKr!NBBN0)(^``h(bLEoV_Es-6Yv`ZStmy8}IGqj8EHD-<-j-%a=|7yHZ9_`@M zlZqnWwOUb1Q(vpEy+K1m>*$S`U}j<>+8M7ry1S%VTN7ActjnC7j#)oC8af|o0fHp0 zmBaP8y;Jhueo0hPQfr&f9+SDbd0Stf|Lu9I&cW>5$M*<-3kD#Nxt@H5(I6@$jJ%PsxDy|7~Fxt zp+`z;m?r!2BO@azGjmK76^hNNE~R+(YiVis!PMuB>8rPJ!XD*Sb{pp-DCdK$=U-)H zj%xX&BC`}pge7zK_@$uFVVse-;#_vbn!HkcoG2bK1`}mHQeE%=@<~RL3#!F1UUV2; ze2vV?^;GdR58U6w`=qarl%77p#KbhN2+vcHogMG6?3Oe?&w_-6q}F(&6GN{)6vvDa zLB4xr!Sw3q&%a+K`Ffk(8n~=CNX*PuwzdEgE7!b{fvx-X7ZZ7WqWbA>?!D8~ttdH#9r7e1>@XzqJt?KarF08y1>L~*ypcm#Vt*}&i}JpBD!1y#((h9fy7&|i!sod1evbyeZj z$B(t0Dg4^MBg@0v+XrxP^G{CTHY3EIJd29Vhks!GdeS#F?e`}>+Q=1ji+jAUvDdhI z%TVL-&Z&jW)t^r)x$Y+Ds10dPy|W2v7B zH(p5O1;L(_)j#x^fBbR1y+8a=QiGbCj|g_ha>6n{u^L_3R_K3^j*Ye68P&2sUK&1K z7n7s8JUv5LjW=2%WwU)#P8SvH5Jt!=ur*ue_UF(0@4C8yH4Zqeh7YK;v|?t@=+HW? zxHvdxR}0H0cl$D+d(MXqFy!@of$1wR#6Nsx_lMHwR%X$@(cdKz{SuQO_Ppt0^{CH& zh5NgR$1qMbc^~ZMo+HC3g;i+CARJ<%sJ=cMGID)|6-1Vnnwpfs90h1hp;1&(;6QdS zxNr&HjV;3=6N#v+lp9aLW@R1ZW@OYh-77;QVmAkgQ{2fTdduf;6x9d_WtVSM zjPQt6ETpAKvJ1y-641xwPOza5meXxRBL5(TG#sXfxla;1cuWzxAx>H@e1bVDLUG_M zr<-~6+?;w{8%+*jOiQ^vaJtt^N$Cg-2%sd_4^k!Ek29G;;I>>*2SroZ`3^oLL=u<7 zlpH8w0>sopKr^6uHZpMVIWvlr4*OAu)56&h){;8_D`W5FLFrZ)x01xXU)dr z_3}<_;hW*Fk!)XLHjxgMavRv@1b#sM^TD00sc<0#Bjv0PkJhm9zpgL&euNT9ew)6e z#t(amLYy2Ds`Sf$gp!mL&&7o~Kr41*d%MiznL$^N)9TI^kCKw+;o-~aUcqzQhy^)4 zy;Ksnjkk<|Q}E>lN1=B z+M6e5)72s&R4W!PaHlsoM1MO~lCshrik~L%&IS|=-*UR+acd_YQN1?00qZhyh`;9o zO02_0=FtFC(BmguOBbjum)#CGZE^^L@V^RYtQx`!7WOI3{ny9~D76^D889Z136C|?G#4fj;@r=D<%{zI%4h!k ze2wVuU~TUAZj4$HJ@?JRS2x)s!SVCz$*Zk9gv-c-2J9bVZc&*-dn$jZZ0(JijG}>z{aJ7V0E# zLGGBDohiiehJci8TTgF&etqB9%MNUr1_ukhh3XPeoV>HM>C@9OZpXrxy8HT~f`ZVc zQ}{Y_Q=7YP&#A^{I6K?g{NEzF3(JmvHj8D1LkTI<%RPT7v0L#@iYh9echDoehmTeF znNE{wIb+{r4C>?~vyMIE7KkEu?*HULr@guiQi4IwSo&O@EhwTENzOk>SeF8uWZ{BD zoN7r*ngNfH@KL#khlKtR8k~RMBK4Mx+8aD&WqW{4;!~d=$PNxQsi~<~Is>@`ZdTYC zv;{)b)8U7Qp9)n^c{=<;r|oaOPg)V)5q4~+5^wcU8OeQfE?PgcnD4k1n=h1FfFV`m z80C*k4_C;T?-6efcP@CODyP#v%DsE_o7|XuFL_FC@oJ=Na4<+Na|<1fnb^c+J4K5D z2~{lyA|++GJv?N(P#tl0hF(}i2#1o|zh5F4TvUYN>l@4MY|AMYc0ell{HD8mtG4cK zncwszqt}`FZ zmIWRza00_Qu&9VEQ*1=PFLE2Se=^Q%0xPS;uab)pxiQSaLAuimq|M!2kBd*puh4$A zwGRz7*sx4>1*;Lps#K2HreqJzSBkD1lMS5NK_YeK!sQz^J){EnFd&hnvL(}0Rtthq z(fxj7ncFPR7Y{;n(q-jmc=uOs{hI^%laq>Rxw#+^1J=R|pa#L&IXm9D>e#Uv4NGmdbIB=>GRn(wSXpTsn>y604`zJ!W~kv% zcwAhJrc1)NjymXut>Y!MV(latY`PPVJaf?22clnyuW03M06UnV+Xoq%nDTAXTf_ zLVLNf^0ehmvO|uDXd>`<@oGe{<@d%$ZP)->BzZEFu)do4l&%xh&opl*PT9ArOZH9L z;9wF%BD*uR2xV5P4XL)aszZqQ!@-p585@`6qqAic6@_kW6cGqEgTq%4myl5IdYcL2 zYB*$HLf)*Dc(_6F^Ybeg-JwNC8<@_HS|p3H({MSm2nk`-xpIg0_scVA@eS46d6077 z^5Ws|mz9>1ef)u-ki!=eA0J&kfC-(R8W$G_iipR+0AtBYtJfi6?4uU}B=W&Pt#}3u z*6@?JTFmCwRdqu6vUMHwP2=P7qj)4a*(7Uv>YD>|H_3F_m2FNxP}3eBx-(>viqHQV z4HJA2aEGFx;O@1?Ki{GUDFk-O6h5fz@_TV@l`ZURUoffPE?r)+upnEnwB~MXYwJ$t z{h*Z5@+vD6AHYQLPNRl_@oPLErgXm@pqeeqtk@2q{Y?dtPoo`C31s~9%1EoKxjLb`>TFF(*tU+2&dmD0os!P#TVw)N33qp_ckk>% zh>5#QN**KYY_N4q`6}<({r#jV*lhn+51>NpyrPbF1_9@NCe9lD$Gc%I#p+fHNF-Rc zVK5VToWI)$U~31;U8@9_E8XlKTqX-n8R&U25#GLjy&ez{&^=-?nD&i-dh!qGzPb8F z#F;rc-kzSTpv4obHab#NSNrT&H;}*yYeOPCOWZFRXrd{e?`DX37!skjDIj?C182AZ zmdHV24IcVX-qHV|fFyW3+Y$7cJz~()69xptjpWIlgR$+FgiqFPZGBl=Zz1P*6I4>l zo}J@9nN%35u-&C`b$zJROkrx(SIbFHkEyR0-`g)RHa59ghk?s%c%X&IGUD{7)6JdRd-L2G+$eiBtq{7WJHeFf5VSvq`9WgGm@);&} zFcB!cyw(8#>Ym}$l`RTWkk^GsFMSae{Qy>sPV){9+(^dB6uV|)SHSr>KX3j!Hda(k zO#ndPKd}xEO~3IuomtNws#qBqnvw81@IawQn{NMIYB(e#n@@K;WRY?dCu#7C zTs-nUm=YrT*qLJ(Q6`B_kt9Rj6VA_CSb{0B^cd4*9ii0!oo6+t4EV7 zDi~>%T|KT@Ad#b>z0c3Xo0w3&dDG46ay3D~UmxG(BA8QERX1?X%7PpTIuEoFOD~P|jk*8M?Igk~v#G zd}Rgl`E%#WA-}b3VVJtQI^^qYYrev=oRU&Vb~Zb}f8+zPfFG!mHHOJw|_mZS)@M0U0OoE;mKGy1MxD=g$~K0{99OZDl+HPG`K4ksJ!jG2!z0 z`fc9+s%5(G*1M&M-V4gY)qh|*dE$7yy$=VZ-WSY7_JSTJ<_yqDJ%B?;dwq%Poo4p* zln#3O8_?6E+S?by1{f=sr?rZ@#*Y>}VJpZX)2*qp*L@tv@*yb#ZEaC6hiJiN<5R4? zjJ5T6V6b{ml?nEbpFj2IE9>|kPEvs^EdUPHJcA65zNwjJS(#PS@pU|#u|aqn((jb! zRBoFTTsFZIg!bgx1{9N2N%kn83O%V;BSE?;M;*cW2DKj?8eU!pQnE~V z#Kh3RKqnc-8S2eV--Cr~W^V4>yn+J5&Hy;~n+^|Dj0yq?iLnN?9eiKmvAJ`Xo0F$q zYeO9!e;*&JuCBU&L?&itt7~0~Uqa%R7*i?W<~LSW+V3vm`5rF_q*DdPtelF;A&_!9 zlz!G+ymw&9P31fs9#BU&CFuG2p@fBVP;qfXbB*#S2X?S8FRKXnZgADqPA4b-tnTgg zAu=|$k7tLk?EQ5~G%nUIS?`Y~05l>0FU^cScl$LHYsFe@%Yl=fiy$4{feVtM=ik3; z?$3NeqgWCW_|wIq>mE-=uc@j1c^JZ@$*B=>m}e;!jLE@y{TAjN@R_NmD2$MR4@~<9 zI@6qCi%-TTChNTs7F<@k*h)&GaS4B4798xk{*zUmd4`fi08p-uLP5Ux9Rbe;p?EgB zT1*^M8xbw-LYU8OJCv}@$Vyl^J3BwBi1RPlfc*TR=LaKB!P`C&0zRAtD{eSDkHgkB zw)nr=-fEFqVOvAbh;&f(1Tm8{occE>A4$pdEFESZHT!UJVIh(a3FG4$y}VvCFbEWCJt6>hN5EYke7XM|l#(LA!BO1V+4xmoKVKPig`MrCdv6@4!rGvyxOy@;IFfszcYywvA=TmIoz6b`;M2abFOGU=d7BZB5wpm6YDT z=mhlY%^N#oA~-lWYkNE);95E+85ssTx-Livw4{|-cqS)P0gXV?@x~Ob8znC$hEiOj zLNf->6)I# zG&0gAAZ%*6=AB8W6ns7)g#8W;E90K_qy~pljIHg85#1lz@^raP7%S;%3yGxcFL%`l z&UP!guaBl5u!cX$CWmOhQvEi+um7>8swyI>F?qemK~~NROpYEHV3!CA{};y_oR>j5 zIZ=bqsLuHoc$^8++1m^4;2=0%==2T}84$kQ1^^}ackji-hynEE2Vk>Gvw9c^Gwowz z!BUA&Z}J*+=N4R64i5Y)DlG1`JD8Y8i%O{PB))We5tY!sN63+Ov-K=MgFbXx3ry89 zH}A9XxTgbr8>lmOiji4PfaOnEJMoVP#v~I?6Jf*2GOZR4Y;rWDr5A?@AWnAq5YNy+|pe$~aPSha~c zInLwbfLt)^Vdjiq}Pe!-6!UA(&n+r!$0=WQE~HrSdIL{R^K79ga~CUrts)H}`1W{a+8a4-p5OI27;k3Y|!+|2a2 zIYUorpuNpo`fZevPi8ARTqxwyEDfml3Kj9G58ZOCEvO$I1k zl2S^JPH#_rh#w;F?s(SLYs%~oiJ94}T08W(n3);(A7FSijeh)S2eRz>u}90OSzbr7 zqB548n%ZY&W#Mi1=zbWmnKd*XEUoeUf`f@;VvrMP?o&3mQ$KJ!sn_f)D@%hHX4H3f z1J#z>eN5Im=Ug97fmy(i02r6-_1uk$3*w02&$>owAC9=hMEt<;C@V{R*&!?}(i!sc>zkM$K~N&6qSCe6v7pv)6&@F_26P#3 zg8}!@s3>zYVf=%|#W$c&0IBov`hlpbYBNbtd-(ReFL?%_wNk*LxE$rT_vX91MNOb2 zfV8gG^2ABFoM~5HZoRgfyWBlK{)Ale{uiv6ASPLTj6*rPUO79+#M31$BL1JfN&NN`md97xsZyMmN2@XfH-xvQ0*KM z_z2+eNgEon&_rVj2&{st+v9?FPIa+#vMP6tImizHa86_6@0*(vo)TQVgq01p5TFr& zhg3#AA34>)_pP^UNvp0lxmQw|c}3)M5T4vr`&P))(-ZAQiU=1J@G+U;3CDcOdaS;} zGn9 z#>UEu=>FP6SWAm%rep?{NWc$U%Q10h$3Rter@OX3DJl4nc73GIausQ7OBqlNZ!kRH zwY4{41arU>L8GHHg-1&ItT;(CIAm6(c?FeSRTUo@$p;ETro5U79RLobpi)#A@&}3= zWJZka^mPSO&DNe4F|;s{ktyivx=X6g7QQYJL4_d`6H^g*=1a*MC6~3 z1Lf1h>3fPyGgC@dE3My#Qw7DPq_~fcmKra{O9d?1vZ!b* zPxzPUSZv$-;i?vH-g^K@M__F&Jn05rpuP{Rpjgc2@V=H7nQHSx?ApD)&<=%(3GZ|f zZ?DaWXjH;{-Kvc@IV3)hO2POFYQx!`l#v!NW{uUw+aBEUD?F^H< z>mTV02LTU(U_#zW+I6r!RaI5jx3Rlt%Mg19czaIQVZVY=j*mycV<K!m{ zlf{UfqPT6a09JUE<+Y*Av@y_-{q3Kf{m$K8Cj`I7b0D??^aRvgX^QV=hl7>ICOCrb zfjiubBR@?Bz{nPERfO8=h!PEc_{it?)LKczaU71lZXvUNbY|yuXr9SN11u5OW{Xec z^XE!c3LsjKPE2fPiGv?T=bqYx*i??=nN6%HfIGbHOWf{Z>-@YY$ zq-z|lLvIFiH#J4!;Gx54hjeXeeb(02hA$?@sH?ZUIbS8==3esqci&+AIo^rUWbOn$f7xVc`7Egi%gW&7UxpadHEC@i_M+jr-y-b1q1|*ni+jrj@ zqKk$w!E??uF9p5PiC&%S6ZL0 z!82${ZjNV1X*Ag9&-|-x4hLE~fKvd!5D-qiKG@lr&@*E2&9HdxYp91|vRHav+2wv{ z-ajZvNU#QhXjr2WqQgc*gU#M{U&ht#T=fnWXq`OZ0tmifm*wZD;4q1tPe6~v&{vb5 z+AuP4JD>Rkk>DM^I$SPwI(HVA2rerx@0f8Q$DpL!7>vgNRuvgN{c9H&8E}VAlz@E~ z7JwhZck8cb%Qs6L2t;Sq#j}Zqhns;=u)4P9pP7krbw%_sy6Ik~uBOJ7p6(!?|K1qX zgW~9gPS8noua7*&W*rG-pWh4Wv|9t0UL#2Y>(}eENre(!bMvla_v?`iI$c3CxB`6Q z3kE38Z{KnQ<{O@s^+-QUc6;px`aIBEqV zowd%*Z}6=_K_;gE?q(Qxi#0VKfSa4k#e0wJ$nSlU=CYG+1T-H2qr^b(dTnQZ6isei zM>n9(b{a226K9~d)fq?*79gQWol{m#ZK;`ssO=YgioQMpKnW4c*ECrG1JWRY4)xy-=AyEdvNY%+42l zV77#5mlyiW2gfoK=NhhCDl6Gu?-8RL4!e3=t;YnE$U_SSZw+gD<>zxVHrM{??uL<- z$(bjIjI);0J=e4dT8zTl{HME%&6cg>gS^!zJ3ET$X=EgPEI%I~d}CvHatb$p@Y4(o zPvEh-<PFJZJd)OD z4ge3WZD9@Cj5K*RxRh285M9jA&&LV;iz-k#Kia(nqSYHHs+E0SAl=D9EuqmfGFA*c z*VJ5pKUySSJ1%JoRSXQ&KL6)HY*#mQyocxMFUDkSe9wM2S6u9MbMwpif)!flBQE<- z^!;hV4e)rGf}GsE)$PdP>Vvq4+i)8E7Cxu>??1M2hYKx+_g5u#?oC+u_+r4t)HB)d z4aD&0vNvTkG>ma{L^2x7P_eQ)odEMW4}MLIz9A90;4@ts(dcNbEC)05I&coz*z-p| zFlyYOgM0y-yom+aJkYI^laad<9zeId@Z^N6`_~t>YsY2`2?{?2MM{J_vhzq>nUQ&R$X zxB$>x!T>Rsm%joaV)c-)yFc0jL_V?)%VDcbW*8#koqhxV;ZH2~)ozt|cI3*+m}DGN z6g-9@vu>xV;SiqvzAAeWHRH<@y~%x1D(IM1cmQme#gfCdlWcBoj>KwHo^@id_6;?S zTHOX-S!&s~9GBR%EzZx23%9?1IV`iY7C=Vo?CuWq^!!RkZ^q^R@CsB3vFvi4+0wB> zwF(4$d~CB={ya?V?cWhrU^qTNC|i7dTVv^Pt@CgbA3`h`1&q9O`Q5G7u)RHbE$3YY z=AR0vzuZ?hHilo+p36zo;be*Z+D6&Ptd4RznYz^L>A>&i#>PPS7hI@z>jIqYhq*Z* zQ}JnO%z28+z`#hwpjrd!HE^NnKq3z-QTIpz0@2#;2fq{Lx+a$bqT3lzHkf>mI*~)) zIb~_1UY45tax_GyH`*OQ|6_6AUou0-rHBEv;!1D@d=(nM5y}iFCCq@3mXmz!>hXLadn8;*t zaX*aMng48TCR0)yBLZF5?dRF*9$qWJ?nwe}aSsm_Un7Nom6O1=n}Ha?P0RB_8*NFU z;q_4oFT;Hrk^3s+fVGtNk_>Iz!6CnQfePdJq@s+K)$7g8F4b>5Ear>ol+qer5fOnL z{dn@<)Dt0q-O7(E7i%55jo4vhdkBkU!odf&_xGcD+H6O%Ddm7q`VBm~k>#iA*Q~6F z&9_^bVFO_=iH-hpjm7=z@vpuPr{Jn2>?D5E*%^za4I+9)$UQ_!iMc1tZ2RU^b8_bT z$e#_+I1nZQnwgxcdhn2(HwoOeaJuZt{qi%cjg16IDwYt&7I{iUl862_s8h*2tgOG4 zkdcwGUEQOKWk@CkbFn>4c&J3hK$WY5L`>8L{vutK7n?-zZf@iW8%P>8%TG!@6bd8~ zky&Nsbh&OL60Zs8qKi!W2N1y?>s(qoZ-$}#@y*7DELYl1On!V?>#%Tog7tf6z%Bq( zsz{$vp@l}%j8Y#d01aro-3kZ6hGrE@4tWI!hp@K~0)V52;8y$&2)G578OkSL@KxJ8P@Yi%umXmmR8P0M z8;Nve7DYLoMa#rK(arZ}`$JM{>awit!`%FQt%c3S2)Y4%qg>029cAEJ{5H5PE&l$NT65H{ez!paO`e}wZUaV^Qq`yp`m1LgT# z5D`eduP^oghEqVwV+?MOYXqOY5Vip2k(al(JloI$4q>I{@O7j?d`Jivh`VK0UK};$ z6cr`oa+;%o=eaT5(%uT8+Dd-zeE%Z1?&fZTt_-th`IJZwsV=8$vER4xcV()nuKpd3 zIZ~#_+dDM$YBDj+)wTWP3c06;D&%}S3f$spilJ4CGKdFdu(PYEVc(Ad5_xhN`hBss z>*h9eY==%y2o-wu2^uzh?R;e2>8vmQJ+=cf{GI51|Lt5DqKH5oE6dt!J@}mx0IZqK z>p8lFcmCst=I4JL-UgYDQC;7k<#aZ87dmTe({dU~_e~@0Y-~D{dE77aqOLyUMJ)?< zM6HE@fS2p-CK{24D~w99#zF0aqzf0LKP*Wc)SK?pyZthrf2|uAyB&Z;9Th(o3=NsZ z^WExv2~P?3@;ZH`LXUA;Jzr6$tPvyH~1WlV|pWd_?$0ezgfp za_l(Bm%vEA(#5JGf%6^>h1+u9+UHFGMv#MBN>LGhPEHJzYy|jEOmP8VFn)fNz)nAQ z!S@1+vt(+s;j04lmx)J28^lA!IM?Ij^K(En0xmzGQZG!4S+_psF9!HOY~yDivR@ELJDs+k@pA`tE(08D5*t<04}2b z68a2XK>{Zt4R9flc-~`g%WEWc%vFf-64TPsuFY4`a&gz0lnD#fvI3Mrg7mGNZW+C` z?$4h*pV~sY)amIMBJHRso0Q!N{uh|U%v=!1YQzny7nDXF$znX5AsAr_-GHL9*1pE; z0w}K7@p0N^UevAorQ^;(N9m-1?IBL>?`IoMot=fGG&Fc3BL9;AG4SDhWU#5FC}4hsLy#64J5fK>sy^2;^){H8+T{W^F|9}tpZgD)1+p41z1<2;q*MI5h>+tUgQ9fxb z8rmN{{8?PI={*}7D+2MA(-DuSmv)7@x{47Hs5X?uJpd9H(_f|9eWYGCgqysA!V+#X z1%*>`Vi_KO$@Q)q*f}{lTeAxdE30UqWM!d2DiqML8QDz-PP2LW94U2i6BAZ|s6Y;0 zTR|gf`L>pBAS;J5G9jT?-QqD0614@ikA!>$z0Mrw^yL6BN$Fx$RhY>&sTS|n{QTwx zngH1ac$a{e7n_go0hmQns+)X)GdxZUn4Ictos1N*3$Cvuu=$v9Js;648$zdD*~8zq`Z3!~021Q$M+GGm^|3 z1dbtK2$GV6%pA%(`ucw45Gai*k{{BVnp5;`F6S;Q%`m0p)J*J3fZ&Aq`xC!@jrPk| zs=cjEN+cQu3G74gV9C3eKM0776*?V)5Gnr2O=KZW&3EcG#RmJ+RkI7ctQJe+SahmV z-@nIU(PG0CfO4Ck-@t9HuV93Fz1b^jdf@V}7!vs_B0|kb6}*w~tZQ1hHxl_)hzy92 zM>=nl1}^uf+?TqKQ42aRa6+wqUn)XKw|=}5*|4vtL$2Z#{WT3Sm(Df zn4{X-eT3R9a{qepW>ix+IRu~w9liBmiHXEdPdYEBqN_^`e07EoAN1hiaS_3r0Sf`4 zk8z8O6_r*07TN4~$JLgcwr3jekM@80hEnl3W7=#B{L0P_t?tKy@%oTT1Ejr^GraUe z7U=Y4cDBiCi{`!hH^oIowfDgmA0X)6-8r+fTx(lf!7Uy*IywrLHs@2an<6rblcX6L zSYz|^gJHm%vsnHT6m<3)SJncL*XaxnC6SFiq(wd$T5oPwl*tWyJQ4ED} z4#3`BEIbvr}qe;U5MluKxZY)taN! zLiKBz#>NLwt)y%($ZG4HObSeeBwlK*AMj)3za=7D0zXIt;nPY<=KSH9T`573N zfXE9VD*Vm8e{iOYkF2F7d0SiRYhVE;gOoKT)wX1;lpZ(tw$t^$nU_Df+|~r(3>pq6 z`InZDOJ1`I)qolLbw4>i{@HjpnqeI-IM@bQ<@NrrINHa@i&;HIM0zk#nGk%1U9Y*` zOQkga?u)`6pPuf&I!rCKSXKdYtljM~B|Uv$WhMEN^S&shbdr?hAWe>pb^xFe;9Rjm z!2Dduo0!HpiiL0(?|7A*NnjB zR9tY(4A;A_ze8=D#?Sgs0k#ov2kmg2~{U2 z=2W*UsSfDD;#Nx2C40O)EP5lDZ_Jz5EK~ z2f-EsAXw+-qzoXM&em30ktsy)Z=YH}y5BF@y#k>}{rjtD>sxE(*k?Z*8^)6*mzK?@ zYxjWwG(E7hx)$qbORK9Vl;_&{QQPQ{aDf;4k(Rc$2v-alC`603W8iFzPfYYIF5-!a zp}4ww!y^-c`zujhKLmxSB$IH4Is?ZltE$lP8)BMVI4uvqna7rV8=r`R$jEHTc-+Bb zP!5t)8nRF1GIq|+Dw^0KHj#O&;n)J-Vj|dkPCX0_GnYI!jDx zX`gOS0n^8i@15y1Zr&qe3y8Y8y~F2hmJx18rlGY+32Xr&_?w%5oju3hv$KD|!lQw9 zb-Hd8p!Lin{-BO#8$&lx1AQ`tX{n~>9&0Snl&-i3R8?P~oM~ybLBoo%SZ|O^N)53q zHjyCFT~;<|pWUptWYuzk*M6S*fS#XM(!$+bk-o}PR;CSHl(!rlSA)q7-f?kLzx=-Z zEVEv<2d%vb(2f3n6R^9ovsLPCzwEusmJf`Nr?|Q*c65e8eg7T;nj#%t;mfD&5W&K7 z0?C8;l}7FF?(Wdz-|_K_1_x$NPVoCPEj@Ra$E!yIA#rg^07A5Ph#)bJai9&hd+y@3 za;m)i^>=Jk_@B~cbqx)@l9LfrQeH#Dgi-SGA<)v6^@*aIZ*Fr&&S*cs_sq)T2eK$J zgJ%Chx$yzG$?ba5c6_tqvy6s^2eG}N*&0$03=M6n?srcE*oSRzdgvp#e5#x}@)|hk zU`EO+Y}z`=JX>4kLhvv_o=(prmIh8_sn*H{htnJx2+H6|3ZAQj+en}lINZ9$M??sJ z`GVkaJ23E~@9gX-4JOs8n&RPq0`n7EUq#*iPk64g6A66z#ea|g4<~?hHJfGz37;j< zHpa%nF$f>IE-&p&=Pv|+x&Ct7;+&h)e39gX4hlTH%gv#M)I4Ws5qJ(mO?M*BkGfLR zld00zH}v?@W`BPlaL=6L;-IxP*Wo0{>e=Q5D2_i%g@qhT<3R#-Rc`CC zwiiev<`>b6MUn&ffPHfVy>>_#P~-55lG4z@tp(gDN(QV*PFeZ0s3?4B=sUN+Vv+B; zcu zSzKs?D5XzaD8M=hs&OCzOcET3mG#W0WeyHx2UjTx309Cp0{M>hi{15&O#=ljE$g1; z2Zs#BJs{}&CN2z>UY(rujExaO&^dje(_095tHX=b1;JZ->tX-SgoVF=`k3H!uKeAE z_R8}j8g2_VgvYbQ-UOod%{hDKH5~*&zwY`mb7-h&US;}qa@!&Jroq8f2%;nDbF->4 zx@%ftgu&|va|#-D+ZSrvuU=t2LOu&AS_k&`mkXq-O@nOTkQoj@J+*bWYpbi_4GqNA z)x)~(Wh9IK)zutV2WsGPhJ9+f#>w?&v~2ml*|G_>((ml7hIB_$n(RW*=fAVfd#$Pl ze1Y!>LABdXtAy z9A%@UG0R>sD`ZYWQ`0Vd1o%D%pko6vFqJEnj)H(T=<^E@Hzmwv77W#9>v2J30h^Ok(8@#_wYeu-BKLN$z@fL7%en^x z)7*UNvzVYTs4h&}#tcV|2s31D=f-V2L}XqJG?s^S!VVN(+nkdb$-YOZ_{ammRK zJ^+9bj6EU?fU}?9z8kVBFYopON7C);9uE=}6tj~!s=3`-=W7m&r{4z$;Ma@p-0l~z ztjKkC=JAHk&2hi8^sN_xuE5HNs=Y_3&ChREDVdq!{DJaa#?@6A4jxzR$ByI0r5&s1 zao1D)!Er`nafzdf*3@6Ud-7U zA(k;Uv#>CryL;*JekV;}Jli}hW63h7nf~bDfTCFigUAuoQSe@&mqp8Ch_`nz{}WT8 z>_;44d!83g4p>o64h_BHUw+a!*iTYYYWMv$`!uzTuT9O(!OX#enL{ELh*|BR`u_cU z-fF*{ij>q_W8=Ui-dJ(-BQZdqB|@P^r57R?39=XcJ{HJmFu_Ly0TiCw!q3239jRDdivhuNJVGSQ;2+T0XT zs-C|7;AB2C=ud{@S==a{C^bM=)-7mxGGA))Zs zUL0U3g5+75A1yHtV1L|z_Y@ZDX*4HwRhiTQ#6C7TIl8|v856^i{K0L1i`B>|oI$J* zNQU613vo{vAt^0w^n>eVMDfy-<*1PMGOCJ7s=1WH!GT6+1jDMAoSfXCiguF}@Rug1 zl`n5V&J=%ZP)%BL@Mn8_H_F^HF=^Z}V0i|yn3iIwoNSXzk6n2dC4aYHyMXb1{@SYw z#`h7g!(`l&1AmRvs5Hhm4qYEq=0UrQD5FGsA{5&El0V`X!`YjqwUKQ|=MVPMb&5Ybv^;LR|ZCOdod zwPn^o27l=z?}&Co-K~x}LzpeRh|JHu58zl}V>2YxuOIidwleAJDl>aLbpQg4V(I%R z1I;R{tv#`haC3K=Vv)Njoj+-U@?E8|(fj3Mr0VR3`Ova&TlW7hwGF56OG^){1qFj> zHubSWgRG0oHp8-x!y;CTU5~Mj4zfRrhs4jHq(H^6I{YSJXE*gSrfT($_f}aFIO11F z|5}SR_j^Z1n%8s6dVBN1?C4GxW^1}L5lIr|eK-G+cWCuiLq%n-V5R_S7Tv|g?iK7? zQB)!#-}rc6KU!?tzEFI6plNzfs)%PGy2oqTz4SG0}Z<- zaC|(4GZYsOkJ;`g(%4u5_)SqqX*@+N&ed$Ikub2Qm=&PC<+RI8eYnpxk?l^E-oLJKZ1ZE}{d068w z-OT71*O3ucAxTL#z~sqHPd^r`Cm_(UFpjgf5ufoX-B-flp`n!kCAS6?8WA(IkzhJR z#QiHNy#jDaEblzA8^(@_lYI&ZIumA?8VVB)uay5&nkr!}UjcFj^pNiUe(6j*M3j`E zpf&aRKU!&(m7eqSe+8Qf2nrQ87Y})zR+3@+4iiORd;sYUPC^xT5r3IdP7tq3>G<1%Ug1(#o z{F|FaUSfkIA_mTG?A6{Sf-ky)f(-zH;94>XlOjK&ZklY%2^IGFf9Rp%GE`y<{udWhYX7V$9gLtYyo- zC;KjBvS;5%3x&ZL%aA=$k|qs<@AZB2XMW!IzW2Q6Joh=zb8fhDxI1!C)!517iCYIS zQ&!H-WfWA@{koo+i4Ae(b$#%_@ATp2jsmK8oItpt*^f$sYmCe^R)SD2Zg0=SftOa&zDQQxp4^0R~Jo02v&{PATlYfioMM*(s3+Xit->rVg~;mA-i#ZgK_ET3y|0 z8TJjh`vK7fkoXXhnB3bte)`}R7D(M&oOJe<#vU&~CIIpDadfnz>5n+jsQn3=uQ08O ziFsd#dWQv-(gpcuW31R75PDw6!OBrlZJ>sd4!Tr;(aYa08{i8mkO*w1=I2N7wea&G z&ePJKf&A|1sAq02d&&j?j@M>J7Fa6_G)@A6h}p-M+R}o9Bpxnu8weIaqgM=&ehds; z+5rJDkgfLZD+QS4rl!_@EIJonlG?e5#gZrSf4dD3;iaXv$rBwwZm;O$!U-^ih>A)& zm{??NYdf*EF2M)Hawxa#lH-mSAD>S#S&wyBS6>HgPE4t;znPiY_=@+)=UO1n!R0X(iNY| zM-9Im^&q)k1%4*~`HK_m;J~03ot_3(SrT5nSoHipX>!$G83?ob)c7_V>OHrS*|>34 z>}U6EMVtt8EQJ#PKPDhwIrx3CTv8G$KX-^iiFRw^Pdwv|=Hksg4}$^2x-T?=`yB;IzE8rY7KA1Y zzXXNYe#a~%?UECE2R|cG4kEdxCK)Wj<*v?<3235*fW~;&N)=<+$=DY|=cJ^gFnY_H zzF-A_Q^AG(7?Gq!_l~I6e~ID@N0qO?LAbeJfUywOT?U&|>hBP~p1a?1H?YIQg*iD8 zptk~F0Ep`BL;|Mi=Zc=?wE8ljC&6JJd%L_W5A;(A09>C^obIKSo#vL){TI)C)Dw&m zeKrGJdo`y+3L?VcU(dDD8iq?cQfE^~hc9<)z<`rt5Ql4#X+=l-O`o8hoDwgQhIJwR zv>OK`SD;_;_`3}-$Ec}!h7mw4l9F9$Ggm;IJ*sT&=upVaTmt~+%jSewtJm833l~K8 zJ93p?iq`v*lE4xB7tV6=U-a@a<$tmIAp@~@N@0M%9XHS$rS}F7xUv}K&gWF{ zUM7z-7pZwC1yM9yRQpFA`rySGg(41onrj(`fTL#EGz*J#X!k6Qdh=!_Pd$HR?F7AJ z7c{5%R+V7kA*-rJ+ukMZ)|ZsYsGO_nEHT2S^1A%Q9(q=-bIhr9mwWc|_d7Q( ziCWv_2&Uhz?_Qu}Y{i z99K?YZ?ntcRX83bcARKU@IV_OF)D3-Kg`t0tKJJ?CkhxeGt@qtC=kg&vqOcZwu}(` zN;5|5L(Nvi=YpkW+b2_4c9V2EwmN@Vy~%YkCoe&;sF5$~kAvs=&BUkO*K_&JzVDG= zypO4Qv|CURUp7%AA#o|YprBf-{d&gmPhopn+JV89(kW8T?!U{adeaUI70a-O)_-|# zyAOmlj{czUln<%Fy1I^l;&z9d_b_jK{JtFNX>z7?$4!RuM9F2#l=44JA54Ro8HDvW zYaLYY3$P*yz4#As^po9H#DzF#1M$o^Z{|8jDHJmc%lk!JpOX<6G(r2&N;2NxzfdgS z0hm_{W@aicrSE-fUk|FS00*`QSed3;6tP!c!nm)O4 zfAK4(XKN7B$Q#M}60E_g46Yt7QC@f}3#any1C Y@Dt3N}+;ss;*4%~ z1tH~}C^ZZJy}0x*fBjzF4{aM=U4`B?GHPhb5Xg5ZH+K!a`$T~CO%mcoqclbLZPh3aG{IzTdxTj8BwEWC~z?(5E{9)#wE6!W)cx zp@NYNOMeDddbL*(olMqu(DbSw18-~0bBon*dI#E{b2rYD<>07zmEAf#Q3#b8Qc^_nj=MF3fO3pq8kH(BNrBmzjwQ1H-!pE zz4q1%+q^g64;!nZPed;!dHtBJ3g z@O21q4znXK#jO~KHVzFA^6_hQ-{&@St(`-v$N3&pv_aNnJgag!Gw$Ja1a9+Q!^}%0 zQWnlm>*7utUkoc>ww-%MoRBFJvabv`tqRAusfHb=kBpQ~TRhE>hSNr}TBZnv zUZ{jGB*J!C9wLbB8mh4GmpE!PB6g6jOff2%aEzk-him2g**OQPS`XsZ)|47%GHTL2 z73aYS90oo&_7R7zc6*X&xoJeO`YrWB?P)n5 zHQSK9QSf!X;Vt}1u=>h@H}#!tBbX+GhM`6gsJo&vnqX>mBI0pqi!)mvo8jYoMz{%WycTF+im7_GMcB16Y=!)`d33*$3meO1p z-t6m&ikh-Peo|11<`y_3VcA`f zQxT}o*tp!xAb1e&Utju2<>(iS>Yst~fj!uGRuQ%aIP7SJ1i?Oj^CQ>#}Qe$4ceEML?LVaFFL-pcMlIu@AkX@9JRYeAsu=_KwbMZD~W!5J@;F_vZJv5I|yAB6y}{mu4g62DoqI*Z-C* z5JaBl*<|m@>dMeo-%l7)|CaOP4TiI~&<8#cZN3+Sm)P0&1O6hPVX+%!6F-MCK8<=X z3)&C}R+Z-Btquo*!uFo;qcMGbYzGHd$8k8#HoGC|CReiMw47JlU6SVyl1;HBY#xf< zrD8v%v(3E-eRH?wfH!L4FS zQau`DMF|d4>-7Ys;O;JTy2)iKpc3GMpA>*bowUM!WOFkoCMPkHmF~Hdjjip>>}-*_ zcpJ*x)t$7o|IXy{x2J(j=s1x&UcCsp*PMh$WxZFyZY)VVY~L)3wDv4v)wI)M3FOwv znxgmkqW?~(HfS{_=Dvx}JKnjHaTG|lb|wF&T=A){sC4^yR_o(D_#*Y}bszpRK} z?3Ef|%?Sic zgpMbioax3zuBX@!jQthrPYigNv#x@NYR2-f{wJVMwG1T@m3aPfRR66=R{IYwGYo#} z^Kn_ePRTZ;K`7eIEo`kneRk^;bicr>%}%&Fr}SoZH?4IIo1J@4N2H|7r%I&QDAM`{5_x` zf9IT0Rdbv5e{>syxBX9j!Z>9Hj{ZVW88W?UWQ7D^?!H7qquhGtMaCS(yDq_ZW}awAi-$#U`vM9B&QEq>FN zPes9v5eebmx-I0a7T?SKOEWXmNDM?>9D5|IQ0$KwTe8O$o5zVZ=Y;e(3&=~&CBy)m zxwZ;1lc~o~{Mn~$cAI;44rO2K)br~*`maB(9eT|@A=`LJE`f7BT^f}0 zh8n8Tuw8jo(!dWc>&vimE7|Xc_4Fy_&7TJFn^T`Y+t|OyyJ**_s>W|CTh#MoBR~`u z8+URDYF(Uz_9RIBKMha>_QUZ>_nJ6ptrluT>MQ~Y%3YX?U$@LI|BVEjp}EAZ8EcUj z`j6Fg@M&tf&lR}CoKW}el`5krJVqfoat3?GI_3x%ecuUnY_!_^@q<)TD)76lZK#FO HbbR(-ZU>uU literal 0 HcmV?d00001 diff --git a/logo_imapsync_2.svg b/logo_imapsync_2.svg new file mode 100644 index 0000000..506cfe6 --- /dev/null +++ b/logo_imapsync_2.svg @@ -0,0 +1,149 @@ + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + + + + + + diff --git a/logo_imapsync_s.png b/logo_imapsync_s.png new file mode 100644 index 0000000000000000000000000000000000000000..2526144a019763944e6ecf5c8b9a9a00cea589dc GIT binary patch literal 3957 zcmai1hc_Eu^bd)>Rcmi;gV@xlQd_Ku){a@Dc2pu(&C*s;<4cQLQM+jEQKS?lR6_|> zqSW5AR{5pB-yiTh@7{OMdFOr39q--y-hFOvX23+xLk|D|n4pHb7G$YT<{PxsNt);M~QB)6SN0SMn}`z%x;%@Wu%IO%DrYLoCQ)Sa?1jfA$S`Z`_X~2v6oG8(K<714+=IKuvQa^@0g^~M14=6~n{^_)4XFDQ znvLYv9&38Z)xz@yka1UXhcA_>(205;$0bV@am9w_T&_@z-H*200RLD5CoIJ8yH~KI zluPYM;San;5dgRZMo@r(&^c#73*~EyS7F2r#4K{_?Vi2eZ@fwk-pCzEjry zapz(`+~d1c#{uVG&R$V`=ZtZgqndMy)&ycdA$Ckdly(GD2N||NkrK4A%b~M3=@Fm{+7+A(y8zSHrTnq zIrm7Mfhq8RbDH98TEWc<9N9M}1qo_J#1Pc>lTODv0cNc_(93lAw zvmLjiL}=&NEWCOhN-Rk3d3l}(jg41D+61UT>Lb1T5u5z{6(ViP#CLs*9qSE}#jBXO%|dh0|dY^@!qJ5RMpKAKf0qc0T`W8^EAhqRu#Z4974b z`H{3XPPNuVY5SuJpPM(B-#N4&mHO0A`HP9G*P31~00gkd{xbXOF;^w6cc3r*8Ow)ZzA2|?W z=1f(a=vt1DsNVUiy1Zs@UEQ{Zj}@w^v?}|aDOoGVXN7cNA)*0K4Rx{Y?eWMKXvwH9 z$90KJx*yZ`P$-lqqGH;%+t=P%Seerr z`M1MqYt2qYU8Us=2#hP>44{ZiaH2k%;{<6VJI=~mStzY3c-z`vF;rLc|Cv7e9@>uS zlD{WWZDR+9(A_q>(jOQ&LtT`rBT)i}G~ENc$(hDwXG_Gz>1<3Z4;~*g9=1gbfuCsK zz=Dxj)OuU$2!>AiCvq8`h~?qE6|tSt`{L}V^K|Wqh4CW|>D6t@F-PFXgaYL=ciZr4 zLirs~%X8geCm4)$x9I(`BsnRhXkaoNBEF=~-YcLd9%J2T&*%N_ZEd3*FI2Gv+RQ;l zvKJdOw}*;!>L-I~p`*0%*e`WlUryp!i18++dF!=Z3y<^&Nld(3?S8{K_}P%Piklj& zNKwEYLCvQZ!jY&8%-n%~aTcNl>0VdmvpRfozWVCzSa0x{i4atnng0h&B6D$2l1K;B z?6_iDzq0M5FTz%AQL!^&4`gKIbAD8pvH<>42UYoL1V$`FoJI z?+cUdq=r)Xi}_}HpJNSMA+j182{p~E&&y+Ar_qge@o8zzsbX|mtY6%Wp7h9o+VG;842GD$(!Iqg7c)M*S0i#{4}EaEL#yH=^^UHWJ{NA%e|8$ zG_)`n89zU$@AUj?S@XOK^ERa4wBEhbn;pca#mWj|8Hv*`P7s5NW$^n>?XfQIae3y4 zLQ`MD`0XswH7)b?cM`F8T2QM~QGjy)bBDgpA3ApjIHCtE2RDR0L-ky{2FfrsK z({vNy+aZ_WL==g^F6*jv#{ovo((-Ta;rg~xQvhi%Rfu+r?||=puE`S0Gy_^jWmF>l zsPz`2d7$&Lj_-6+URs*`aA|Dmb=hI|bPjp|l`b3?$TzqcxOQk;TB@J@hVR#ur(hpC zm;7vq|NXmeZkdstEgu(Gi#%Oj9vyG|?`0e5P(AgnET?0Lo?X`X*;R76_n$e?fzm7S zmxX>7a3J<7Qk|X}B_$>8O+L8I#jTpO?p^Nv#!xI?47$(51}Z03B_%V}d5r~oH*z!c zspv{$cy>b)e4CyuOmfh_5YMz?WhU>~bf0cAFuXBM!Nogmtky9nI=;u|lVQ^l=Jx_y zPO{`ssteuknvua9iK5(Mai4YLlX(UE_fd*cF)j_x(`eMp@0FgkiV8Vu8YhoOkGT3j ztZr)-+?VL7aS%nJAl>^21W`D1O^h!q(1BEjzB4%A`*-Lh6XGMtumPWZhnNzCa~#61 z>M00Bo%jFYyAr4<6<=A(s>jyvC9ilO(H?vU-^+O^03e?}5O}-Xs_e^Rm`&rF1f=T2%Zu$AP zn{{XycQ}4(^32W`SWH&tX=rFj#iNV7ew;694(+I$a~yVzH1L%{OXOoJb4*}@ZyOtd zTC6aU%1+*)z#K&$G}%EizOGWm3pwaFe%f zYY!iAQ#0q_CN4fP?c41;duSt;IT&MLIpcGp8Kbl~Do#N>0=2YVK~A z)wgpb;@ch;~oED@VN@@i#erPQt(xidHIJNuDNj}8uo6xtvRMF?snyH3ILz!(zK z(l=i_MII$`2#Vo7fe>ASPC6(dA%R>HOoJ+{4AS1x)@?Z33j5j@Px;QNd<~TP9hai& zvJ&>hb(fJo-cce`UQ|@)$n*0wQT#vB-$10^l_e#ixCB-|6l;58!)S zzJ6_11c#nJ5k0!fm1Zc=v!iqaFE8}X_s79e4c02x#iMlS-~hC^r**U$9_M{1+ca~R z7UBwb9zPox2qf1LvXf+ESanf%wAE*gUzWJTx*6JH>vO4TS$7j-QQHz(C7}%3|n0Rzjw!%syb^OsLN1&-aoN`^ z?V(=beqzG;HFX!%bAYQ(Bo&RM}Po&Jn?T+hkqscF8seCyB+!&RW05 zyezhFRMnace&EPTR$^k7A}=SWUm_pxKAt8<*Yhmhup!N8(eOt7=Y?wW(I9Q|o%Ri7 zw#tl&hYQAyVXp}U;e@B8ZnV$WA(Pfnlb-TQwN=zjKfg`4dItz1DTw+TSG^&2e5hW@L`g_sSWvcSmZ4StHF;S$uuegDoi?oIwWe1ewz$aQe&aJRMc$+E1P zSg)_ovb>F`9kE(FoT_slHY2V#dQJPAjC(6QrJ;6|gqfubzc~mh%lD3&Il^f1>&ceG7lU?ohf+RG!i zl)E~|qv=bXt72}`_`~m#S(chVAKHvH`I*{URr}gDK7Vv#9vTwj>`JWR#HWnC`K;OS zy6;l8Tp%JRdNWjjMWZEixgaY2?-^!)DOYCqXgd5@bIYT)kM#yaB)KEKj?%M1J$U5q zf^wH~BToQ%Svgs$f24X}RzXcpSxxDdq^!J}tgNc-FLGb|e*nJ#H!qLS{|Df)^2&e= w;QpuKUVsM*] + [--user1 ] [--passfile1 ] + [--host2 server2] [--port2 ] + [--user2 ] [--passfile2 ] + [--ssl1] [--ssl2] + [--tls1] [--tls2] + [--authmech1 ] [--authmech2 ] + [--noauthmd5] + [--folder --folder ...] + [--folderrec --folderrec ...] + [--include ] [--exclude ] + [--prefix2 ] [--prefix1 ] + [--regextrans2 --regextrans2 ...] + [--sep1 ] + [--sep2 ] + [--justfolders] [--justfoldersizes] [--justconnect] [--justbanner] + [--syncinternaldates] + [--idatefromheader] + [--buffersize ] + [--syncacls] + [--regexmess ] [--regexmess ] + [--maxsize ] + [--minsize ] + [--maxage ] + [--minage ] + [--skipheader ] + [--useheader ] [--useheader ] + [--skipsize] [--allowsizemismatch] + [--delete] [--delete2] + [--expunge] [--expunge1] [--expunge2] [--uidexpunge2] + [--subscribed] [--subscribe] [--subscribe_all] + [--nofoldersizes] + [--dry] + [--debug] [--debugimap][--debugimap1][--debugimap2] + [--timeout ] [--fast] + [--split1] [--split2] + [--reconnectretry1 ] [--reconnectretry2 ] + [--pidfile ] + [--tmpdir ] + [--version] [--help] + +=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. imapsync is CPU hungry so nice and renice +commands can be a good help. imapsync can be memory hungry too, +especially with large messages. + +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 --expunge1 options. + +You can also just synchronize a mailbox A from another mailbox B +in case you just want to keep a "live" copy of B in A (--delete2 +may help) + +=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. + + +=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, gratis and open source 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 a message to: + + +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 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://www.linux-france.org/prj/imapsync/ + +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(tm) and you haven't read the 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. + + - operating system running imapsync. + + - operating systems on both sides and the third side in case + you run imapsync on a foreign host from the both. + + - virtual software context (vmware, xen etc.) + +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 4 imap servers: + + - MailEnable 1.54 (Proprietary) http://www.mailenable.com/ + - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works. + Patient and confident testers are welcome. + - dkimap4 2.39 + - Imail 7.04 (maybe). + +Success stories reported with the following 36 imap servers +(software names are in alphabetic order): + + - 1und1 H mimap1 84498 [host1] + - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] + (OSL 3.0) http://www.archiveopteryx.org/ + - 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.10, 2.2.12, + v2.2.3-Invoca-RPM-2.2.3-8, + 2.3-alpha (OSI Approved), + v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1, + 2.2.13, + v2.3.1-Invoca-RPM-2.3.1-2.7.fc5, + v2.3.7, + (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] + - Domino (Notes) 4.61[host1], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1[host1], 8.0.1[host1] + - 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 + - GMX IMAP4 StreamProxy. + - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. + - iPlanet Messaging server 4.15, 5.1, 5.2 + - IMail 7.15 (Ipswitch/Win2003), 8.12 + - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform) + - 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], Exchange 2007 SP1 (with Update Rollup 2), + Exchange2007-EP-SP2, + Exchange 2010 RTM (Release to Manufacturing) [host2] + - Netscape Mail Server 3.6 (Wintel !) + - Netscape Messaging Server 4.15 Patch 7 + - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) + - OpenWave + - 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 + - SmarterMail, Smarter Mail 5.0 Enterprise. + - 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 + - Sun Messaging Server 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 + - Imap part of TCP/IP suite of VMS 7.3.2 + - Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, 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 + +Please rate imapsync at http://freshmeat.net/projects/imapsync/ +or better give the author a book, he likes books: +http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ +(or its paypal account gilles.lamiral@laposte.net) + +=head1 HUGE MIGRATION + +Pay special attention to options +--subscribed +--subscribe +--delete +--delete2 +--expunge +--expunge1 +--expunge2 +--uidexpunge2 +--maxage +--minage +--maxsize +--useheader +--fast + +If you have many mailboxes to migrate think about a little +shell program. Write a file called file.csv (for example) +containing users and passwords. +The separator used in this example is ';' + +The file.csv file contains: + +user0001;password0001;user0002;password0002 +user0011;password0011;user0012;password0012 +... + +And the shell program is just: + + { while IFS=';' read u1 p1 u2 p2; do + imapsync --user1 "$u1" --password1 "$p1" --user2 "$u2" --password2 "$p2" ... + done ; } < file.csv + +Welcome in shell programming ! + +=head1 Hacking + +Feel free to hack imapsync as the 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 : http://software.complete.org/offlineimap + mailsync : http://mailsync.sourceforge.net/ + imapxfer : http://www.washington.edu/imap/ + part of the imap-utils from UW. + mailutil : replace imapxfer in + part of the imap-utils from UW. + http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil + imaprepl : http://www.bl0rg.net/software/ + http://freshmeat.net/projects/imap-repl/ + imap_migrate : http://freshmeat.net/projects/imapmigration/ + imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html + migrationtool : http://sourceforge.net/projects/migrationtool/ + imapmigrate : http://sourceforge.net/projects/cyrus-utils/ + wonko_imapsync: http://wonko.com/article/554 + see also tools/wonko_ruby_imapsync + pop2imap : http://www.linux-france.org/prj/pop2imap/ + + +Feedback (good or bad) will often be welcome. + +$Id: imapsync,v 1.350 2010/09/06 01:05:09 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 POSIX qw(uname); +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 Test::More 'no_plan'; + +eval { require 'usr/include/sysexits.ph' }; + +# global variables + +my( + $rcs, $pidfile, + $debug, $debugimap, $debugimap1, $debugimap2, $nb_errors, + $host1, $host2, $port1, $port2, + $user1, $user2, $password1, $password2, $passfile1, $passfile2, + @folder, @include, @exclude, @folderrec, + $prefix1, $prefix2, + @regextrans2, @regexmess, @regexflag, + $sep1, $sep2, + $syncinternaldates, + $idatefromheader, + $usedatemanip, + $syncacls, + $fastio1, $fastio2, + $maxsize, $minsize, $maxage, $minage, + $skipheader, @useheader, + $skipsize, $allowsizemismatch, $foldersizes, $buffersize, + $delete, $delete2, + $expunge, $expunge1, $expunge2, $uidexpunge2, $dry, + $justfoldersizes, + $authmd5, + $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, + $timeout, + $timestart, $timeend, $timediff, + $timesize, $timebefore, + $ssl1, $ssl2, + $tls1, $tls2, + $authuser1, $authuser2, + $authmech1, $authmech2, + $split1, $split2, + $reconnectretry1, $reconnectretry2, + $tests, $test_builder, $tests_debug, + $allow3xx, $justlogin, + $tmpdir, + $releasecheck, +); + +# main program + +# global variables initialisation + +$rcs = '$Id: imapsync,v 1.350 2010/09/06 01:05:09 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; + +$nb_errors = 0; + +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(); + +$releasecheck = defined($releasecheck) ? $releasecheck : 1; +my $warn_release = ($releasecheck) ? check_last_release() : ''; + +# default values + +$tmpdir ||= File::Spec->tmpdir(); +$pidfile ||= $tmpdir . '/imapsync.pid'; + +# allow Mail::IMAPClient 3.0.xx by default +$allow3xx = defined($allow3xx) ? $allow3xx : 1; + +print banner_imapsync(@argv_copy); + +print "Temp directory is $tmpdir\n"; + +is_valid_directory($tmpdir); +write_pidfile($pidfile) if ($pidfile); + +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.0.25 or superior \n"; + +exit_clean(0) if ($justbanner); + +# By default, 1000 at a time, not more. +$split1 ||= 1000; +$split2 ||= 1000; + +$host1 || missing_option("--host1") ; +$port1 ||= (defined $ssl1 and !defined $tls1) ? 993 : 143; + +$host2 || missing_option("--host2") ; +$port2 ||= (defined $ssl2 && !defined $tls2) ? 993 : 143; + +$debugimap1 = $debugimap2 = 1 if ($debugimap); + +# By default, don't take size to compare +$skipsize = (defined $skipsize) ? $skipsize : 1; + +sub connect_imap { + my($host, $port, $debugimap, $ssl, $tls) = @_; + my $imap = Mail::IMAPClient->new(); + $imap->Server($host); + $imap->Port($port); + $imap->Debug($debugimap); + $imap->Ssl($ssl) if ($ssl); + $imap->Tls($tls) if ($tls); + #$imap->connect() + myconnect($imap) + or die_clean("Can not open imap connection on [$host]: $@\n"); +} + + +if ($justconnect) { + justconnect(); + exit_clean(0); +} + +$user1 || missing_option("--user1"); +$user2 || missing_option("--user2"); + +$syncinternaldates = defined($syncinternaldates) ? $syncinternaldates : 1; + +if($idatefromheader) { + print "Turned ON idatefromheader, ", + "will set the internal dates on host2 from the 'Date:' header line.\n"; + $syncinternaldates = 0; + +} +if ($syncinternaldates) { + print "Turned ON syncinternaldates, ", + "will set the internal dates (arrival dates) on host2 same as host1.\n"; +}else{ + print "Turned OFF syncinternaldates\n"; +} + + +if(defined($authmd5) and not($authmd5)) { + $authmech1 ||= 'LOGIN'; + $authmech2 ||= 'LOGIN'; +} +else{ + $authmech1 ||= $authuser1 ? 'PLAIN' : 'CRAM-MD5'; + $authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5'; +} + +$authmech1 = uc($authmech1); +$authmech2 = uc($authmech2); + +$authuser1 ||= $user1; +$authuser2 ||= $user2; + +print "Will try to use $authmech1 authentication on host1\n"; +print "Will try to use $authmech2 authentication on host2\n"; + +$syncacls = (defined($syncacls)) ? $syncacls : 0; +$foldersizes = (defined($foldersizes)) ? $foldersizes : 1; + +$fastio1 = (defined($fastio1)) ? $fastio1 : 0; +$fastio2 = (defined($fastio2)) ? $fastio2 : 0; + +$reconnectretry1 = (defined($reconnectretry1)) ? $reconnectretry1 : 3; +$reconnectretry2 = (defined($reconnectretry2)) ? $reconnectretry2 : 3; + +@useheader = ("ALL") unless (@useheader); + +print "Host1: imap server [$host1] port [$port1] user [$user1]\n"; +print "Host2: imap server [$host2] port [$port2] user [$user2]\n"; + + +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; +} + + +$password1 || $passfile1 || do { + $password1 = ask_for_password($authuser1 || $user1, $host1); +}; + +$password1 = (defined($passfile1)) ? firstline ($passfile1) : $password1; + +$password2 || $passfile2 || do { + $password2 = ask_for_password($authuser2 || $user2, $host2); +}; + +$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2; + +my $imap1 = (); +my $imap2 = (); + +$timestart = time(); +$timebefore = $timestart; + +$debugimap1 and print "Host1 connection\n"; +$imap1 = login_imap($host1, $port1, $user1, $password1, + $debugimap1, $timeout, $fastio1, $ssl1, $tls1, + $authmech1, $authuser1, $reconnectretry1); + +$debugimap2 and print "Host2 connection\n"; +$imap2 = login_imap($host2, $port2, $user2, $password2, + $debugimap2, $timeout, $fastio2, $ssl2, $tls2, + $authmech2, $authuser2, $reconnectretry2); + +# history + +$debug and print "Host1 Buffer I/O: ", $imap1->Buffer(), "\n"; +$debug and print "Host2 Buffer I/O: ", $imap2->Buffer(), "\n"; + + +sub login_imap { + my($host, $port, $user, $password, + $debugimap, $timeout, $fastio, + $ssl, $tls, $authmech, $authuser, $reconnectretry) = @_; + my ($imap); + + $imap = Mail::IMAPClient->new(); + + $imap->Ssl($ssl) if ($ssl); + $imap->Tls($tls) if ($tls); + $imap->Clear(5); + $imap->Server($host); + $imap->Port($port); + $imap->Fast_io($fastio); + $imap->Buffer($buffersize || 4096); + $imap->Uid(1); + $imap->Peek(1); + $imap->Debug($debugimap); + $timeout and $imap->Timeout($timeout); + + $imap->Reconnectretry($reconnectretry) if ($reconnectretry); + + #$imap->connect() + myconnect($imap) + or die_clean("Can not open imap connection on [$host] with user [$user]: $@\n"); + + print "Banner: ", server_banner($imap); + + if ($imap->has_capability("AUTH=$authmech") + or $imap->has_capability($authmech) + ) { + printf("Host %s says it has CAPABILITY for AUTHENTICATE %s\n", + $imap->Server, $authmech); + } + else { + printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n", + $imap->Server, $authmech); + if ($authmech eq 'PLAIN') { + print "Frequently PLAIN is only supported with SSL, ", + "try --ssl1 or --ssl2 option\n"; + } + } + + $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); + $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; + + + $imap->User($user); + $imap->Authuser($authuser); + $imap->Password($password); + unless ($imap->login()) { + my $info = "Error login: [$host] with user [$user] auth"; + my $einfo = $imap->LastError || @{$imap->History}[-1]; + chomp($einfo); + my $error = "$info [$authmech]: $einfo\n"; + print $error; # note: duplicating error on stdout/stderr + die_clean($error) if ($authmech eq 'LOGIN' or $imap->IsUnconnected() or $authuser); + print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n"; + $imap->Authmechanism(""); + $imap->login() or + die_clean("$info [LOGIN]: ", $imap->LastError, "\n"); + } + print "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 server_banner { + my $imap = shift; + my $banner = $imap->Banner() || "No banner\n"; + return $banner; + } + +die_clean() unless $imap1->IsAuthenticated(); +print "Host1: state Authenticated\n"; +die_clean() 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); + +$split1 and $imap1->Split($split1); +$split2 and $imap2->Split($split2); + +# +# Folder stuff +# + +my (@h1_folders, %requested_folder, +@h2_folders, @h2_folders_list, %h2_folders_list, %subscribed_folder, %h2_folders); + +sub tests_folder_routines { + ok( !give_requested_folders() ,"no requested folders" ); + 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') ); + ok( init_requested_folders() , 'empty requested folders'); + ok( !give_requested_folders() , 'no requested folders' ); +} + +sub give_requested_folders { + return(keys(%requested_folder)); +} + +sub init_requested_folders { + + %requested_folder = (); + return(1); + +} + +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) ); +} + + +# Make a hash of subscribed folders in source server. +map { $subscribed_folder{$_} = 1 } $imap1->subscribed(); + + + + +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 (%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)) { + my @all_source_folders = sort $imap1->folders(); + add_to_requested_folders(@all_source_folders); + } +} + + +# consider (optional) includes and excludes +if (scalar(@include)) { + my @all_source_folders = sort $imap1->folders(); + foreach my $include (@include) { + my @included_folders = grep /$include/, @all_source_folders; + 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 + +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 = @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([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') ; +} + + +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_namespace = $imap1->namespace(); +#my $h2_namespace = $imap2->namespace(); +#$debug and print "Host1 namespace:\n", Data::Dumper->Dump([$h1_namespace]); +#$debug and print "Host2 namespace:\n", Data::Dumper->Dump([$h2_namespace]); + +my($h1_prefix,$h2_prefix); +$h1_prefix = get_prefix($imap1, $prefix1, "--prefix1"); +$h2_prefix = get_prefix($imap2, $prefix2, "--prefix2"); + +sub get_prefix { + my($imap, $prefix_in, $prefix_opt) = @_; + my($prefix_out); + + $debug and print "Getting prefix namespace\n"; + if (defined($prefix_in)) { + print "Using [$prefix_in] given by $prefix_opt\n"; + $prefix_out = $prefix_in; + return($prefix_out); + } + $debug and print "Calling namespace capability\n"; + if ($imap->has_capability("namespace")) { + my $r_namespace = $imap->namespace(); + $prefix_out = $r_namespace->[0][0][0]; + return($prefix_out); + } + else{ + print + "No NAMESPACE capability in imap server ", + $imap->Server(),"\n", + "Give the prefix namespace with the $prefix_opt option\n"; + exit_clean(1); + } +} + + +sub get_separator { + my($imap, $sep_in, $sep_opt) = @_; + my($sep_out); + + + if ($sep_in) { + print "Using [$sep_in] given by $sep_opt\n"; + $sep_out = $sep_in; + return($sep_out); + } + $debug and print "Calling namespace capability\n"; + if ($imap->has_capability("namespace")) { + $sep_out = $imap->separator(); + return($sep_out) if defined $sep_out; + warn + "NAMESPACE request failed for ", + $imap->Server(), ": ", $imap->LastError, "\n"; + exit_clean(1); + } + else{ + warn + "No NAMESPACE capability in imap server ", + $imap->Server(),"\n", + "Give the separator character with the $sep_opt option\n"; + exit_clean(1); + } +} + + +print "Host1 separator and prefix: [$h1_sep][$h1_prefix]\n"; +print "Host2 separator and prefix: [$h2_sep][$h2_prefix]\n"; + + +sub foldersizes { + + my ($side, $imap, $folders_r) = @_; + my $tot = 0; + my $tmess = 0; + my @folders = @{$folders_r}; + print "++++ Calculating sizes\n"; + foreach my $folder (@folders) { + my $stot = 0; + my $smess = 0; + printf("$side folder %-35s", "[$folder]"); + unless($imap->exists($folder)) { + print("does not exist yet\n"); + next; + } + unless ($imap->examine($folder)) { + warn + "$side Folder $folder: Could not examine: ", + $imap->LastError, "\n"; + $nb_errors++; + next; + } + + my $hash_ref = {}; + my @msgs = select_msgs($imap); + $smess = scalar(@msgs); + @$hash_ref{@msgs} = (undef); + unless ($smess == 0) { + $imap->fetch_hash_2("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; + } + + printf(" Size: %9s", $stot); + printf(" Messages: %5s\n", $smess); + $tot += $stot; + $tmess += $smess; + } + print "Total size: $tot\n"; + print "Total messages: $tmess\n"; + print "Time: ", timenext(), " s\n"; +} + + +foreach my $h1_fold (@h1_folders) { + my $h2_fold; + $h2_fold = imap2_folder_name($h1_fold); + $h2_folders{$h2_fold}++; +} + +@h2_folders = sort keys(%h2_folders); + +if ($foldersizes) { + foldersizes("Host1", $imap1, \@h1_folders); + foldersizes("Host2", $imap2, \@h2_folders); +} + + +sub timenext { + my ($timenow, $timerel); + # $timebefore is global, beurk ! + $timenow = time; + $timerel = $timenow - $timebefore; + $timebefore = $timenow; + return($timerel); +} + +exit_clean(0) if ($justfoldersizes); + +# needed for setting flags +my $imap2hasuidplus = $imap2->has_capability("UIDPLUS"); + + +@h2_folders_list = sort @{$imap2->folders()}; +foreach my $folder (@h2_folders_list) { + $h2_folders_list{$folder}++; +} + +print + "++++ Listing folders\n", + "Host1 folders list:\n", map("[$_]\n",@h1_folders),"\n", + "Host2 folders list:\n", map("[$_]\n",@h2_folders_list),"\n"; + +print + "Host1 subscribed folders list: ", + map("[$_] ", sort keys(%subscribed_folder)), "\n" + if ($subscribed); + +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; + 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] +"; + +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,]'); + + +} + +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 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; + $debug and print "eval \$h1_flags =~ $regexflag\n"; + eval("\$h1_flags =~ $regexflag"); + die_clean("error: eval regexflag '$regexflag': $@\n") if $@; + $debug 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 warn "Could not getacl for $h1_fold: $@\n"; + my $h2_hash = $imap2->getacl($h2_fold) + or warn "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 warn "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 \(([^)]+?)\)\]}) { + #print "%%%$1%%%\n"; + 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); +} + + +# folder loop +print "++++ Looping on each folder\n"; + +FOLDER: foreach my $h1_fold (@h1_folders) { + + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my $h2_fold = imap2_folder_name($h1_fold); + + printf("%-35s -> %-35s\n", "[$h1_fold]", "[$h2_fold]"); + unless ($imap1->select($h1_fold)) { + warn + "Host1 folder $h1_fold: Could not select: ", + $imap1->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + + if ( ! exists($h2_folders_list{$h2_fold})) { + print "Host2 folder $h2_fold does not exist\n"; + print "Creating folder [$h2_fold]\n"; + unless ($dry){ + unless ($imap2->create($h2_fold)){ + warn "Couldn't create [$h2_fold]: ", + $imap2->LastError,"\n"; + $nb_errors++; + next FOLDER; + } + } + else{ + next FOLDER; + } + } + + acls_sync($h1_fold, $h2_fold); + + unless ($imap2->select($h2_fold)) { + warn + "Host2 folder $h2_fold: Could not select: ", + $imap2->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + my @select_results = $imap2->Results(); + + #print "%%% @select_results\n"; + my $permanentflags2 = permanentflags(@select_results); + + if ($expunge){ + print "Expunging host1 $h1_fold\n"; + unless($dry) { $imap1->expunge() }; + #print "Expunging host2 $h2_fold\n"; + #unless($dry) { $imap2->expunge() }; + } + + if (($subscribe and exists $subscribed_folder{$h1_fold}) or $subscribe_all) { + 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 = select_msgs($imap1); + + $debug and print "LIST Host1: ", scalar(@h1_msgs), " messages [@h1_msgs]\n"; + # internal dates on host2 are after the ones on host1 + # normally... + my @h2_msgs = select_msgs($imap2); + + $debug and print "LIST Host2: ", scalar(@h2_msgs), " messages [@h2_msgs]\n"; + + my %h1_hash = (); + my %h2_hash = (); + + $debug and print "Host1 folder [$h1_fold] parsing headers\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my ($h1_heads_ref, $h1_fir_ref) = ({}, {}); + $h1_heads_ref = $imap1->parse_headers([@h1_msgs], @useheader) if (@h1_msgs); + $debug and print "Time headers: ", timenext(), " s\n"; + last FOLDER if $imap1->IsUnconnected(); + + @$h1_fir_ref{@h1_msgs} = (undef); + $h1_fir_ref = $imap1->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref) + if (@h1_msgs); + $debug and print "Time fir: ", timenext(), " s\n"; + unless ($h1_fir_ref) { + warn + "Host1 folder $h1_fold: Could not fetch_hash_2 ", + scalar(@h1_msgs), " msgs: ", $imap1->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + last FOLDER if $imap1->IsUnconnected(); + + + my @h1_msgs_duplicate; + foreach my $m (@h1_msgs) { + my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, "F", \%h1_hash); + if (! defined($rc)) { + my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + print "+ Skipping msg #$m:$h1_size on host1 folder $h1_fold (no header so we ignore this message)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + $h1_nb_msg_noheader +=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; + } + } + $debug and print "Time parsing headers on host1: ", timenext(), " s\n"; + + $debug and print "Host2 folder [$h2_fold] parsing headers\n"; + + my ($h2_heads_ref, $h2_fir_ref) = ({}, {}); + $h2_heads_ref = $imap2->parse_headers([@h2_msgs], @useheader) if (@h2_msgs); + $debug and print "Time headers: ", timenext(), " s\n"; + last FOLDER if $imap2->IsUnconnected(); + + @$h2_fir_ref{@h2_msgs} = (undef); # fetch_hash_2 can select by uid with last arg as ref + $h2_fir_ref = $imap2->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref) + if (@h2_msgs); + $debug and print "Time fir: ", timenext(), " s\n"; + last FOLDER if $imap2->IsUnconnected(); + + my @h2_msgs_duplicate; + foreach my $m (@h2_msgs) { + my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, "T", \%h2_hash); + if (! defined($rc)) { + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + print "+ Skipping msg #$m:$h2_size in host2 folder $h2_fold (no header so we ignore this message)\n"; + $h2_nb_msg_noheader += 1 ; + } elsif(0 == $rc) { + # duplicate + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + $h2_nb_msg_duplicate += 1; + $h2_total_bytes_duplicate += $h2_size; + push(@h2_msgs_duplicate, $m); + } + } + $debug and print "Time parsing headers on host2: ", 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($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 deleted on host2 [$m_id]\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_duplicate) { + print "msg $h2_fold/$h2_msg deleted [duplicate] on host2\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 and !$imap2->can("uidexpunge")) { + warn "uidexpunge not supported (< IMAPClient 3.17)\n"; + } + elsif(@h2_expunge) { + print "uidexpunge $cnt message(s)\n"; + $imap2->uidexpunge(\@h2_expunge) if !$dry; + } + } + + MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) { + my $h1_size = $h1_hash{$m_id}{'s'}; + my $h1_msg = $h1_hash{$m_id}{'m'}; + my $h1_idate = $h1_hash{$m_id}{'D'}; + + if (defined $maxsize and $h1_size > $maxsize) { + print "msg $h1_fold/$h1_msg skipping ($h1_size exceeds maxsize limit $maxsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + next MESS; + } + if (defined $minsize and $h1_size < $minsize) { + print "msg $h1_fold/$h1_msg skipping ($h1_size smaller than minsize $minsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + next MESS; + } + unless (exists($h2_hash{$m_id})) { + # copy + $debug and print "msg $h1_fold/$h1_msg copying to $h2_fold\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + my $string; + $string = $imap1->message_string($h1_msg); + unless (defined($string)) { + warn + "- msg $h1_fold/$h1_msg could not fetch [$m_id $h1_size]: ", + $imap1->LastError, "\n"; + $nb_errors++; + $total_bytes_error += $h1_size; + next MESS; + } + + #my $message_file = "tmp_imapsync_$$"; + #$imap1->select($h1_fold); + #unlink($message_file); + #$imap1->message_to_file($message_file, $h1_msg) or do { + # warn "Could not put message #$h1_msg to file $message_file", + # $imap1->LastError; + # $nb_errors++; + # $total_bytes_error += $h1_size; + # next MESS; + #}; + #$string = file_to_string($message_file); + #print "AAA1[$string]ZZZ\n"; + #unlink($message_file); + if (@regexmess) { + $string = regexmess($string); + + #string_to_file($string, $message_file); + } + + + + 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); + } + + $debug 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"; + } + + my $h1_flags = $h1_hash{$m_id}{'F'} || ""; + # 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 = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); + + my $new_id; + $debug and print "msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + $h1_date = undef if ($h1_date eq ""); + unless ($dry) { + + if ($OSNAME eq "MSWin32") { + $new_id = $imap2->append_string($h2_fold, $string, $h1_flags, $h1_date); + } + else { + # just back to append_string since append_file 3.05 does not work. + #$new_id = $imap2->append_file($h2_fold, $message_file, "", $h1_flags, $d); + # append_string 3.05 does not work too some times with $d unset. + $new_id = $imap2->append_string($h2_fold, $string, $h1_flags, $h1_date); + } + unless($new_id){ + no warnings 'uninitialized'; + warn "- msg $h1_fold/$h1_msg couldn't append (Subject:[". + $imap1->subject($h1_msg)."]) to folder $h2_fold: ", + $imap2->LastError, "\n"; + $nb_errors++; + $total_bytes_error += $h1_size; + next MESS; + } + else{ + # good + # $new_id is an id if the IMAP server has the + # UIDPLUS capability else just a ref + print "msg $h1_fold/$h1_msg copied to $h2_fold/$new_id\n"; + $total_bytes_transferred += $h1_size; + $nb_msg_transferred += 1; + if($delete) { + print "msg $h1_fold/$h1_msg deleted on host1\n"; + unless($dry) { + $imap1->delete_message($h1_msg); + $h1_nb_msg_deleted += 1; + last FOLDER if $imap1->IsUnconnected(); + $imap1->expunge() if ($expunge); + last FOLDER if $imap1->IsUnconnected(); + } + } + } + } + else{ + $nb_msg_skipped_dry_mode += 1; + } + #unlink($message_file); + next MESS; + } + else{ + #my $h2_size = $h2_hash{$m_id}{'s'}; + my $h2_msg = $h2_hash{$m_id}{'m'}; + #my $h2_idate = $h2_hash{$m_id}{'D'}; + $debug and print "msg $h1_fold/$h1_msg equals $h2_fold/$h2_msg\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + } + + $fast and next MESS; + #$debug and print "MESSAGE $m_id\n"; + my $h2_size = $h2_hash{$m_id}{'s'}; + my $h2_msg = $h2_hash{$m_id}{'m'}; + + # used cached flag values for efficiency + my $h1_flags = $h1_hash{$m_id}{'F'} || ""; + my $h2_flags = $h2_hash{$m_id}{'F'} || ""; + + # 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 = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); + + + # 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 and $debug and print "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)") ) { + warn "- msg $h2_fold/$h2_msg could not add flags @h1_flags", + $imap2->LastError, "\n"; + #$nb_errors++; + } + last FOLDER if $imap2->IsUnconnected(); + + $debug and do { + my @h2_flags = @{ $imap2->flags($h2_msg) || [] }; + last FOLDER if $imap2->IsUnconnected(); + + print "host1 flags: $h1_flags\n", + "host2 flags: @h2_flags\n"; + + print "Looking dates\n"; + #my $h1_idate = $imap1->internaldate($h1_msg); + #my $h2_idate = $imap2->internaldate($h2_msg); + my $h1_idate = $h1_hash{$m_id}{'D'}; + my $h2_idate = $h2_hash{$m_id}{'D'}; + print + "host1 internal date: $h1_idate\n", + "host2 internal date: $h2_idate\n"; + + #unless ($h1_idate eq $h2_idate) { + # print "!!! Dates differs !!!\n"; + #} + }; + unless ($skipsize or ($h1_size == $h2_size)) { + # Bad size + print + "- msg $h1_fold/$h1_msg size diff $h1_size != $h2_size $h2_fold/$h2_msg\n"; + $nb_errors++; + } + else { + # Good + $debug and print + "msg $h1_fold/$h1_msg sizes ok $h1_size <=> $h2_size $h2_fold/$h2_msg\n"; + 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); + } + } + } + } + if ($expunge1){ + print "Expunging host1 folder $h1_fold\n"; + unless($dry) { $imap1->expunge() }; + } + if ($expunge2){ + print "Expunging host2 folder $h2_fold\n"; + unless($dry) { $imap2->expunge() }; + } + +$debug and print "Time: ", timenext(), " s\n"; +} + +print "++++ End looping on each folder\n"; + + +# FOLDER loop is exited any time a connection is lost be sure to log it! +# Example: +# lost_connection($imap1,"host1 [$host1]"); +# +# can be tested with a "killall /usr/bin/imapd" (or equivalent) in command line. +# +sub _filter { + my $str = shift or return ""; + my $sz = 64; + my $len = length($str); + if ( ! $debug and $len > $sz*2 ) { + my $beg = substr($str, 0, $sz); + my $end = substr($str, -$sz, $sz); + $str = $beg . "..." . $end; + } + $str =~ s/\012?\015$//; + return "(len=$len) " . $str; +} + +sub lost_connection { + my($imap, $error_message) = @_; + if ( $imap->IsUnconnected() ) { + $nb_errors++; + my $lcomm = $imap->LastIMAPCommand || ""; + my $einfo = $imap->LastError || @{$imap->History}[-1] || ""; + + # if string is long try reduce to a more reasonable size + $lcomm = _filter($lcomm); + $einfo = _filter($einfo); + warn("error: last command: $lcomm\n") if ($debug && $lcomm); + warn("error: lost connection $error_message", $einfo, "\n"); + return(1); + }else{ + return(0); + } +} + +$imap1->logout(); +$imap2->logout(); + +my $host1_reconnect_count = $imap1->Reconnect_counter() || 0; +my $host2_reconnect_count = $imap2->Reconnect_counter() || 0; + +$timeend = time(); + +$timediff = $timeend - $timestart; + +stats(); + +exit_clean(1) if($nb_errors); + +exit_clean(0); + +# END of main program + +# subroutines + +sub check_lib_version { + $debug and print "IMAPClient $Mail::IMAPClient::VERSION\n"; + if ($Mail::IMAPClient::VERSION eq '2.2.9') { + override_imapclient(); + 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::SSL +Digest::MD5 +Digest::HMAC_MD5 +Term::ReadKey)) + { + 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; + 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'); + + +} + +sub banner_imapsync { + + my @argv_copy = @_; + my $banner_imapsync = join("", + '$RCSfile: imapsync,v $ ', + '$Revision: 1.350 $ ', + '$Date: 2010/09/06 01:05:09 $ ', + "\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) { + warn "$pidfile already exists, overwriting it\n"; + } + open(PIDFILE, ">$pidfile") or do { + warn "Could not open $pidfile for writing"; + return undef; + }; + + print PIDFILE $PROCESS_ID; + close PIDFILE; + return($PROCESS_ID); +} + +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 exit_clean { + my $status = shift; + + 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_msgs { + my ($imap) = @_; + my (@msgs,@max,@min,@union,@inter); + + unless (defined($maxage) or defined($minage)) { + @msgs = $imap->search("ALL"); + return(@msgs); + } + if (defined($maxage)) { + @max = $imap->sentsince(time - 86400 * $maxage); + } + if (defined($minage)) { + @min = $imap->sentbefore(time - 86400 * $minage); + } + SWITCH: { + unless(defined($minage)) {@msgs = @max; last SWITCH}; + unless(defined($maxage)) {@msgs = @min; last SWITCH}; + my (%union, %inter); + foreach my $m (@min, @max) {$union{$m}++ && $inter{$m}++} + @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 stats { + print "++++ Statistics\n"; + print "Transfer time : $timediff sec\n"; + 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"; + print "Total bytes transferred : $total_bytes_transferred\n"; + print "Total bytes duplicate host1 : $h1_total_bytes_duplicate\n"; + print "Total bytes duplicate host2 : $h2_total_bytes_duplicate\n"; + print "Total bytes skipped : $total_bytes_skipped\n"; + print "Total bytes error : $total_bytes_error\n"; + $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"; + print "Detected $nb_errors errors\n\n"; + + print $warn_release, "\n"; + print thank_author(); +} + +sub thank_author { + + 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://www.linux-france.org/prj/imapsync/\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, + "debugimap!" => \$debugimap, + "debugimap1!" => \$debugimap1, + "debugimap2!" => \$debugimap2, + "host1=s" => \$host1, + "host2=s" => \$host2, + "port1=i" => \$port1, + "port2=i" => \$port2, + "user1=s" => \$user1, + "user2=s" => \$user2, + "password1=s" => \$password1, + "password2=s" => \$password2, + "passfile1=s" => \$passfile1, + "passfile2=s" => \$passfile2, + "authmd5!" => \$authmd5, + "sep1=s" => \$sep1, + "sep2=s" => \$sep2, + "folder=s" => \@folder, + "folderrec=s" => \@folderrec, + "include=s" => \@include, + "exclude=s" => \@exclude, + "prefix1=s" => \$prefix1, + "prefix2=s" => \$prefix2, + "regextrans2=s" => \@regextrans2, + "regexmess=s" => \@regexmess, + "regexflag=s" => \@regexflag, + "delete!" => \$delete, + "delete2!" => \$delete2, + "syncinternaldates!" => \$syncinternaldates, + "idatefromheader!" => \$idatefromheader, + "syncacls!" => \$syncacls, + "maxsize=i" => \$maxsize, + "minsize=i" => \$minsize, + "maxage=i" => \$maxage, + "minage=i" => \$minage, + "buffersize=i" => \$buffersize, + "foldersizes!" => \$foldersizes, + "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, + "skipsize!" => \$skipsize, + "allowsizemismatch!" => \$allowsizemismatch, + "fastio1!" => \$fastio1, + "fastio2!" => \$fastio2, + "ssl1!" => \$ssl1, + "ssl2!" => \$ssl2, + "tls1!" => \$tls1, + "tls2!" => \$tls2, + "authmech1=s" => \$authmech1, + "authmech2=s" => \$authmech2, + "authuser1=s" => \$authuser1, + "authuser2=s" => \$authuser2, + "split1=i" => \$split1, + "split2=i" => \$split2, + "reconnectretry1=i" => \$reconnectretry1, + "reconnectretry2=i" => \$reconnectretry2, + "tests" => \$tests, + "tests_debug" => \$tests_debug, + "allow3xx!" => \$allow3xx, + "justlogin!" => \$justlogin, + "tmpdir=s" => \$tmpdir, + "pidfile=s" => \$pidfile, + "releasecheck!" => \$releasecheck, + ); + + $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 "Head NUM:", $headnum, "\n"; + unless($headnum) { print "Warning: no header used or found for message $m_uid\n"; } + my $headstr; + + foreach my $h (sort keys(%$head)){ + foreach my $val (sort @{$head->{$h}}) { + # no 8-bit data in headers ! + $val =~ s/[\x80-\xff]/X/g; + + # remove the first blanks (dbmail bug ?) + # and uppercase header keywords + # (dbmail and dovecot) + $val =~ s/^\s*(.+)$/$1/; + + #my $H = uc($h); + my $H = "$h: $val"; + # show stuff in debug mode + $debug and print "${s}H $H:", $val, "\n"; + + if ($skipheader and $H =~ m/$skipheader/i) { + $debug and print "Skipping header $H\n"; + next; + } + #$headstr .= "$H:". $val; + $headstr .= "$H"; + } + } + #return unless ($headstr); + unless ($headstr){ + # taking everything is too heavy, + # should take only 1 Ko + #print "no header so taking everything\n"; + #$headstr = $imap->message_string($m_uid); + + print "no header so we ignore this message\n"; + return undef; + } + 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 msg $m_uid:$m_md5:$size\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 check_last_release { + + my $public_release = not_long('imapsync_version_lfo'); + return('') if ($public_release eq 'unknown'); + + 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.350 2010/09/06 01:05:09 gilles Exp gilles $ '; + $rcs =~ m/,v (\d+\.\d+)/; + my $VERSION = ($1) ? $1: "UNKNOWN"; + return($VERSION); +} + + +sub imapsync_version_lfo { + + my $local_version = imapsync_version(); + my $agent_info = "$OSNAME system, perl $PERL_VERSION, Mail::IMAPClient $Mail::IMAPClient::VERSION"; + my $sock = new IO::Socket::INET ( + PeerAddr => 'linux-france.org', + 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: www.linux-france.org\n\n"; + my @line = <$sock>; + close($sock); + my $last_release = $line[-1]; + chomp($last_release); + return($last_release); +} + +sub not_long { + + my ($func) = @_; + my $val; + eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm 3; + #print $func, "\n"; + { + no strict "refs"; + $val = &$func(); + } + alarm 0; + }; + if ($@) { + # timed out + return('unknown') unless $@ eq "alarm\n"; # 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 = check_last_release(); + print < : "from" imap server. Mandatory. +--port1 : port to connect on host1. Default is 143. +--user1 : user to login on host1. Mandatory. +--authuser1 : user to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. +--password1 : password for the user1. Dangerous, use --passfile1 +--passfile1 : password file for the user1. Contains the password. +--host2 : "destination" imap server. Mandatory. +--port2 : port to connect on host2. Default is 143. +--user2 : user to login on host2. Mandatory. +--authuser2 : user to auth with on host2 (admin user). +--password2 : password for the user2. Dangerous, use --passfile2 +--passfile2 : password file for the user2. Contains the password. +--noauthmd5 : don't use MD5 authentification. +--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. +--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 : separator in case namespace is not supported. +--sep2 : idem. +--delete : delete messages on host1 server after + a successful transfer. Useful in case you + want to migrate from one server to another one. + With imap, "delete" tags messages as deleted, they + are not really deleted. See expunge. +--delete2 : delete messages on host2 that are not on + host1 server. +--expunge : expunge messages on host1. + expunge really deletes messages marked deleted. + expunge is made at the beginning, on host1 only. + Newly transferred messages are expunged if + option --expunge is given. + No expunge is done on destination account + (see --expunge2) but it may change in future releases. +--expunge1 : expunge messages on host1. +--expunge2 : expunge messages on host2. +--uidexpunge2 : uidexpunge messages on the destination imap server + that are not on the source server, 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. +--buffersize : sets the size of a block of I/O. +--maxsize : skip messages larger than bytes +--minsize : skip messages smaller 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) +--skipheader : Don't take into account header keyword + matching ex: --skipheader 'X.*' +--useheader : Use this header to compare messages on both sides. + Ex: Message-ID or Subject or Date. +--useheader and this one, etc. +--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 +--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. +--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. +--justfoldersizes : exit after printed the folder sizes. +--syncacls : Synchronises acls (Access Control Lists). +--nosyncacls : Does not synchronise acls. This is the default. +--debug : debug mode. +--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 (just does not sync flags of messages + already transfered). +--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 1000. +--split2 : same thing on host2. +--fastio1 : use fastio with host1. +--fastio2 : use fastio with host2. +--timeout : imap connect timeout. +--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 \\ + --host1 imap.truc.org --user1 foo --password1 secret1 \\ + --host2 imap.trac.org --user2 bar --password2 secret2 + +$localhost_info +$rcs +$warn_release + +$thank +EOF +} + + +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) = @_; + 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 = '' if not defined($zone); + $d = $day_1 . $date_rest . $hour . $zone; + + + }elsif ($d =~ m{(?:.{3}, )(\d?)(\d) (...) (\d{4})( \d{2}:\d{2}:\d{2})( (?:\+|-)\d{4})?}o ) { + #print "header: [$1][$2][$3][$4][$5][$6]\n"; + my ($day_1, $day_rest, $month, $year, $hour, $zone) = ($1,$2,$3,$4,$5,$6); + $day_1 = '0' if ($day_1 eq ''); + $zone = '' if not defined($zone); + $d = $day_1 . "$day_rest-$month-$year" . $hour . $zone; + + }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"' 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"' 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'); + +} + +sub tests_debug { + + SKIP: { + skip "No test in normal run" if (not $tests_debug); + tests_good_date(); + } +} + +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(); + } +} + +# 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::append_file = sub { + + my $self = shift; + my $folder = $self->Massage(shift); + my $file = shift; + my $control = shift || undef; + my $count = $self->Count($self->Count+1); + my $flags = shift || undef; + my $date = shift || undef; + + if (defined($flags)) { + $flags =~ s/^\s+//g; + $flags =~ s/\s+$//g; + } + + if (defined($date)) { + $date =~ s/^\s+//g; + $date =~ s/\s+$//g; + } + + $flags = "($flags)" if $flags and $flags !~ /^\(.*\)$/ ; + $date = qq/"$date"/ if $date and $date !~ /^"/ ; + + + unless ( -f $file ) { + $self->LastError("File $file not found.\n"); + return undef; + } + + my $fh = IO::File->new($file) ; + + unless ($fh) { + $self->LastError("Unable to open $file: $!\n"); + $@ = "Unable to open $file: $!" ; + carp "unable to open $file: $!"; + return undef; + } + + my $bare_nl_count = scalar grep { /^\x0a$|[^\x0d]\x0a$/} <$fh>; + + seek($fh,0,0); + + my $clear = $self->Clear; + + $self->Clear($clear) + if $self->Count >= $clear and $clear > 0; + + my $length = ( -s $file ) + $bare_nl_count; + + my $string = "$count APPEND $folder " . + ( $flags ? "$flags " : "" ) . + ( $date ? "$date " : "" ) . + "{" . $length . "}\x0d\x0a" ; + + $self->_record($count,[ $self->_next_index($count), "INPUT", "$string" ] ); + + my $feedback = $self->_send_line("$string"); + + unless ($feedback) { + $self->LastError("Error sending '$string' to IMAP: $!\n"); + $fh->close; + return undef; + } + + my ($code, $output) = ("",""); + + until ( $code ) { + $output = $self->_read_line or $fh->close, return undef; + foreach my $o (@$output) { + $self->_record($count,$o); # $o is already an array ref + ($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i; + if ($o->[DATA] =~ /^\*\s+BYE/) { + carp $o->[DATA]; + $self->State(Unconnected); + $fh->close; + return undef ; + } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { + carp $o->[DATA]; + $fh->close; + return undef; + } + } + } + + { # Narrow scope + # Slurp up headers: later we'll make this more efficient I guess + local $/ = "\x0d\x0a\x0d\x0a"; + my $text = <$fh>; + $text =~ s/\x0d?\x0a/\x0d\x0a/g; + $self->_record($count,[ $self->_next_index($count), "INPUT", "{From file $file}" ] ) ; + $feedback = $self->_send_line($text); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + $fh->close; + return undef; + } + _debug($self, "control points to $$control\n") if ref($control) and $self->Debug; + $/ = ref($control) ? "\x0a" : $control ? $control : "\x0a"; + while (defined($text = <$fh>)) { + $text =~ s/\x0d?\x0a/\x0d\x0a/g; + $self->_record( $count, + [ $self->_next_index($count), "INPUT", "{from $file}\x0d\x0a" ] + ); + $feedback = $self->_send_line($text,1); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + $fh->close; + return undef; + } + } + $feedback = $self->_send_line("\x0d\x0a"); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + $fh->close; + return undef; + } + } + + # Now for the crucial test: Did the append work or not? + ($code, $output) = ("",""); + + my $uid = undef; + until ( $code ) { + $output = $self->_read_line or return undef; + foreach my $o (@$output) { + $self->_record($count,$o); # $o is already an array ref + $self->_debug("append_file: Deciding if " . $o->[DATA] . " has the code.\n") + if $self->Debug; + ($code) = $o->[DATA] =~ /^\d+\s(NO|BAD|OK)/i; + # try to grab new msg's uid from o/p + $o->[DATA] =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1; + if ($o->[DATA] =~ /^\*\s+BYE/) { + carp $o->[DATA]; + $self->State(Unconnected); + $fh->close; + return undef ; + } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { + carp $o->[DATA]; + $fh->close; + return undef; + } + } + } + $fh->close; + + if ($code !~ /^OK/i) { + return undef; + } + + + return defined($uid) ? $uid : $self; +}; + + + + +*Mail::IMAPClient::fetch_hash = sub { + # taken from original lib, + # just added split code. + my $self = shift; + my $hash = 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 = scalar($self->messages); + 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 ( exists $hash->{$uid} ) { + $entry = $hash->{$uid} ; + } + else { + $hash->{$uid} ||= $entry; + } + } + else { + my($mid) = $l =~ /^\* (\d+) FETCH/i; + next unless $mid; + if ( exists $hash->{$mid} ) { + $entry = $hash->{$mid} ; + } + else { + $hash->{$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 : $hash; +}; + + + +*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 ; + +}; + + + +*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' : '' ) ; + + $self->fetch($msg,$cmd) or return undef; + + my $string = ""; + + foreach my $result (@{$self->{"History"}{$self->Transaction}}) { + $string .= $result->[DATA] + if defined($result) and $self->_is_literal($result) ; + } + + # BUG? should probably return undef if length != expected + # No bug, somme servers are buggy. + + if (! $self->Ignoresizeerrors ) { + if ( length($string) != $expected_size ) { + warn "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::exists = sub { + 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 ); + + # 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 ) ); + } + + 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" ; + + $self->_record($count,[ 0, "INPUT", "$string\x0d\x0a"] ); + + 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 ; + } + } + } + + # $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 "" + + ) { + 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; + + # $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) +} + +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 ($self->Tls) { + $debug and print "Calling starttls\n"; + + my $banner = starttls($self); + $debug and print "End starttls: $banner\n"; + } + + $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"; + my $banner = $self->Banner(); + $debug and print $banner; + unless ($banner =~ /^\* OK \[CAPABILITY.*STARTTLS.*\]/) { + die_clean( "No STARTTLS capability: $banner" ); + } + print $socket, "\n"; + print $socket "z00 STARTTLS\015\012"; + my $txt = $socket->getline(); + $debug and print "Read: $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"; + } + $banner; +} + +# 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; + 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; +} + +sub fetch_hash_2 { + # 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; +} diff --git a/test.bat b/test.bat index c39cce2..9751900 100755 --- a/test.bat +++ b/test.bat @@ -1,17 +1,10 @@ -REM $Id: test.bat,v 1.6 2010/08/15 11:10:49 gilles Exp gilles $ +REM $Id: test.bat,v 1.7 2010/10/08 01:43:35 gilles Exp gilles $ cd C:\msys\1.0\home\Admin\imapsync perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mDate::Manip -mFile::Spec -mDigest::HMAC_MD5 -e '' -set TZ="GMT" -REM perl ./imapsync --host1 l --user1 toto --passfile1 secret.toto --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 -REM perl ./imapsync --host1 l --user1 tata --passfile1 secret.tata --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 --folder INBOX +perl ./imapsync +perl ./imapsync --host1 l --user1 toto --passfile1 secret.toto --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 +perl ./imapsync --host1 l --user1 tata --passfile1 secret.tata --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 --folder INBOX -REM -M Date::Manip 6.xx buggy? -pp -o imapsync.exe -M Term::ReadKey -M IO::Socket::SSL -M Digest::HMAC_MD5 imapsync - -echo Checking imapsync.exe -.\imapsync.exe --host1 l --user1 toto --passfile1 secret.toto --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 -.\imapsync.exe --host1 l --user1 tata --passfile1 secret.tata --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 --folder INBOX -echo Done Checking imapsync.exe diff --git a/test_exe.bat b/test_exe.bat index 99adbae..c302ed4 100755 --- a/test_exe.bat +++ b/test_exe.bat @@ -3,6 +3,7 @@ cd C:\msys\1.0\home\Admin\imapsync perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mFile::Spec -mDigest::HMAC_MD5 -e '' -.\imapsync.exe --host1 l --user1 toto --passfile1 secret.toto --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 -.\imapsync.exe --host1 l --user1 tata --passfile1 secret.tata --host2 l --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 --folder INBOX +.\imapsync.exe +.\imapsync.exe --host1 p --user1 toto --passfile1 secret.toto --host2 p --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 +.\imapsync.exe --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --noauthmd5 --delete2 --expunge2 --folder INBOX diff --git a/test_exe_2.bat b/test_exe_2.bat new file mode 100644 index 0000000..c2df1e6 --- /dev/null +++ b/test_exe_2.bat @@ -0,0 +1,2 @@ +imapsync \ --host1 p --user1 toto --passfile1 secret.toto \ --host2 p --user2 titi --passfile2 secret.titi +imapsync \ --host1 p --user1 tata --passfile1 secret.tata \ --host2 p --user2 titi --passfile2 secret.titi diff --git a/tests.sh b/tests.sh index 5925037..1402eb2 100644 --- a/tests.sh +++ b/tests.sh @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: tests.sh,v 1.116 2010/09/06 01:06:52 gilles Exp gilles $ +# $Id: tests.sh,v 1.127 2010/10/25 17:59:09 gilles Exp gilles $ # Example 1: # CMD_PERL='perl -I./Mail-IMAPClient-3.25/lib' sh -x tests.sh @@ -8,8 +8,11 @@ # Example 2: # To select which Mail-IMAPClient within arguments: # sh -x tests.sh 2 locallocal 3 locallocal -# run locallocal() with Mail-IMAPClient-2.2.9 then +# This runs locallocal() with Mail-IMAPClient-2.2.9 then # again with Mail-IMAPClient-3.xx +# 2 means "use Mail-IMAPClient-2.2.9" +# 3 means "use Mail-IMAPClient-3.xx" + HOST1=${HOST1:-'localhost'} echo HOST1=$HOST1 @@ -86,10 +89,14 @@ no_args() { # mailbox tata titi on most ll_*() tests -# mailbox tete@est.belle # used on big size tests -# big_transfert() -# big_transfert_sizes_only() -# dprof() +# mailbox tete@est.belle used on big size tests: +# big_transfert() +# big_transfert_sizes_only() +# dprof() + +# mailbox big1 big2 used on bigmail tests +# ll_bigmail() +# ll_memory_consumption sendtestmessage() { email=${1:-"tata"} @@ -122,6 +129,10 @@ option_tests() { $CMD_PERL ./imapsync --tests } +option_tests_debug() { + $CMD_PERL ./imapsync --tests_debug +} + option_bad_delete2() { ! $CMD_PERL ./imapsync --delete 2 --blabla } @@ -145,8 +156,7 @@ first_sync() { --passfile1 ../../var/pass/secret.toto \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --noauthmd5 \ - --allow3xx + --noauthmd5 } @@ -162,11 +172,10 @@ locallocal() { --host1 $HOST1 --user1 tata \ --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ - --passfile2 ../../var/pass/secret.titi \ - --allow3xx + --passfile2 ../../var/pass/secret.titi } -ll_pidfile() { +pidfile() { $CMD_PERL ./imapsync \ --justbanner \ @@ -174,6 +183,17 @@ ll_pidfile() { ! test -f /var/tmp/imapsync.pid } +justbanner() { + $CMD_PERL ./imapsync \ + --justbanner +} + +nomodules_version() { + $CMD_PERL ./imapsync \ + --justbanner \ + --nomodules_version +} + ll_ask_password() { @@ -204,8 +224,7 @@ ll_timeout_ssl() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --folder INBOX --timeout 5 --ssl1 --ssl2 \ - --allow3xx + --folder INBOX --timeout 5 --ssl1 --ssl2 } @@ -217,8 +236,7 @@ ll_folder() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --folder INBOX.yop --folder INBOX.Trash \ - --allow3xx + --folder INBOX.yop --folder INBOX.Trash } ll_oneemail() { @@ -246,8 +264,7 @@ ll_folderrec() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --folderrec INBOX.yop \ - --allow3xx + --folderrec INBOX.yop } @@ -258,8 +275,7 @@ ll_buffersize() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --buffersize 8 \ - --allow3xx + --buffersize 8 } @@ -269,19 +285,31 @@ ll_justfolders() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --justfolders \ - --allow3xx + --justfolders --nofoldersizes echo "rm -rf /home/vmail/titi/.new_folder/" } + +ll_delete2folders() { + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --justfolders --nofoldersizes \ + --delete2folders +} + + + + ll_bug_folder_name_with_blank() { $CMD_PERL ./imapsync \ --host1 $HOST1 --user1 tata \ --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --justfolders \ - --allow3xx + --justfolders echo "rm -rf /home/vmail/titi/.bugs/" } @@ -294,8 +322,7 @@ ll_prefix12() { --passfile2 ../../var/pass/secret.titi \ --folder INBOX.qqq \ --prefix1 INBOX.\ - --prefix2 INBOX. \ - --allow3xx + --prefix2 INBOX. } @@ -342,8 +369,7 @@ ll_idatefromheader() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --folder INBOX.oneemail \ - --idatefromheader --debug --dry \ - --allow3xx + --idatefromheader --debug --dry } @@ -354,8 +380,7 @@ ll_folder_rev() { --passfile1 ../../var/pass/secret.titi \ --host2 $HOST2 --user2 tata \ --passfile2 ../../var/pass/secret.tata \ - --folder INBOX.yop \ - --allow3xx + --folder INBOX.yop } ll_subscribed() @@ -365,8 +390,7 @@ ll_subscribed() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --subscribed \ - --allow3xx + --subscribed } @@ -377,8 +401,7 @@ ll_subscribe() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --subscribed --subscribe \ - --allow3xx + --subscribed --subscribe } ll_justconnect() @@ -386,8 +409,7 @@ ll_justconnect() $CMD_PERL ./imapsync \ --host2 $HOST2 \ --host1 $HOST1 \ - --justconnect \ - --allow3xx + --justconnect } ll_justfoldersizes() @@ -432,8 +454,7 @@ ll_authmd5() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --justlogin --authmd5 \ - --allow3xx + --justlogin --authmd5 } ll_noauthmd5() @@ -443,11 +464,12 @@ ll_noauthmd5() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --justfoldersizes --noauthmd5 \ - --allow3xx + --justlogin --noauthmd5 } + + ll_maxage() { can_send && sendtestmessage @@ -499,8 +521,7 @@ ll_maxsize() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --maxsize 10 \ - --allow3xx + --maxsize 10 } ll_skipsize() @@ -517,8 +538,7 @@ ll_skipsize() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --skipsize --folder INBOX.yop.yap \ - --allow3xx + --skipsize --folder INBOX.yop.yap } ll_skipheader() @@ -535,7 +555,7 @@ ll_skipheader() --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --skipheader '^X-.*|^Date' --folder INBOX.yop.yap \ - --allow3xx --debug + --debug } @@ -553,8 +573,7 @@ ll_include() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --include '^INBOX.yop' \ - --allow3xx + --include '^INBOX.yop' } ll_exclude() @@ -570,8 +589,7 @@ ll_exclude() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --exclude '^INBOX.yop' \ - --allow3xx + --exclude '^INBOX.yop' } @@ -637,8 +655,7 @@ ll_sep2() --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --folder INBOX.yop.yap \ - --sep2 '\\' --dry \ - --allow3xx + --sep2 '\\' --dry } ll_bad_login() @@ -647,8 +664,7 @@ ll_bad_login() --host1 $HOST1 --user1 toto \ --passfile1 ../../var/pass/secret.toto \ --host2 $HOST2 --user2 notiti \ - --passfile2 ../../var/pass/secret.titi \ - --allow3xx + --passfile2 ../../var/pass/secret.titi } @@ -658,8 +674,7 @@ ll_bad_host() --host1 badhost --user1 toto \ --passfile1 ../../var/pass/secret.toto \ --host2 badhost --user2 titi \ - --passfile2 ../../var/pass/secret.titi \ - --allow3xx + --passfile2 ../../var/pass/secret.titi } @@ -670,8 +685,7 @@ ll_bad_host_ssl() --passfile1 ../../var/pass/secret.toto \ --host2 badhost --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --ssl1 --ssl2 \ - --allow3xx + --ssl1 --ssl2 } @@ -684,9 +698,8 @@ ll_useheader() --passfile2 ../../var/pass/secret.titi \ --folder INBOX.yop.yap \ --useheader 'Message-ID' \ - --dry --debug \ - --allow3xx - echo 'rm /home/vmail/tata/.yop.yap/cur/*' + --dry --debug + echo 'rm /home/vmail/titi/.yop.yap/cur/*' } @@ -703,8 +716,7 @@ ll_regexmess() --folder INBOX.yop.yap \ --regexmess 's/\157/O/g' \ --regexmess 's/p/Z/g' \ - --debug \ - --allow3xx + --debug if can_send; then file=`ls -t /home/vmail/titi/.yop.yap/cur/* | tail -1` @@ -723,8 +735,7 @@ ll_regexmess_scwchu() --folder INBOX.scwchu \ --regexmess 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nReceived: From; $2}gxms' \ --skipsize --skipheader 'Received: From;' \ - --debug \ - --allow3xx + --debug echo 'rm /home/vmail/titi/.scwchu/cur/*' } @@ -802,8 +813,8 @@ ll_regex_flag_keep_only() ll_tls_justconnect() { $CMD_PERL ./imapsync \ - --host1 l \ - --host2 l \ + --host1 $HOST1 \ + --host2 $HOST2 \ --tls1 --tls2 \ --justconnect --debug } @@ -869,8 +880,7 @@ ll_ssl() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --ssl1 --ssl2 \ - --allow3xx + --ssl1 --ssl2 } ll_authmech_PLAIN() { @@ -880,8 +890,7 @@ ll_authmech_PLAIN() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --justfoldersizes --nofoldersizes \ - --authmech1 PLAIN --authmech2 PLAIN \ - --allow3xx + --authmech1 PLAIN --authmech2 PLAIN } @@ -893,13 +902,10 @@ ll_authuser() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --justfoldersizes --nofoldersizes \ - --authuser2 titi \ - --allow3xx + --authuser2 titi } - - ll_authmech_LOGIN() { $CMD_PERL ./imapsync \ @@ -908,8 +914,7 @@ ll_authmech_LOGIN() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --justfoldersizes --nofoldersizes \ - --authmech1 LOGIN --authmech2 LOGIN \ - --allow3xx + --authmech1 LOGIN --authmech2 LOGIN } ll_authmech_CRAMMD5() { @@ -919,8 +924,7 @@ ll_authmech_CRAMMD5() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --justfoldersizes --nofoldersizes \ - --authmech1 CRAM-MD5 --authmech2 CRAM-MD5 \ - --allow3xx + --authmech1 CRAM-MD5 --authmech2 CRAM-MD5 } ll_delete2() { @@ -933,7 +937,7 @@ ll_delete2() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --folder INBOX \ - --delete2 --expunge2 + --delete2 --expunge2 } ll_delete() { @@ -952,12 +956,23 @@ ll_delete() { ll_bigmail() { $CMD_PERL ./imapsync \ - --host1 $HOST1 --user1 tata \ - --passfile1 ../../var/pass/secret.tata \ - --host2 $HOST2 --user2 titi \ - --passfile2 ../../var/pass/secret.titi \ + --host1 $HOST1 --user1 big1 \ + --passfile1 ../../var/pass/secret.big1 \ + --host2 $HOST2 --user2 big2 \ + --passfile2 ../../var/pass/secret.big2 \ --folder INBOX.bigmail - echo 'sudo rm -v /home/vmail/titi/.bigmail/cur/*' + echo 'sudo rm -v /home/vmail/big2/.bigmail/cur/*' +} + +ll_memory_consumption() { + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 big1 \ + --passfile1 ../../var/pass/secret.big1 \ + --host2 $HOST2 --user2 big2 \ + --passfile2 ../../var/pass/secret.big2 \ + --folder INBOX.bigmail2 \ + --nofoldersizes + echo 'sudo rm -v /home/vmail/big2/.bigmail2/cur/*' } @@ -995,27 +1010,22 @@ msw2() { gmail() { $CMD_PERL ./imapsync \ - --allow3xx \ --host1 imap.gmail.com \ --ssl1 \ + --authmech1 LOGIN \ --user1 gilles.lamiral@gmail.com \ --passfile1 ../../var/pass/secret.gilles_gmail \ --host2 $HOST2 \ - --ssl2 \ --user2 tata \ --passfile2 ../../var/pass/secret.tata \ - --useheader 'Message-Id' --skipsize \ - --regextrans2 's/\[Gmail\]/Gmail/' \ - --authmech1 LOGIN \ - --allowsizemismatch - #--dry # --debug --debugimap # --authmech1 LOGIN - + --useheader 'Message-Id' \ + --useheader="X-Gmail-Received" \ + --regextrans2 's/\[Gmail\]/Gmail/' } gmail_gmail() { $CMD_PERL ./imapsync \ - --allow3xx \ --host1 imap.gmail.com \ --ssl1 \ --user1 gilles.lamiral@gmail.com \ @@ -1029,13 +1039,11 @@ gmail_gmail() { --folder INBOX \ --authmech1 LOGIN --authmech2 LOGIN \ --allowsizemismatch - #--dry # --debug --debugimap # --authmech1 LOGIN } gmail_gmail2() { $CMD_PERL ./imapsync \ - --allow3xx \ --host1 imap.gmail.com \ --ssl1 \ --user1 gilles.lamiral@gmail.com \ @@ -1084,8 +1092,7 @@ archiveopteryx_1() { --passfile1 ../../var/pass/secret.aox_je \ --host2 lupus.aox.org --user2 je \ --passfile2 ../../var/pass/secret.aox_je \ - --folder INBOX --regextrans2 's/INBOX/copy/' \ - --allow3xx + --folder INBOX --regextrans2 's/INBOX/copy/' } ll_justlogin() { @@ -1096,7 +1103,7 @@ ll_justlogin() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --allow3xx --justlogin --noauthmd5 + --justlogin --noauthmd5 } ll_justlogin_backslash_char() { @@ -1107,7 +1114,7 @@ ll_justlogin_backslash_char() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 tptp@est.belle \ --passfile2 ../../var/pass/secret.tptp \ - --allow3xx --justlogin --noauthmd5 + --justlogin --noauthmd5 } @@ -1210,172 +1217,6 @@ dprof_bigmail() - -essnet_justconnect() -{ -./imapsync \ - --host1 mail2.softwareuno.com \ - --user1 gilles@mail2.softwareuno.com \ - --passfile1 ../../var/pass/secret.prw \ - --host2 mail.softwareuno.com \ - --user2 gilles@softwareuno.com \ - --passfile2 ../../var/pass/secret.prw \ - --dry --noauthmd5 --sep1 / --foldersizes --justconnect -} - -essnet_mail2_mail() -{ -./imapsync \ - --host1 mail2.softwareuno.com \ - --user1 gilles@mail2.softwareuno.com \ - --passfile1 ../../var/pass/secret.prw \ - --host2 mail.softwareuno.com \ - --user2 gilles@softwareuno.com \ - --passfile2 ../../var/pass/secret.prw \ - --noauthmd5 --sep1 / --foldersizes \ - --prefix2 "INBOX/" --regextrans2 's¤INBOX/INBOX¤INBOX¤' -} - -essnet_mail2_mail_t123() -{ - -for user1 in test1 test2 test3; do - ./imapsync \ - --host1 mail2.softwareuno.com \ - --user1 ${user1}@mail2.softwareuno.com \ - --passfile1 ../../var/pass/secret.prw \ - --host2 mail.softwareuno.com \ - --user2 gilles@softwareuno.com \ - --passfile2 ../../var/pass/secret.prw \ - --noauthmd5 --sep1 / --foldersizes \ - --prefix2 "INBOX/" --regextrans2 's¤INBOX/INBOX¤INBOX¤' \ - --debug \ - || true -done -} - - -essnet_plume2() -{ -./imapsync \ - --host1 mail2.softwareuno.com \ - --user1 gilles@mail2.softwareuno.com \ - --passfile1 ../../var/pass/secret.prw \ - --host2 plume --user2 tata \ - --passfile2 ../../var/pass/secret.tata \ - --noauthmd5 --sep1 / --foldersizes \ - --prefix2 INBOX. --regextrans2 's¤INBOX.INBOX¤INBOX¤' -} - -dynamicquest_1() -{ - -perl -I bugs/lib ./imapsync \ - --host1 69.38.48.81 \ - --user1 testuser1@dq.com \ - --passfile1 ../../var/pass/secret.dynamicquest \ - --host2 69.38.48.81 \ - --user2 testuser2@dq.com \ - --passfile2 ../../var/pass/secret.dynamicquest \ - --noauthmd5 --sep1 "/" --sep2 "/" \ - --justconnect --dry -} - -dynamicquest_2() -{ - -perl -I bugs/lib ./imapsync \ - --host1 mail.dynamicquest.com \ - --user1 gomez \ - --passfile1 ../../var/pass/secret.dynamicquestgomez \ - --host2 69.38.48.81 \ - --user2 testuser2@dq.com \ - --passfile2 ../../var/pass/secret.dynamicquest \ - --noauthmd5 \ - --justconnect --dry -} - -dynamicquest_3() -{ - -perl -I bugs/lib ./imapsync \ - --host1 loul \ - --user1 tata \ - --passfile1 ../../var/pass/secret.tata \ - --host2 69.38.48.81 \ - --user2 testuser2@dq.com \ - --passfile2 ../../var/pass/secret.dynamicquest \ - --noauthmd5 --sep2 "/" --debug --debugimap - -} - -mailenable() { - ./imapsync \ - --user1 imapsync@damashekconsulting.com \ - --host1 imap.damashekconsulting.com \ - --passfile1 ../../var/pass/secret.damashek \ - --sep1 "." --prefix1 "" \ - --host2 $HOST2 --user2 toto \ - --passfile2 ../../var/pass/secret.toto \ - --noauthmd5 -} - -ariasolutions() { - ./imapsync \ - --host1 209.17.174.20 \ - --user1 chrisw@canadapack.com \ - --passfile1 ../../var/pass/secret.ariasolutions \ - --host2 209.17.174.20 \ - --user2 chrisw@canadapack.com \ - --passfile2 ../../var/pass/secret.ariasolutions \ - --dry --noauthmd5 --justfoldersizes - - ./imapsync \ - --host1 209.17.174.20 \ - --user1 test@domain.local \ - --passfile1 ../../var/pass/secret.ariasolutions \ - --host2 209.17.174.20 \ - --user2 test@domain.local \ - --passfile2 ../../var/pass/secret.ariasolutions \ - --dry --noauthmd5 --ssl1 - -# hang after auth failure - ./imapsync \ - --host1 209.17.174.20 \ - --user1 test@domain.local \ - --passfile1 ../../var/pass/secret.ariasolutions \ - --host2 209.17.174.20 \ - --user2 test@domain.local \ - --passfile2 ../../var/pass/secret.ariasolutions \ - --dry --debug --debugimap - -} - - -ariasolutions2() { - ./imapsync \ - --host1 209.17.174.12 \ - --user1 chrisw@basebuilding.net \ - --passfile1 ../../var/pass/secret.ariasolutions2 \ - --host2 209.17.174.20 \ - --user2 chrisw@basebuilding.net\ - --passfile2 ../../var/pass/secret.ariasolutions2 \ - --noauthmd5 --syncinternaldates - # --dry --debug --debugimap - - -} - -genomics() { - -# Blocked, timeout ignored -./imapsync \ - --host1 mail.genomics.org.cn --user1 lamiral --passfile1 ../../var/pass/secret.genomics \ - --host2 szmail.genomics.cn --user2 lamiral --passfile2 ../../var/pass/secret.genomics \ - --sep1 . --prefix1 'INBOX.' --folder INBOX --useheader 'Message-Id' --expunge --skipsize \ - --timeout 7 --debug --debugimap - -} ########################## ########################## @@ -1385,12 +1226,18 @@ mandatory_tests=' no_args option_version option_tests +option_tests_debug option_bad_delete2 passwords_masked first_sync_dry first_sync locallocal -ll_pidfile +pidfile +justbanner +nomodules_version +gmail +gmail_gmail +gmail_gmail2 ll_ask_password ll_bug_folder_name_with_blank ll_timeout @@ -1439,18 +1286,21 @@ ll_authuser ll_delete2 ll_delete ll_folderrec -ll_bigmail -gmail -gmail_gmail -gmail_gmail2 -archiveopteryx_1 allow3xx noallow3xx -ll_newmessage' +ll_memory_consumption +ll_newmessage +ll_delete2folders +' other_tests=' +archiveopteryx_1 msw -ll_justlogin_backslash_char' +msw2 +ll_bigmail +ll_justlogin_backslash_char +option_tests_debug +' l() { echo "$mandatory_tests" "$other_tests"