diff --git a/CREDITS b/CREDITS index 57706c3..bbf7e08 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.187 2016/03/07 02:08:16 gilles Exp gilles $ +# $Id: CREDITS,v 1.190 2017/01/25 23:58:21 gilles Exp gilles $ If you want to make a donation to me, imapsync author, Gilles LAMIRAL, use any of the following ways: @@ -24,6 +24,11 @@ I thank very much all of these people. I thank also very much all people who bought imapsync from the homepage but I don't cite them here. +Sean McDougall from New Brunswick, Ian Thomas & Matt Wilks from Toronto +Sean found the solution and wrote the FAQ item in FAQ.Exchange.txt +"NO Maximum size of appendable message has been exceeded" +and Ian & Matt reported it to me. + Joe Pruett Bugfix about delete_message_on_host1() not using --noexpungeaftereach diff --git a/ChangeLog b/ChangeLog index 666a024..a4c54b6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,515 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.727 +head: 1.836 branch: locks: strict - gilles: 1.727 + gilles: 1.836 access list: symbolic names: keyword substitution: kv -total revisions: 727; selected revisions: 727 +total revisions: 836; selected revisions: 836 description: ---------------------------- -revision 1.727 locked by: gilles; +revision 1.836 locked by: gilles; +date: 2017/09/05 16:14:53; author: gilles; state: Exp; lines: +189 -182 +Reread the README part. Changed order, rewrote some parts, added options. +---------------------------- +revision 1.835 +date: 2017/09/03 04:11:31; author: gilles; state: Exp; lines: +53 -92 +Reviewed the pod part that goes to README +---------------------------- +revision 1.834 +date: 2017/08/31 04:14:04; author: gilles; state: Exp; lines: +18 -15 +Some crit level 4 fixed. +---------------------------- +revision 1.833 +date: 2017/08/31 01:58:57; author: gilles; state: Exp; lines: +9 -305 +Removed sub usage_old() +---------------------------- +revision 1.832 +date: 2017/08/31 01:47:48; author: gilles; state: Exp; lines: +285 -127 +Rewrote sub usage() and use Pod::Usage now. +Dependency added: Pod::Usage +ID on by default now. Use --noid to avoid it. +Splited sub tests_mailimapclient_connect() to put pure ipv6 test in sub tests_mailimapclient_connect_bug() which is not +run with --tests +Added some warning in --testsunit when sub called do not exist. +---------------------------- +revision 1.831 +date: 2017/08/27 01:52:48; author: gilles; state: Exp; lines: +17 -14 +Updated from OPTIONS file +---------------------------- +revision 1.830 +date: 2017/08/27 01:27:49; author: gilles; state: Exp; lines: +35 -35 +Inline help to remove sslcheck +---------------------------- +revision 1.829 +date: 2017/08/23 12:40:10; author: gilles; state: Exp; lines: +14 -12 +Bugfix. Fixed guess \ separator. +---------------------------- +revision 1.828 +date: 2017/08/22 22:06:27; author: gilles; state: Exp; lines: +10 -10 +Syntax fix +---------------------------- +revision 1.827 +date: 2017/08/22 22:04:38; author: gilles; state: Exp; lines: +12 -12 +Increased gmail1 maxbytespersecond to 40_000 +Increased gmail2 maxbytespersecond to 20_000 +---------------------------- +revision 1.826 +date: 2017/08/22 21:55:26; author: gilles; state: Exp; lines: +13 -11 +Added \ separator guess. List is now . / \\ and \ +---------------------------- +revision 1.825 +date: 2017/07/26 19:05:56; author: gilles; state: Exp; lines: +19 -10 +Skip ipv6 tests on cuillere. +Skip a connect in void context on macosx polarhome, it stalls. +---------------------------- +revision 1.824 +date: 2017/07/24 08:04:18; author: gilles; state: Exp; lines: +22 -21 +Better output for failed tests. +---------------------------- +revision 1.823 +date: 2017/07/21 23:55:17; author: gilles; state: Exp; lines: +53 -20 +Better output in sub tests_mailimapclient_connect() +---------------------------- +revision 1.822 +date: 2017/07/20 23:22:08; author: gilles; state: Exp; lines: +11 -11 +Bugfix. --skipmess could not work most of the time. +---------------------------- +revision 1.821 +date: 2017/07/18 00:16:43; author: gilles; state: Exp; lines: +24 -26 +Bugfix. Guess prefix '' even when there is no folders. +---------------------------- +revision 1.820 +date: 2017/07/11 12:12:49; author: gilles; state: Exp; lines: +14 -14 +loadavg on Win32 => 0 => unknown. +---------------------------- +revision 1.819 +date: 2017/07/07 23:21:45; author: gilles; state: Exp; lines: +70 -27 +Added --testslive6 to check ipv6 connectivity +---------------------------- +revision 1.818 +date: 2017/07/06 03:06:36; author: gilles; state: Exp; lines: +42 -27 +Removed from --tests call to: + tests_imapsping() + tests_tcpping() + tests_resolv() + tests_resolvrev() +---------------------------- +revision 1.817 +date: 2017/07/05 21:58:42; author: gilles; state: Exp; lines: +30 -22 +--ipv4 is now synonim of --inet4 +--ipv6 is now synonim of --inet6 +---------------------------- +revision 1.816 +date: 2017/07/05 14:50:28; author: gilles; state: Exp; lines: +101 -16 +Added dependency use IO::Socket::INET6 +Added sub probe_imapssl(). Not use yet. Will replace imapsping() +---------------------------- +revision 1.815 +date: 2017/06/27 16:45:20; author: gilles; state: Exp; lines: +10 -10 +MAX_SLEEP 30 => 2 +---------------------------- +revision 1.814 +date: 2017/06/26 22:50:41; author: gilles; state: Exp; lines: +213 -66 +Added raw LIST folders. +Added IP print of both hosts, using peerhost(). +Added sub resolv() and others but not using them for now. +Still a problem with IPv6 on port 143 only, 993 with ssl is ok. "Invalid argument" when connecting. + Solved with Mail::IMAPClient patched like this: + use IO::Socket::INET6 instead of IO::Socket::INET +---------------------------- +revision 1.813 +date: 2017/05/24 17:46:13; author: gilles; state: Exp; lines: +93 -38 +Added --maxsleep in order to avoid timeouts with --maxbytespersecond and --maxmessagespersecond +Default is like --maxsleep 30 +30 seconds sleeping at max. +---------------------------- +revision 1.812 +date: 2017/05/23 21:12:37; author: gilles; state: Exp; lines: +10 -10 +941 unit tests. +---------------------------- +revision 1.811 +date: 2017/05/23 21:10:12; author: gilles; state: Exp; lines: +24 -24 +Sync also messages with no internal date. +No blanks in automatic logfile name. +---------------------------- +revision 1.810 +date: 2017/05/02 18:46:30; author: gilles; state: Exp; lines: +10 -10 +Fixed a test in tests_umask_str() in order to pass it on Darwin +---------------------------- +revision 1.809 +date: 2017/05/02 18:34:34; author: gilles; state: Exp; lines: +45 -45 +Isolated bad tests in notmatch() and match(): q{} against q{}, so commented now. +---------------------------- +revision 1.808 +date: 2017/05/02 17:35:25; author: gilles; state: Exp; lines: +160 -75 +Better tests ending in exe in case of failure (was 0 I do not know why, a PAR bug) +Report which tests failed at the end of tests. +---------------------------- +revision 1.807 +date: 2017/04/28 13:43:07; author: gilles; state: Exp; lines: +30 -25 +testsunit() isolated. +---------------------------- +revision 1.806 +date: 2017/04/28 09:50:40; author: gilles; state: Exp; lines: +81 -31 +Added --testsunit in order to run any unit test individualy from the command line. +Several --testsunit are allowed. Example: + imapsync --testsunit tests_true --testsunit tests_always_fail +---------------------------- +revision 1.805 +date: 2017/04/27 13:04:58; author: gilles; state: Exp; lines: +50 -40 +Added test to mkpath with trailing dots foo... in folder name for --usecache. +It does not fail. +---------------------------- +revision 1.804 +date: 2017/04/27 00:39:51; author: gilles; state: Exp; lines: +10 -10 +Fix number of fake test on Win32. +---------------------------- +revision 1.803 +date: 2017/04/26 17:52:34; author: gilles; state: Exp; lines: +123 -119 +Perl crit fixes: +* $! $OS_ERROR +* $@ $EVAL_ERROR +many others. +---------------------------- +revision 1.802 +date: 2017/04/25 16:13:33; author: gilles; state: Exp; lines: +231 -229 +crit about blanks +---------------------------- +revision 1.801 +date: 2017/04/24 20:51:00; author: gilles; state: Exp; lines: +116 -75 +Bugfix. logfile must not have / from user1 and user2. +---------------------------- +revision 1.800 +date: 2017/04/24 13:51:44; author: gilles; state: Exp; lines: +19 -18 +Bugfix. passfile1 passfile2 failure only if used! +---------------------------- +revision 1.799 +date: 2017/04/24 12:47:34; author: gilles; state: Exp; lines: +20 -10 +Check passfile exist before reading it and exit on failure. +---------------------------- +revision 1.798 +date: 2017/04/24 02:41:46; author: gilles; state: Exp; lines: +61 -29 +Make all tests run on MSWin32, either success or skip +---------------------------- +revision 1.797 +date: 2017/04/23 13:35:47; author: gilles; state: Exp; lines: +353 -23 +Moved /etc/imapsync.hash to $CGI_HASHFILE => '/var/tmp/imapsync_hash' +Added note( 'Entering ...' ) and note( 'Leaving ...' ) to all tests_...() functions +---------------------------- +revision 1.796 +date: 2017/04/23 12:25:22; author: gilles; state: Exp; lines: +115 -28 +Added umask setting to 0077 in cgi context. +---------------------------- +revision 1.795 +date: 2017/04/22 13:01:28; author: gilles; state: Exp; lines: +55 -16 +Refactor. Replaced hard cgi context test $ENV{SERVER_SOFTWARE} by function call to under_cgi_context() +---------------------------- +revision 1.794 +date: 2017/04/15 16:59:24; author: gilles; state: Exp; lines: +10 -10 +871 unit tests +---------------------------- +revision 1.793 +date: 2017/04/15 16:56:06; author: gilles; state: Exp; lines: +136 -54 +Tests should pass under nobody in /var/tmp/ now. +---------------------------- +revision 1.792 +date: 2017/04/05 03:06:42; author: gilles; state: Exp; lines: +22 -22 +Added GMT setting to test setlogfile() +---------------------------- +revision 1.791 +date: 2017/04/05 02:27:50; author: gilles; state: Exp; lines: +26 -9 +Added docker context in order to be run under nobody without permission issues. +---------------------------- +revision 1.790 +date: 2017/04/04 11:27:09; author: gilles; state: Exp; lines: +10 -10 +Added 'Objets envoy&AOk-s' for --automap +---------------------------- +revision 1.789 +date: 2017/03/24 22:44:11; author: gilles; state: Exp; lines: +11 -9 +Fix issue "SSL routines:ssl3_check_cert_and_algorithm:dh key too small" with +http://stackoverflow.com/questions/36417224/openssl-dh-key-too-small-error +SSL_cipher_list => 'DEFAULT:!DH' +---------------------------- +revision 1.788 +date: 2017/03/20 23:26:26; author: gilles; state: Exp; lines: +10 -10 +852 unit tests +---------------------------- +revision 1.787 +date: 2017/03/20 23:23:39; author: gilles; state: Exp; lines: +130 -84 +Added --maxbytesafter in order to start --maxbytespersecond limitation only after --maxbytesafter amount of data transferred +---------------------------- +revision 1.786 +date: 2017/03/20 03:32:12; author: gilles; state: Exp; lines: +44 -39 +Bugfix. Abort on heavy load was not working because of load_and_delay strictly needed 4 arguments +---------------------------- +revision 1.785 +date: 2017/03/14 18:06:38; author: gilles; state: Exp; lines: +12 -10 +No systematic NOP! +---------------------------- +revision 1.784 +date: 2017/03/14 17:51:48; author: gilles; state: Exp; lines: +120 -30 +Changed abandon points (last FOLDER) to reconnection points. +---------------------------- +revision 1.783 +date: 2017/03/13 06:22:43; author: gilles; state: Exp; lines: +24 -90 +Removed Mail::IMAPClient ads! +---------------------------- +revision 1.782 +date: 2017/03/13 01:20:24; author: gilles; state: Exp; lines: +486 -384 +Added --domino1 --domino2 to facilitate Domino options setting. +Added password setting via environment variables IMAPSYNC_PASSWORD1 IMAPSYNC_PASSWORD2 +---------------------------- +revision 1.781 +date: 2017/03/09 12:50:07; author: gilles; state: Exp; lines: +30 -22 +Usability. No more "... says it has NO CAPABILITY for AUTHENTICATE LOGIN" +---------------------------- +revision 1.780 +date: 2017/03/09 11:00:05; author: gilles; state: Exp; lines: +54 -20 +Added --office1 --office2 to load simplify sync from and to office 365 (parameters from the FAQ.d/FAQ.Exchange.txt) +---------------------------- +revision 1.779 +date: 2017/03/07 13:05:02; author: gilles; state: Exp; lines: +85 -65 +Removed most of the perlcrit (Severity: 3) Regular expression without "/x" flag +---------------------------- +revision 1.778 +date: 2017/03/02 00:22:59; author: gilles; state: Exp; lines: +125 -83 +Fixed some perlcrit level 4 +---------------------------- +revision 1.777 +date: 2017/03/01 01:25:58; author: gilles; state: Exp; lines: +20 -16 +Added memory_available +---------------------------- +revision 1.776 +date: 2017/02/28 22:58:38; author: gilles; state: Exp; lines: +89 -68 +Added tests_not_long_imapsync_version_public() +---------------------------- +revision 1.775 +date: 2017/02/17 01:54:27; author: gilles; state: Exp; lines: +27 -23 +loadavg on Win32 +---------------------------- +revision 1.774 +date: 2017/02/15 12:55:50; author: gilles; state: Exp; lines: +40 -25 +Bugfix. $tls1 and $tls2 vs $mysync->{tls1} $mysync->{tls2} somewhere +---------------------------- +revision 1.773 +date: 2017/02/14 23:21:05; author: gilles; state: Exp; lines: +155 -41 +Splited loadavg() in 3 calls loadavg_windows() loadavg_darwin() loadavg_linux() +Bugfix. Output "Load is" was not complete, miss the important 3 load values! +---------------------------- +revision 1.772 +date: 2017/02/01 01:31:22; author: gilles; state: Exp; lines: +14 -14 +Bugfix. Output Load is was inacurate +---------------------------- +revision 1.771 +date: 2017/01/31 22:10:51; author: gilles; state: Exp; lines: +10 -10 +Bugfix. gmail2() had bad regextrans2 +---------------------------- +revision 1.770 +date: 2017/01/29 21:48:44; author: gilles; state: Exp; lines: +52 -45 +Added $imap1->reconnect in case getting metadata from host2 is too long and host1 timesout. +Bugfix. getoption uses $mysync not $sync +---------------------------- +revision 1.769 +date: 2017/01/28 05:54:43; author: gilles; state: Exp; lines: +60 -61 +Removed global $dry and $dry_message => $sync->{dry} $sync->{dry_message} +---------------------------- +revision 1.768 +date: 2017/01/19 06:12:02; author: gilles; state: Exp; lines: +12 -11 +Bugfix. CGI context a newline was bad in $sync->{loadavg} +---------------------------- +revision 1.767 +date: 2017/01/19 05:53:02; author: gilles; state: Exp; lines: +11 -10 +use Net::Ping instead of just require. +---------------------------- +revision 1.766 +date: 2017/01/19 05:29:42; author: gilles; state: Exp; lines: +12 -12 +sslcheck localhost => imapsync.lamiral.info +---------------------------- +revision 1.765 +date: 2017/01/19 05:16:42; author: gilles; state: Exp; lines: +10 -10 +806 unit tests +---------------------------- +revision 1.764 +date: 2017/01/19 05:12:17; author: gilles; state: Exp; lines: +184 -59 +Added --sslcheck and made it on by default. Use --nosslcheck to unset it. +--sslcheck checks ssl port 993 and turn on ssl if it is open. +---------------------------- +revision 1.763 +date: 2017/01/19 00:49:43; author: gilles; state: Exp; lines: +10 -10 +792 unit tests +---------------------------- +revision 1.762 +date: 2017/01/19 00:46:30; author: gilles; state: Exp; lines: +113 -90 +--showpasswords now show also passwords with --debugimap +Load does not generate Perl warnings on Win32 +---------------------------- +revision 1.761 +date: 2017/01/17 06:08:49; author: gilles; state: Exp; lines: +12 -9 +debug for --gmail1 --gmail2 +---------------------------- +revision 1.760 +date: 2017/01/17 04:43:51; author: gilles; state: Exp; lines: +90 -11 +Added --gmail1 --gmail2 --gmail12 to simplify gmail syncs. It sets parameters from the FAQ --ssl --host etc. +Allow parameters passed by POST. +---------------------------- +revision 1.759 +date: 2017/01/16 13:20:57; author: gilles; state: Exp; lines: +10 -10 +Bugfix. Add / after CGI_TMPDIR_TOP +---------------------------- +revision 1.758 +date: 2017/01/15 19:34:42; author: gilles; state: Exp; lines: +71 -26 +Splitted get_options(). Now call either get_options_cgi() or get_options_cmd() +I applied David M advice, remove all but what is safe in the context. +---------------------------- +revision 1.757 +date: 2017/01/12 10:33:47; author: gilles; state: Exp; lines: +10 -10 +nb tests +---------------------------- +revision 1.756 +date: 2017/01/12 10:14:32; author: gilles; state: Exp; lines: +175 -154 +tmpdir is cgidir in cgi context. different for each account couple (host,user,pass). +---------------------------- +revision 1.755 +date: 2017/01/12 03:25:42; author: gilles; state: Exp; lines: +28 -22 +Now goes to TLS if STARTTLS is in CAPABILITY and ssl is off and notls is not there. +---------------------------- +revision 1.754 +date: 2017/01/11 06:43:05; author: gilles; state: Exp; lines: +11 -14 +*** empty log message *** +---------------------------- +revision 1.753 +date: 2017/01/11 04:59:22; author: gilles; state: Exp; lines: +280 -80 +Added load average from /proc/loadavg +Added abort if load is too heavy in cgi context. +---------------------------- +revision 1.752 +date: 2017/01/10 00:48:45; author: gilles; state: Exp; lines: +13 -13 +timestart with milliseconds. +---------------------------- +revision 1.751 +date: 2017/01/09 06:57:00; author: gilles; state: Exp; lines: +30 -36 +Added milliseconds in logfile name since in cgi context several runs is possible in one second. +---------------------------- +revision 1.750 +date: 2017/01/05 13:47:10; author: gilles; state: Exp; lines: +57 -36 +Added /dist/ link in releasecheck. +Added tests_check_last_release( ) +Made check_last_release() testable. +---------------------------- +revision 1.749 +date: 2017/01/05 03:18:01; author: gilles; state: Exp; lines: +10 -10 +*** empty log message *** +---------------------------- +revision 1.748 +date: 2017/01/05 01:48:34; author: gilles; state: Exp; lines: +166 -109 +Added cookie imapsync_runs in cgi context. +Refactor. $host1 $user1 $password1 $host2 $user2 $password2 under $sync now. +Added output() to delay some output in cgi context. +---------------------------- +revision 1.747 +date: 2016/12/24 15:38:49; author: gilles; state: Exp; lines: +152 -26 +Added sub rand32() +Added sub createhashfileifneeded() +Added sub hashsync() +Added sub hashsynclocal() +Temporary dir different for each individual sync but same dir if same parameters host1 host2 user1 user2 password1 password2 +---------------------------- +revision 1.746 +date: 2016/12/19 20:14:37; author: gilles; state: Exp; lines: +81 -23 +Extracted the $cgi object creation from sub myGetOptions() +Started sub tests_get_options_cgi() +Added tests to sub tests_get_options() +---------------------------- +revision 1.745 +date: 2016/12/14 23:12:37; author: gilles; state: Exp; lines: +102 -41 +Refactoring. get_options( @ARGV ) uses @ARGV as a parameter. +Refactoring. sub get_options() only gets options (use to add stuff about their values). +Refactoring. What was in sub get_options() has gone into sub after_get_options() +Refactoring. sub unsetunsafe( ) is now sub sub setcgicontext( ) and has more settings. +Bugfix. sub ask_for_password used <> which could open remaining options from @ARGS. Uses now +Refactoring. Use Getopt::Long::GetOptionsFromArray() instead of Getopt::Long::GetOptions() +Added test sub tests_get_options() +Refactoring. Added sub printenv() extracted code from sub get_options() +---------------------------- +revision 1.744 +date: 2016/12/13 13:04:21; author: gilles; state: Exp; lines: +105 -106 +Removed local package Imapsync::Getopt::Long +---------------------------- +revision 1.743 +date: 2016/12/12 11:43:46; author: gilles; state: Exp; lines: +60 -18 +Added --abort option to terminate a previous call still running. Useful in remote context, ie online. +---------------------------- +revision 1.742 +date: 2016/12/07 16:17:10; author: gilles; state: Exp; lines: +25 -11 +Added --simulong int. To simulate a long response in web context. +---------------------------- +revision 1.741 +date: 2016/11/22 21:27:43; author: gilles; state: Exp; lines: +10 -10 +Now print " could not append ( Subject:[$subject], Date:[$h1_date], Size:[$h1_size] ) " whn append fails. +---------------------------- +revision 1.740 +date: 2016/11/17 15:05:01; author: gilles; state: Exp; lines: +10 -10 +Print always permanentflags info. Was only in debug mode. +---------------------------- +revision 1.739 +date: 2016/11/03 20:31:10; author: gilles; state: Exp; lines: +87 -36 +Added sub tests_match( ). +Changed name sub tests_dontmatch( ) => tests_notmatch( ) +710 tests noregression. +---------------------------- +revision 1.738 +date: 2016/11/01 10:11:31; author: gilles; state: Exp; lines: +115 -59 +--expunge --expunge1 are pure aliases now (don't know why they were distinct). +---------------------------- +revision 1.737 +date: 2016/10/11 12:40:59; author: gilles; state: Exp; lines: +16 -16 +blanks +---------------------------- +revision 1.736 +date: 2016/10/10 21:02:49; author: gilles; state: Exp; lines: +3215 -3215 +all tabs converted to spaces. By notepad++ +---------------------------- +revision 1.735 +date: 2016/10/10 20:48:53; author: gilles; state: Exp; lines: +21 -21 +crit fix. open my +---------------------------- +revision 1.734 +date: 2016/10/10 14:05:09; author: gilles; state: Exp; lines: +60 -60 +Renamed sub is_valid_directory() to do_valid_directory() +Rewrote modulesversion() tp avoid no strict 'refs' usage. + use a closure instead +---------------------------- +revision 1.733 +date: 2016/10/09 21:38:44; author: gilles; state: Exp; lines: +166 -184 +Some crit fixes. +---------------------------- +revision 1.732 +date: 2016/09/29 20:56:35; author: gilles; state: Exp; lines: +106 -106 +Small perlcritics. +---------------------------- +revision 1.731 +date: 2016/09/29 12:24:56; author: gilles; state: Exp; lines: +32 -26 +Added --noabletosearch1 --noabletosearch2; Still support --noabletosearch, which turn on both --noabletosearch1 --noabletosearch2 +---------------------------- +revision 1.730 +date: 2016/09/17 14:30:45; author: gilles; state: Exp; lines: +32 -28 +Variable $delete is now $delete1 +Change doc --delete => --delete1 +--delete still supported, --delete1 and --delete are aliases. +---------------------------- +revision 1.729 +date: 2016/09/12 06:24:07; author: gilles; state: Exp; lines: +16 -14 +typo. +---------------------------- +revision 1.728 +date: 2016/08/30 11:38:30; author: gilles; state: Exp; lines: +11 -11 +Typo +---------------------------- +revision 1.727 date: 2016/08/19 10:30:36; author: gilles; state: Exp; lines: +53 -110 Bugfix. Fall back separator to / even when host has no mailbox at all. Usability. Better warning about default ssl SSL_VERIFY_NONE diff --git a/FAQ b/FAQ deleted file mode 100644 index e2bd740..0000000 --- a/FAQ +++ /dev/null @@ -1,724 +0,0 @@ -#!/bin/cat -# $Id: FAQ,v 1.224 2016/06/08 21:32:09 gilles Exp gilles $ - -+-------------------+ -| FAQs for imapsync | -+-------------------+ - -http://imapsync.lamiral.info/FAQ -http://imapsync.lamiral.info/FAQ.d/ - -Unix versus Windows syntax. -There are several differences between Unix and Windows -in the command line syntax. -- Character \ versus ^ -- Character ' versus " - - -A) \ versus ^ - -On Unix shells you can write a single command on multiple lines -by using the escape character \ at the end of each line -(except the last one). On Windows this character is ^ - -Unix example: - -./imapsync \ - --host1 imap.truc.org --user1 foo --password1 secret1 \ - --host2 imap.trac.org --user2 bar --password2 secret2 - - -Windows example: - -imapsync ^ - --host1 imap.truc.org --user1 foo --password1 secret1 ^ - --host2 imap.trac.org --user2 bar --password2 secret2 - - -Of course you can write the command on one only line without -characters \ nor ^. I use them because the output is -better, no truncation, pretty print. It's just sugar. - -In this FAQ I use \ for examples. Transcript to ^ if -you're on a Windows system. - -B) ' versus " - -On Windows the single quote character ' doesn't work -like on Unix so in the examples of this FAQ the -command containing single quotes ' will fail on Windows. -To fix it just replace single quotes ' by double quotes " - -Also on Windows, in examples with \$1 replace -any \$1 by $1 (remove the \ before $). - -======================================================================= -Q. How to verify imapsync.exe I got is the right file bit per bit? - -R. Use md5sum to check integrity of the file. - Get md5sum.exe at http://etree.org/md5com.html - - md5sum imapsync.exe - - Then compare the checksum with the one given by the author. - -======================================================================= -Q. How to install imapsync? - -R. Read the INSTALL files in the tarball also available at - http://imapsync.lamiral.info/INSTALL - http://imapsync.lamiral.info/INSTALL.d/ - -======================================================================= -Q. How to configure and run imapsync? - -R. Read the README, OPTIONS and FAQ files in the tarball also - available at: - http://imapsync.lamiral.info/README - http://imapsync.lamiral.info/OPTIONS - http://imapsync.lamiral.info/FAQ - -======================================================================= -Q. Can you give some configuration examples? - -R1. Basic usage is described there: - http://imapsync.lamiral.info/#DOC_BASIC - - imapsync --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ - --host2 test2.lamiral.info --user2 test2 --password2 secret2 - -R2. The FAQ files contains many examples for several scenarios - http://imapsync.lamiral.info/FAQ - -======================================================================= -Q. How can I have commercial support? - -R. Buy support from imapsync author and expert: Gilles LAMIRAL -http://imapsync.lamiral.info/#buy_all - -======================================================================= -Q. How can I have gratis support? - -R. Use the mailing-list - -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. - -======================================================================= -Q. Where I can find old imapsync releases? - -R. Search the Internet. - -======================================================================= -Q. Where I can find free open and gratis imapsync releases? - -R. Search the Internet. - -Q. Is is legal to find imapsync gratis (or not) elsewhere? - -R. Yes, the license permits it - http://imapsync.lamiral.info/NOLIMIT - -======================================================================= -Q. How "Facts and figures" are known on http://imapsync.lamiral.info/ - -R. To know wether a newer imapsync exists or not imapsync does a http - GET to http://imapsync.lamiral.info/VERSION - Via the User-agent parameter it also send: - - * imapsync release - * Perl version - * Mail::IMAPClient version - * Operating System - -You can remove this behavior by adding option --noreleasecheck on the -command line (or by setting $releasecheck = 0 in the source code) -or by using github release. - -======================================================================= -Q. I use --useuid which uses a cache in /tmp or --tmpdir, the hostnames - host1 or host2 has changed but mailboxes are the same. Will imapsync - generate duplicate messages on next runs? - -R. Yes - -Q. How can I fix this? - -R. The cache path reflects exactly hostnames or ip addresses given via - --host1 and --host2 values. So just change the directory names - of host1 or host2. Use --dry to see if next runs will generate - duplicates. - By default on Unix the cache is like - - /tmp/imapsync_cache/host1/user1/host2/user2/... - -======================================================================= -Q. How can I speed up transfers? - -R. By using --useuid imapsync avoid getting messages headers and build - a cache. On Unix a good thing is to add also --tmpdir /var/tmp - to keep the cache since /tmp is often cleared on reboot. - - imapsync ... --useuid - -On Unix: - - imapsync ... --useuid --tmpdir /var/tmp/ - -R. Add also --nofoldersizes since the default behavior is to compute - folder sizes. Folder sizes are useless for the transfer, just - useful to see what has to be done on each folder and guess when - the transfer will end (ETA). - -R. Add also --noexpungeaftereach if you use --delete. - But be warn that an interrupted transfer can loose messages - on host2 in a second run if you use a (silly) combination like - - imapsync ... --delete --noexpunge --noexpungeaftereach --expunge2 - -R. Add also --nocheckmessageexists - --nocheckmessageexists is on by default since release 1.520. - Since transfer can be long on a huge mailbox imapsync checks - a message exist before copying it, but it takes time and - cpu on the host1 server. - - -Notes about --useuid - -Case where building the cache first is necessary (to avoid multiples transfers) - -If you run again imapsync with --useuid on a transfer already done without ---useuid then, to avoid messages be copied again, first run imapsync -with --usecache but without --useuid, example scenario: - -A] Running with the default options, I began without --useuid - -1) First run with default options - - imapsync ... - -Too slow, I want to speed up! - -2) Build the cache - - imapsync ... --usecache - -3) Speed up now - - imapsync ... --useuid - -B] I began with --useuid from the first time - -1) First run and next runs with --useuid - - imapsync ... --useuid - - -Inodes number issue. - -The cache is simple, it uses the file-system natively, -it's just an empty file per message transfered. -When mailboxes are huge the cache can exhaust the number of inodes -allowed in the filesystem, that's a limitation like limitation -size but it's less often encountered. - -On Unix, to predict whether your tmpdir filesystem used by imapsync -will support the whole cache, just run the command "df -i /var/tmp", -if /var/tmp is the --tmpdir argument. - -On windows, search and drop me a note about how to count the number -of files allowed in the filesystem. -It seems FAT32 supports 268 435 445 clusters. - -Choosing the number of inodes allowed by a filesystem can be done -at the creation of it with "mkfs -N number-of-inodes ..." - -imapsync can predict how many messages have to be synced with the -option --justfoldersizes (no transfer will be done) - - imapsync ... --justfoldersizes - - -======================================================================= -Q. I see warning messages like the following: -"Host1 Sent/15 size 1428 ignored (no header so we ignore this message. -To solve this: use --addheader)". - -What can I do to transfer those messages? - - -R1. Like suggested inline, use --addheader option. -Option --addheader will add an header line like -Message-Id: <15@imapsync> -where 15 is the message UID number on host1. -Then imapsync will transfer the changed message on host2. -Duplicates won't happen on next runs. - - imapsync ... --addheader - -R2. Other solution. -Use --useuid then imapsync will avoid dealing with headers. - - imapsync ... --useuid - -======================================================================= -Q. On Windows, with --useuid or --usecache a problem occurs with long - nested folder names. The error message is: - "No such file or directory; The filename or extension is too long" - -R. This comes from a Windows limitation on pathnames. -No more than 260 characters are allowed for pathnames. -See more details on page -http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx#maxpath -The workaround solution given at the previous link, -ie using \\?\D:", does not work for imapsync. -So this imapsync Windows bug is still pending and needs a fix using -a different technique to cache, like a database file for example. - -A solution to fix the issue is to use a Linux virtual host on a -Windows box, with VirtualBox or VmWare etc. There is no bug this way, -pathnames can be several thousands characters long. -Better said that done but not so difficult nor expensive these days, -VirtualBox is free and VmWare Player is free for personal or test use. - -If you have to stick on Windows, there are two good workarounds -to reduce the cache directory name: - -1) Use --tmpdir "D:\\temp" or simply --tmpdir "D:" and imapsync -will build and use the cache in the sub directory -D:\imapsync_cache\ - -2) add two equivalent entries in the etc/hosts for host1 imap.truc.org -and host2 imap.trac.org. -If you map the ip of imap.truc.org just with the letter a -and same thing for imap.trac.org then you gain characters - -etc/hosts - -192.168.12.1 a -192.168.55.3 b - -Then use: - - imapsync --host1 a --host2 b ... - -You can get the ip of a host with the ping command line -C:\> ping imap.truc.org - -Fixing the long path problem directly in imapsync is in the TODO file. - -======================================================================= -Q. How can I try imapsync with latest Mail::IMAPClient 3.xx perl module? - -Three solutions at least. - -R1 - Look at the script named "i3" in the tarball, it can be used to - run imapsync with the included Mail-IMAPClient-3.38/ wherever you - unpacked the imapsync tarball - -R2 Run: - - cpanm Mail::IMAPClient # this uses cpanminus - - or - - cpan -i Mail::IMAPClient - - or - - perl -MCPAN -e "install Mail::IMAPClient" - - -R3 If you want to install the Perl module locally in a directory - - - Download latest Mail::IMAPClient 3.xx at - http://search.cpan.org/dist/Mail-IMAPClient/ - - - untar it anywhere: - tar xzvf Mail-IMAPClient-3.xx.tar.gz - - - Get any imapsync (latest is better). - - - run imapsync with perl and -I option tailing to use the perl - module Mail-IMAPClient-3.xx. Example: - - perl -I./Mail-IMAPClient-3.38/lib ./imapsync ... - - or if imapsync is in directory /path/ - perl -I./Mail-IMAPClient-3.38/lib /path/imapsync ... - - -======================================================================= -Q. How can I use imapsync with Mail::IMAPClient 2.2.9 perl module? - -R. Mail::IMAPClient 2.2.9 is no longer supported. - -======================================================================= -Q. Can I use imapsync to migrate emails from pop3 server to imap server? - -R1. No. -You can migrate emails from pop server to imap server with pop2imap: -http://www.linux-france.org/prj/pop2imap/ - -R2. Yes -Many pop3 servers runs in parallel with an imap server on exactly -the same mailboxes. They serve the same INBOX -(imap serves INBOX and several other folders, pop3 serves only INBOX) -So have a try with imapsync on the same host1. - -======================================================================= -Q. Folders are not created on host2. What happens? - -R. Do you use IMAP or POP3 with your client software? -It looks like you use POP3 instead of IMAP, POP3 sees only INBOX. - - -======================================================================= -Q. I am interested in creating a local clone of the IMAP on a LAN -server for faster synchronizations, email will always be delivered -to the remote server and so the synchronization will be one way - from -remote to local. How suited is imapsync for continuous one-way -synchronization of mailboxes? Is there a better solution? - -R. If messages are delivered remotely and you play locally with the -copy, in order to have fast access, then the synchronization can't -be one way. You may change flags, you may move messages in -different folders etc. The issue described is clearly -two-ways sync. - -A better tool with this scenario is offlineimap, -designed for this issue, and faster than imapsync. - - -======================================================================= -Q. I need to log every output on a file named log.txt - -R1. imapsync logs on a file by default, its name is given at the - beginning and the end of each run. This name is unique since - it is compound of the current date and time and user2 value. - -R2. To change this default name, use --logfile log.txt - - imapsync ... --logfile log.txt - - -======================================================================= -Q. Quantifier in {,} bigger than 32766 in regex; marked by <-- HERE in - m/(.{ <-- HERE 1,49947})(?:,|$)/ at Mail/IMAPClient.pm line 2121. - -R. Do not use a bigger value than 3276 with --split1 or --split2 - -======================================================================= -Q. Couldn't create [INBOX.Ops/foo/bar]: NO Invalid mailbox name: -INBOX.Ops/foo/bar - -Let begin by an explanation. - -Example: -sep1 = / -sep2 = . - -imapsync reverts each separator automatically. - -a) All / character coming from host1 are converted to . (convert the separator) -b) All . character coming from host1 are converted to / (to avoid -intermediate unwanted folder creation). - -So -INBOX/Ops.foo.bar (Ops.foo.bar is just one folder name) will be translated to -INBOX.Ops/foo/bar - -Sometimes the sep1 character is not valid on host2 (character "/" usually) - -R. Try : - - --regextrans2 "s,/,X,g" - -It'll convert / character to X -Choose X as you wish: _ or SEP or -any string (including the empty string). - -This issue is automatically fixed by default since imapsync -release 1.513, use --nofixslash2 to suppress the fix. - -======================================================================= -Q. Is it possible to sync also the UIDL of the POP3 server? - -R. imapsync does not POP3 but I think you mean UID in IMAP. - See next question. - -======================================================================= -Q. Is it possible to sync also the UIDs of the IMAP server? - -UIDs in IMAP are chosen and created by the servers, not by the clients, -imapsync is a client. So UIDs cannot be synced by any imap method. -UIDs might be synced via a rsync command on the server part. - -======================================================================= -Q. The option --subscribe does not seem to work - -R1. Use it with --subscribed - -R2. There is also the --subscribe_all option that subscribe -to all folders on host2. - -======================================================================= -Q. On Unix, some passwords contain * and " characters. Login fails. -R. Use a backslash to escape the characters: - - imapsync ... --password1 \"password\" - -It works for the star * character, -I don't know if it works for the " character. - -======================================================================= -Q. With huge account (many messages) when it comes to reading the -destination server it comes out this error: -"To Folder [INBOX.foobar] Not connected" -What can I do? - -R. May be spending too much time on the source server, the connection -timed out on the destination server. -Try options --nofoldersizes - -====================================================================== -Q. Can Imapsync filter Spam during the sync? - -R. No, imapsync doesn't detect Spam by itself and currently it can't -delegate this job during its IMAP syncs. But I've seen blogs and -Spamassassin documentation explaining solutions to apply Spamassassin -to a imap mailbox. So you can apply one of these solutions on the host1 -source mailbox before the imapsync run or on the destination host2 -mailbox after the imapsync transfer. - -http://www.stearns.org/doc/spamassassin-setup.current.html#isbg -http://euer.krebsco.de/using-spamassassin-on-a-remote-imap-host.html -https://github.com/ook/isbg - -====================================================================== -Q. How to migrate from uw-imap with an admin/authuser account? - -R. Use the following syntax: - - imapsync ... --user1="loginuser*admin_user" --password1 "admin_user_password" - - -====================================================================== -Q. How to migrate from cyrus with an admin account? - -R. Use: - - imapsync ... \ - --authuser1 admin_user ----password1 admin_user_password \ - --user1 foo_user --ssl1 - -Instead of --ssl1 the alternative --tls1 can be used. -With --authuser1, the option --authmech1 PLAIN is set -automatically, you don't have to add it. - -PLAIN authentication is the only way to go with --authuser1 for now. -So don't use --authmech1 SOMETHING with --authuser1 admin_user, -it will not work. -Same behavior with the --authuser2 option. - -Do not forget the option --ssl1 or --tls1 since PLAIN auth is only -supported with ssl encryption most of the time. But it can -work without --ssl1 nor --tls1 if PLAIN is permitted in clear text -transmissions (the normal mode). - -Add the AdminAccount to admins line in /etc/imapd.conf -Give AdminAccount lrswipkxtecda to the Cyrus Imap account -being migrated from, "joe" here. - - -Here is an example: - imapsync \ - --host1 server1 \ - --user1 joe \ - --authuser1 AdminAccount \ - --password1 AdminAccountPassword \ - --ssl1 \ - --host2 server2 \ - --user2 joe \ - --password2 joespassonserver2 \ - --exclude "^user\." - -====================================================================== -Q: How to migrate from Sun Java Enterprise System / Sun One / iPlanet / -Netscape servers with an admin account? - -R: Those imap servers don't allow the typical use of --authuser1 to use an -administrative account. They expect the use of an IMAP command called -proxyauth that is issued after login in as an administrative account. - -For example, consider the administrative account 'administrator' and your -real user 'real_user'. The IMAP sequence would be: - - OK [CAPABILITY IMAP4 IMAP4rev1 ACL QUOTA LITERAL+ NAMESPACE UIDPLUS - CHILDREN BINARY UNSELECT LANGUAGE STARTTLS XSENDER X-NETSCAPE XSERVERINFO - AUTH=PLAIN] imap.server IMAP4 service (Sun Java(tm) System Messaging - Server ...)) - 1 LOGIN administrator password - 1 OK User logged in - 2 PROXYAUTH real_user - 2 OK Completed - -In imapsync, you can achieve this by using the following options: - - --host1 source.imap.server \ - --user1 real_user \ - --authuser1 administrator \ - --proxyauth1 \ - --passfile admin.txt - -====================================================================== -Q. Is there anyway of making imapsync purge the destination folder - when the source folder is deleted? - -R. Yes, use --delete2folders - ---delete2folders : Delete folders in host2 that are not in host1 server. - For safety, first try it like this (it is safe): - --delete2folders --dry --justfolders --nofoldersizes ---delete2foldersonly : Deleted only folders matching regex. - Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" ---delete2foldersbutnot : Do not delete folders matching regex. - Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" - - -======================================================================= -Q. I want to play with headers line and --regexmess but I want to leave - the body as is. - -R. The header/body separation is a blank line so an example: - --regexmess 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}gxms' - -Will replace the next three lines - -Message-ID: <499EF800.4030002@blabla.fr> -Date: Fri, 20 Feb 2009 19:35:44 +0100 -From: Gilles LAMIRAL - -by the next four lines - -Message-ID: <499EF800.4030002@blabla.fr> -Date: Fri, 20 Feb 2009 19:35:44 +0100 -X-Date: Fri, 20 Feb 2009 19:35:44 +0100 -From: Gilles LAMIRAL - - -This example just add an header line "X-Date:" based on "Date:" line. - -======================================================================= -Q. My imap server does not accept a message and warns - "Invalid header". What is the problem? - -R. You fall in the classical mbox versus Maildir/ format - problem. May be you use a misconfigured procmail rule. - -A header beginning like the following one is in the mbox -format, header line 1 has no colon behind "From", header -lines 2 through N do have a colon : - -From foo@yoyo.org Sat Jun 22 01:10:21 2002 -Return-Path: -Received: ... - -Any Maildir/ configured imap server may refuse this message since its -header is invalid. The first "From " line is not valid. It lacks a -colon character ":". To solve this issue you have several solutions - -a) Remove manually this first "From " line for each message before - using imapsync. - -b) Replace manually the whitespace by a colon in string "From " but you - might end with two "From:" lines (just have a look at the other - header lines of the message) - -c) Run imapsync with the following option (this replaces "From "by "From:"): - --regexmess 's/\AFrom /From: /' - -or may be better (no other "From:" collision): - -d) Run imapsync with the following option (this replaces "From "by "X-om:"): - --regexmess 's/\AFrom /X-From: /' - -e) Run imapsync with the following option (this removes the whole "From " line): - --regexmess 's{\AFrom\ [^\n]*(\n)?}{}gxms' - -Solution e) is solution a) made by imapsync itself. -Solutions c) and d) keep "From " lines information -(normally it's useless to keep them) - -Best solutions are e) or d). - -======================================================================= -Q. The contact folder isn't well copied. - How to copy the contact folder? - -R. Forget the destination server (choose the same) -Change the script around line 1426 - # ITSD - $new_id = $from->copy($t_fold,$f_msg); - #$new_id = $to->append_string($t_fold,$string, $flags_f, $d); - -and tried a copy of the mail instead an append_string. Because we are -using the same server, we can use $from->copy Therefore we seem to not -download and upload the message and therefore we do not have any -format issues. And now it works fine. (Thanks to Hansjoerg.Maurer) - - -====================================================================== -Q: How can I write an .rpm with imapsync - -R. You'll find an RPM imapsync.spec file in the directory learn/rpm/ - It has been downloaded from - https://svn.fysik.dtu.dk/projects/rpmbuild/trunk/SPECS/imapsync.spec - It has been tested with imapsync 1.434 (May 2011) on CentOS5 - and RedHat RHEL5 Linux. (Thanks to Ole Holm Nielsen). - This imapsync.spec is coming from Neil Brown work in 2007. - -======================================================================= -Q. Where I can read up on the various IMAP RFCs? - -R. Here: - -RFC 3501 - INTERNET MESSAGE ACCESS PROTOCOL - VERSION 4rev1 -http://www.faqs.org/rfcs/rfc3501.html - -RFC2683 - IMAP4 Implementation Recommendations -http://www.faqs.org/rfcs/rfc2683.html - -RFC 2595 - Using TLS with IMAP, POP3 and ACAP -http://www.faqs.org/rfcs/rfc2595.html - -RFC 2822 - Internet Message Format -http://www.faqs.org/rfcs/rfc2822.html - -RFC 2342 - IMAP4 Namespace -http://www.faqs.org/rfcs/rfc2342.html - -RFC2180 - IMAP4 Multi-Accessed Mailbox Practice -http://www.faqs.org/rfcs/rfc2180.html - -RFC 4549 - Synchronization Operations for Disconnected IMAP4 Clients -http://www.faqs.org/rfcs/rfc4549.html - - diff --git a/FAQ b/FAQ new file mode 120000 index 0000000..1f30c55 --- /dev/null +++ b/FAQ @@ -0,0 +1 @@ +FAQ.d/FAQ.General.txt \ No newline at end of file diff --git a/FAQ.d/FAQ.Admin_Authentication.txt b/FAQ.d/FAQ.Admin_Authentication.txt new file mode 100644 index 0000000..baacae5 --- /dev/null +++ b/FAQ.d/FAQ.Admin_Authentication.txt @@ -0,0 +1,32 @@ +#!/bin/cat +$Id: FAQ.Admin_Authentication.txt,v 1.2 2017/01/06 14:11:13 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +============================================== + Imapsync tips about admin authentication. +============================================== + +It can be useful to authenticate without knowing each user password. +Using an admin account to authenticate is not a standard feature +supported by all imap servers. Sometimes it is implemented via --authuser1 +sometimes not. It depends on the server software and its configuration. +You have to figure out what is the imap software server, +find out if it supports an admin account and how, +if an admin account is actually configured and +finally check an authentication via this admin account for +a standard user. + +Known imap server software supporting admin authentication: + + * Exchange 2003/2007/2010/2013. See the file FAQ.Exchange.txt + * Office365. See the file FAQ.Exchange.txt + * Gmail. See the file FAQ.XOAUTH2.txt + * Dovecot. See the file FAQ.Dovecot.txt + * UW-imap. See the file FAQ.General.txt + * Cyrus-imap. See the file FAQ.General.txt + * Sun Java Enterprise System/SunOne/iPlanet. See the file FAQ.General.txt + + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Archiving.txt b/FAQ.d/FAQ.Archiving.txt index 11dc6a6..38dd82b 100644 --- a/FAQ.d/FAQ.Archiving.txt +++ b/FAQ.d/FAQ.Archiving.txt @@ -1,5 +1,5 @@ #!/bin/cat -$Id: FAQ.Archiving.txt,v 1.2 2016/05/09 13:03:14 gilles Exp gilles $ +$Id: FAQ.Archiving.txt,v 1.6 2017/07/13 14:44:07 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc @@ -7,6 +7,30 @@ This documentation is also at http://imapsync.lamiral.info/#doc Imapsync tips about archiving messages. ============================================ +======================================================================= +Q. Can I archive different accounts on the same destination account, + each account on a separate folder? + +R. Yes. Use --subfolder2 + +--subfolder2 str : Move whole host1 folders hierarchy under the + host2 folder str. + It is done it by adding two --regextrans2 options before + all others. Add --debug to see what's really going on. + + +Example: + + imapsync ... --user1 foo --subfolder2 foo + + imapsync ... --user1 bar --subfolder2 bar + +In case you need a strict sync, add --delete2 --delete2foldersonly "foo" +(or "bar"), il will delete on account2 what is not on account1 but only +in the right place, ie, the subfolder "foo". + + imapsync ... --user1 foo --subfolder2 foo --delete2 --delete2foldersonly "foo" + ======================================================================= Q. How to move emails from one IMAP folder to another either on the same IMAP server or a different one? @@ -21,3 +45,5 @@ Add option --delete if you want to move messages, instead of just copy/sync them R2. See also file FAQ.Folders_Mapping.txt +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Authentication_failure.txt b/FAQ.d/FAQ.Authentication_failure.txt new file mode 100644 index 0000000..ce8a72b --- /dev/null +++ b/FAQ.d/FAQ.Authentication_failure.txt @@ -0,0 +1,54 @@ +#!/bin/cat +$Id: FAQ.Authentication_failure.txt,v 1.5 2017/09/04 11:03:57 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +======================================================================= + Imapsync authentication issues +======================================================================= + + +Host1 failure: Error login on [imap.example.com] with user [foo] auth [LOGIN]: 2 NO [AUTHENTICATIONFAILED] Authentication failed + + +One over four imapsync syncs ends up quickly with the error message +"Authentication failed" or "NO LOGIN failed" or similar. +Authentication failure is the primary failure with imapsync +and since nothing tangible can be done without authentication, +this stage must succeed to go further. + +Here are some advices to get you pass this difficult stage of authentication: + + * Triple check each credendial parameter, there are three parameters at each side: + * triple check --host1 + * triple check --user1 + * triple check --password1 + * triple check --host2 + * triple check --user2 + * triple check --password2 + + * If you can authenticate successfully with an other imap client software + like Thunderbird or Outlook or Sparrow then it is a very good sign to + authenticate successfully with imapsync. Examine the parameters of + this other imap client and copy them as is for imapsync. + + * Use option --showpasswords + At the beginning of the output, imapsync dumps all its command + line parameters; it's the line after "Command line used:". + With --showpasswords, imapsync prints the passwords received + instead of the string MASKED. It helps for debugging quoting issues. + Option --showpasswords shows passwords again when the IMAP dialog + is dumped by --debugimap option. Search for a line like + "Sending: 2 LOGIN test1 secret1" (secret1 is the password here) + + + * It is sometimes very hard to quote correctly unusual characters, + especially on Windows. See + https://imapsync.lamiral.info/FAQ.d/FAQ.Passwords_on_Windows.txt + https://imapsync.lamiral.info/FAQ.d/FAQ.Passwords_on_Unix.txt + The quicker trick might be to change the password temporarilly + with easy characters like the classical alphabet, a long + string will still ensure strong security. + + + \ No newline at end of file diff --git a/FAQ.d/FAQ.Contacts_Calendars.txt b/FAQ.d/FAQ.Contacts_Calendars.txt index 23c2391..98c07a0 100644 --- a/FAQ.d/FAQ.Contacts_Calendars.txt +++ b/FAQ.d/FAQ.Contacts_Calendars.txt @@ -1,5 +1,5 @@ #!/bin/cat -$Id: FAQ.Contacts_Calendars.txt,v 1.3 2016/05/09 13:37:21 gilles Exp gilles $ +$Id: FAQ.Contacts_Calendars.txt,v 1.5 2017/01/06 14:11:13 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc @@ -7,6 +7,11 @@ This documentation is also at http://imapsync.lamiral.info/#doc Imapsync issues about syncing Contacts & Calendars. ========================================================= +Questions anwswered in this FAQ are: + +Q. Can I copy or sync Calendar or Contacts with imapsync? +Q. How can I avoid copying Calendar or Contacts folders? +Q. How can I copy or synchronize Calendars or Contacts? ======================================================================= Q. Can I copy or sync Calendar or Contacts with imapsync? @@ -16,15 +21,29 @@ R. No, Imapsync can't migrate Contacts and Calendars. events via IMAP. In other words, messages synced by imapsync from Calendars or Contacts folders are not used by email servers to set or get the contacts or calendars. - No way via IMAP, no way via imapsync. + No way via IMAP, no way via imapsync. + So it's a good idea to avoid syncing contacts and calendars. But see next question. +======================================================================= +Q. How can I avoid copying Calendar or Contacts folders? + +R1. You can avoid synchronizing Calendar or Contacts folders with + the --exclude option. First you have to search what is their + exact name. The folders listing printed by imapsync at the + beginning of a run will surely help to find their names. + Assuming their names are "Calendars" and "Contacts" use then: + + imapsync ... --exclude "Calendar" --exclude "Contacts" + ======================================================================= Q. How can I copy or synchronize Calendars or Contacts? -R1. It can't be done with imapsync. See previous question for explanations. +R1. Synchronizing Calendars or Contacts can't be done with imapsync. + See the first question for detailed explanations. -R2. It can be done, depending on the email server softwares used. +R2. Synchronizing Calendars or Contacts can be done, not + with imapsync, depending on the email server softwares used. a) From Exchange to Exchange, export contacts and calendar to PST format files on host1 and import them on host2. @@ -46,4 +65,6 @@ d) I plan to make tools for that but so far nothing has began http://www.linux-france.org/prj/imapsync_list/msg01797.html http://www.linux-france.org/prj/imapsync_list/msg01811.html + +======================================================================= ======================================================================= diff --git a/FAQ.d/FAQ.Dates.txt b/FAQ.d/FAQ.Dates.txt index 8efcb7f..4e22297 100644 --- a/FAQ.d/FAQ.Dates.txt +++ b/FAQ.d/FAQ.Dates.txt @@ -1,5 +1,5 @@ #!/bin/cat -$Id: FAQ.Dates.txt,v 1.3 2016/07/27 13:14:30 gilles Exp gilles $ +$Id: FAQ.Dates.txt,v 1.6 2017/08/29 05:34:55 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc @@ -7,10 +7,19 @@ This documentation is also at http://imapsync.lamiral.info/#doc Imapsync tips about dates. =============================== +Questions anwswered in this FAQ are: + +Q. We have found that the time and date displayed have been changed to + the time at which the file was synchronized. What happened? Any fix? + +Q. Is there a way to set any message with + "Date: (Invalid)" to a valid one like + "Date: Thu, 1 Jun 2017 23:59:59 +0000"? + ======================================================================= Q. We have found that the time and date displayed have been changed to - the time at which the file was synchronized. + the time at which the file was synchronized. What happened? Any fix? R. This is the case by default with some email readers like: - Outlook 2003 @@ -70,7 +79,30 @@ by sent date, the "Date:" header line. b) Use a imap server that respects the imap RFC and accepts the internal date set by imapsync. -c) Try to understand why the reader shows another date than the "Date:" line. +c) Try to understand why the email client software shows another date + than the "Date:" header line. ======================================================================= +Q. Is there a way to set any message with + "Date: (Invalid)" to a valid one like + "Date: Thu, 1 Jun 2017 23:59:59 +0000"? +R. Yes, there is a way with option --regexmess + +First, let's select only messages with a buggy Date header: + + --search "HEADER Date Invalid" + +Second, let's change this line by a valid one, + +on windows: + + --regexmess "s{\A(.*?(?! ^$))^Date:\ \(Invalid\)(.*?)$}{$1Date: Thu, 1 Jun 2017 23:59:59 +0000}xms" + +on Unix (replaced enclosing double-quotes " by single quotes ' ): + + --regexmess 's{\A(.*?(?! ^$))^Date:\ \(Invalid\)(.*?)$}{$1Date: Thu, 1 Jun 2017 23:59:59 +0000}xms' + + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Domino.txt b/FAQ.d/FAQ.Domino.txt index 2020222..c7de542 100644 --- a/FAQ.d/FAQ.Domino.txt +++ b/FAQ.d/FAQ.Domino.txt @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ.Domino.txt,v 1.6 2016/01/28 14:34:15 gilles Exp gilles $ +# $Id: FAQ.Domino.txt,v 1.8 2017/03/02 12:54:15 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc @@ -8,44 +8,44 @@ This documentation is also at http://imapsync.lamiral.info/#doc ============================= -====================================================================== -Q. From Domino Notes to xxx +======================================================================= +Q. From Domino Notes to XXX On Windows use: - imapsync.exe ... --sep1 "\\" --prefix1 "" + imapsync.exe ... --sep1 "\\" --prefix1 "" --messageidnodomain On Unix use: - imapsync ... --sep1 '\' --prefix1 '' + imapsync ... --sep1 '\' --prefix1 '' --messageidnodomain -====================================================================== -Q. From xxx to Domino Notes +======================================================================= +Q. From XXX to Domino Notes Domino doesn't accept INBOX subfolders. On Windows: imapsync.exe ... ^ - --sep2 "\\" --prefix2 "" ^ + --sep2 "\\" --prefix2 "" --messageidnodomain ^ --regextrans2 "s,^Inbox\\(.*),$1,i" On Unix: imapsync ... \ - --sep2 '\' --prefix2 '' \ + --sep2 '\' --prefix2 '' --messageidnodomain \ --regextrans2 's,^Inbox\\(.*),$1,i' If you want to sync the complete host1 mailbox in a subfolder called OLDBOX use: On Windows: imapsync.exe ... ^ - --sep2 "\\" --prefix2 "" ^ + --sep2 "\\" --prefix2 "" --messageidnodomain ^ --subfolder2 "OLDBOX" --justfolders --dry On Unix: imapsync ... \ - --sep2 '\' --prefix2 '' \ + --sep2 '\' --prefix2 '' --messageidnodomain \ --subfolder2 'OLDBOX' --justfolders --dry If the output is correct for you then remove --dry and have a run. @@ -69,8 +69,10 @@ For Domino 853FP6 on Linux, we used this command on Unix: --host2 hhh2 --user2 uuu2 --password2 ppp2 \ --exclude "^INBOX/Trash" --exclude 'Junk|Drafts' \ --regextrans2 's#^INBOX/Sent$#^Sent#' \ - --prefix2 "" --sep2 "\/" \ + --prefix2 "" --sep2 "\/" --messageidnodomain \ --regexmess 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Migratedbyus:$2\nx-MailDate:$2}gxms' -====================================================================== + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Dovecot.txt b/FAQ.d/FAQ.Dovecot.txt index ae8ec49..f4d1600 100644 --- a/FAQ.d/FAQ.Dovecot.txt +++ b/FAQ.d/FAQ.Dovecot.txt @@ -1,5 +1,5 @@ #!/bin/cat -$Id: FAQ.Dovecot.txt,v 1.4 2016/01/28 14:34:15 gilles Exp gilles $ +$Id: FAQ.Dovecot.txt,v 1.5 2017/01/06 14:21:06 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc diff --git a/FAQ.d/FAQ.Duplicates.txt b/FAQ.d/FAQ.Duplicates.txt index da15e30..6e3b80b 100644 --- a/FAQ.d/FAQ.Duplicates.txt +++ b/FAQ.d/FAQ.Duplicates.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Duplicates.txt,v 1.10 2016/04/17 19:06:39 gilles Exp gilles $ +$Id: FAQ.Duplicates.txt,v 1.12 2017/08/31 03:06:45 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -====================================================================== +======================================================================= Imapsync tips about duplicated messages issues. -====================================================================== +======================================================================= ======================================================================= Q. How can I remove duplicates in an lone account? @@ -13,6 +13,27 @@ Q. How can I remove duplicates in an lone account? R. Just run imapsync on the same account with option --delete2duplicates, ie, with host1 == host2 and user1 == user2 +======================================================================= +Q. How can I know if imapsync will generate duplicates on a second run? + +R. To see if imapsync will generate duplicates on a second run, start + a second run with --dry option added. imapsync will then show if it + would mistakenly copy messages again, but without really copying them + + imapsync ... --dry + + The final stats should also show a positive value for the line + "Messages skipped:" since most of the skipped messages are skipped + because they are already on host2. Example of final stats: + +++++ Statistics +Transfer started on : Thu Aug 31 04:28:32 2017 +Transfer ended on : Thu Aug 31 04:28:44 2017 +Transfer time : 11.7 sec +Folders synced : 1/1 synced +Messages transferred : 0 +Messages skipped : 1555 + ======================================================================= Q: Multiple copies, duplicates, when I run imapsync twice ore more. @@ -140,5 +161,4 @@ R2. With option --useuid imapsync doesn't use headers to identify In that case duplicates on host1 are also transferred on host2. ======================================================================= - - +======================================================================= diff --git a/FAQ.d/FAQ.Emptying.txt b/FAQ.d/FAQ.Emptying.txt index 92f149e..d5ae282 100644 --- a/FAQ.d/FAQ.Emptying.txt +++ b/FAQ.d/FAQ.Emptying.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Emptying.txt,v 1.4 2016/04/24 00:07:47 gilles Exp gilles $ +$Id: FAQ.Emptying.txt,v 1.5 2017/01/06 14:11:13 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -============================================ +======================================================================= Imapsync tip to empty an account. -============================================ +======================================================================= ======================================================================= Q. How to delete all emails of all folders of an account with imapsync? @@ -33,3 +33,4 @@ Example: ./imapsync ... --delete2folders --foldersizes ======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Exchange.txt b/FAQ.d/FAQ.Exchange.txt index 3ed2d56..79a6f52 100644 --- a/FAQ.d/FAQ.Exchange.txt +++ b/FAQ.d/FAQ.Exchange.txt @@ -1,5 +1,5 @@ -#!/bin/cat -$Id: FAQ.Exchange.txt,v 1.23 2016/08/10 01:29:37 gilles Exp gilles $ + +$Id: FAQ.Exchange.txt,v 1.34 2017/07/18 21:27:18 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc @@ -11,13 +11,16 @@ Questions anwswered in this FAQ are: Q. Can I use imapsync to transfer from or to Exchange or Office365 accounts? -Q. How to sync from XXX to Exchange 2010/2013 +Q. How to sync from XXX to Exchange 2010/2013/2016 Q. How to sync from XXX to Office365 Q. For Office365 I have double and triple checked the username and password spelling but I still get a "LOGIN failed". Any clue? +Q. I see "NO Maximum size of appendable message has been exceeded" + What can I do with that? + Q. Exchange fails with "User is authenticated but not connected". Q. Exchange fails with "BAD Command received in Invalid state". @@ -25,6 +28,9 @@ Q. Exchange fails with "BAD Command received in Invalid state". Q. From XXX to Exchange 2013 or Office365, read receipts are all resent again after a sync. Even for old messages. How can I fix that? +Q. DEBUG: IO/Socket/SSL.pm:1043: local error: SSL read error + DEBUG: IO/Socket/SSL.pm:1043: local error: SSL read error + Q. From XXX to Exchange 2010/2013 or Office365 I get this error message sometimes: "BAD Command Argument Error 11". What does it mean? @@ -60,12 +66,14 @@ R. Yes. But IMAP access to a Exchange or Office365 account is not always part: ======================================================================= -Q. How to sync from XXX to Exchange 2010/2013 +Q. How to sync from XXX to Exchange 2010/2013/2016 -R. Here is a command line resume that solves most encountered issues when - migrating to Exchange. To understand or change the details you have - to read next Q/R sections. +R0. IMAP is not enable by default on Exchange, see how to enable it: +https://technet.microsoft.com/en-us/library/bb124489(v=exchg.150).aspx +R1. Following is a command line resume that solves most encountered + issues when migrating to Exchange. To fully understand or change + the details you have to read the next Q/R sections. On Windows: @@ -155,13 +163,39 @@ R2. Miguel Alameda reported understanding and solving this issue like this, the context was admin/authuser: "The admin user had not permission in the target mailbox." +======================================================================= +Q. I see "NO Maximum size of appendable message has been exceeded" + What can I do with that? + +R. Office 365 supports send/receive max message sizes of up to 150MB + but you need to make changes in your tenant(s) to support it. + +The following PowerShell command will increase the message sizes that +can be sent/received. The trick in getting IMAPSync to work is to +apply these settings to the accounts performing the migration, +NOT the accounts associated with the target mailbox (assuming you're +using service accounts to perform transfers on behalf of users). + + Set-mailbox -Identity $UPN -MaxReceiveSize 150mb -MaxSendSize 150mb + +e.g. + + Set-mailbox -Identity "migrationaccount@testtenant.onmicrosoft.com" -MaxReceiveSize 150mb -MaxSendSize 150mb + +We're transferring data between Office 365 tenants so we set these +values on the migration acounts in the source and target tenants. + +Thanks to Sean McDougall, Ian Thomas & Matt Wilks from Toronto +for this FAQ item. + ======================================================================= Q. Exchange fails with "BAD Command received in Invalid state". -R. This message might happens when authentication without ssl nor tls. +R. This message might happens when authenticating without ssl nor tls. Add --tls1 or --ssl1 if this error message comes from host1. - Add --tls2 or --ssl2 if this error message comes from host1. + Add --tls2 or --ssl2 if this error message comes from host2. +(Never add --tlsX and --sslX on the same side X (1 or 2), it won't work) ======================================================================= Q. From XXX to Exchange 2013 or Office365, read receipts are all resent again after a sync. Even for old messages. How can I fix that? @@ -196,6 +230,19 @@ X-Disposition-Notification-To: blabla Thanks to David Karnowski for pointing and solving this issue. +======================================================================= +Q. DEBUG: IO/Socket/SSL.pm:1043: local error: SSL read error + DEBUG: IO/Socket/SSL.pm:1043: local error: SSL read error + +R1. "SSL read or write error" happens sometimes, it isn't related to + imapsync directly but to the ssl underlying library when communicating + with Exchange in TLS/SSL encrypted mode. + Next runs should put the sync further, so rerun the syncs + until it is well completed. + +R2. Another solution is to remove --tls or --ssl options for Exchange + and accept a clear text sync. + ======================================================================= Q. From XXX to Exchange 2010/2013 or Office365 I get this error message sometimes: "BAD Command Argument Error 11". What does it mean? @@ -273,11 +320,19 @@ Q. Exchange and Office365 have throttle mechanisms to limit any huge usage. Sometimes imapsync transfers are too stressful for servers. How to deal with that? -R. It looks like limiting 4 messages per second is enough to never - reach any throttle limit. +R. It looks like limiting 4 messages per second is enough to avoid + the throttle limits. imapsync ... --maxmessagespersecond 4 +In case throttle appears anyway, fix them with: +https://technet.microsoft.com/en-us/library/jj863577(v=exchg.150).aspx +See also: +http://www.linux-france.org/prj/imapsync_list/msg02072.html + +Sometimes restarting the Exchange server is needed to take +into account the change in the configuration. + ====================================================================== Q. How to migrate from or to Exchange 2007/2010/2013 with an admin/authuser account? @@ -347,6 +402,12 @@ So don't use --authmech1 SOMETHING with --authuser1 admin_user, it will not work. Same behavior with the --authuser2 option. +Note from Martin Paulucci: +I had to remove the domain part for the user +but not for the admin. Example: + + imapsync ... --authuser2 user_admin@domain.com --user2 user_to_be_migrated + See also: http://www.linux-france.org/prj/imapsync_list/msg02203.html @@ -458,3 +519,4 @@ R. imapsync ... --prefix1 "INBOX." ======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Flags.txt b/FAQ.d/FAQ.Flags.txt index 87ba135..581486a 100644 --- a/FAQ.d/FAQ.Flags.txt +++ b/FAQ.d/FAQ.Flags.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Flags.txt,v 1.7 2016/01/28 14:34:15 gilles Exp gilles $ +$Id: FAQ.Flags.txt,v 1.17 2017/07/27 15:39:57 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -=============================== +======================================================================= Imapsync tips about flags. -=============================== +======================================================================= Questions answered here are: @@ -15,7 +15,11 @@ Q. Is there a way to only sync messages with a specific flag set, for example, the \Seen flag? Q. How to convert flags? - + +Q. Exchange sends an email to any sender whose email is deleted + without reading. It's called "unread notifications". + How to set the \Seen flag on host1 (source system) before syncing? + Q. Does imapsync retain the \Answered and $Forwarded flags? Q. How to fix this error: BAD Invalid system flag \FORWARDED @@ -25,9 +29,16 @@ Q. How to convert flags with $ to \ character? Q. imapsync fails with the following error: flags from : [\Seen NonJunk] Error trying to append string: 58 NO APPEND Invalid flag list - + Q. Flags are not well synchronized. Is it a bug? +Q. Flags are resynced at each run for already synced/copied messages, + how can I avoid this feature? + +Q. Is it possible to sync labels and stars made by Thunderbird to + Exchange categories? Or a way in Outlook to show labels created by + Thunderbird? + ======================================================================= Q. How to debug flag issues? @@ -50,35 +61,15 @@ or or ... -The complete list of search things are listed below +The complete list of search things related to flags are listed below http://www.faqs.org/rfcs/rfc3501.html 6.4.4. SEARCH Command ... - ALL - All messages in the mailbox; the default initial key for - ANDing. - ANSWERED Messages with the \Answered flag set. - BCC - Messages that contain the specified string in the envelope - structure's BCC field. - - BEFORE - Messages whose internal date (disregarding time and timezone) - is earlier than the specified date. - - BODY - Messages that contain the specified string in the body of the - message. - - CC - Messages that contain the specified string in the envelope - structure's CC field. - DELETED Messages with the \Deleted flag set. @@ -88,25 +79,9 @@ http://www.faqs.org/rfcs/rfc3501.html FLAGGED Messages with the \Flagged flag set. - FROM - Messages that contain the specified string in the envelope - structure's FROM field. - - HEADER - Messages that have a header with the specified field-name (as - defined in [RFC-2822]) and that contains the specified string - in the text of the header (what comes after the colon). If the - string to search is zero-length, this matches all messages that - have a header line with the specified field-name regardless of - the contents. - KEYWORD Messages with the specified keyword flag set. - LARGER - Messages with an [RFC-2822] size larger than the specified - number of octets. - NEW Messages that have the \Recent flag set but not the \Seen flag. This is functionally equivalent to "(RECENT UNSEEN)". @@ -119,10 +94,6 @@ http://www.faqs.org/rfcs/rfc3501.html functionally equivalent to "NOT RECENT" (as opposed to "NOT NEW"). - ON - Messages whose internal date (disregarding time and timezone) - is within the specified date. - OR Messages that match either search key. @@ -132,42 +103,6 @@ http://www.faqs.org/rfcs/rfc3501.html SEEN Messages that have the \Seen flag set. - SENTBEFORE - Messages whose [RFC-2822] Date: header (disregarding time and - timezone) is earlier than the specified date. - - SENTON - Messages whose [RFC-2822] Date: header (disregarding time and - timezone) is within the specified date. - - SENTSINCE - Messages whose [RFC-2822] Date: header (disregarding time and - timezone) is within or later than the specified date. - - SINCE - Messages whose internal date (disregarding time and timezone) - is within or later than the specified date. - - SMALLER - Messages with an [RFC-2822] size smaller than the specified - number of octets. - - SUBJECT - Messages that contain the specified string in the envelope - structure's SUBJECT field. - - TEXT - Messages that contain the specified string in the header or - body of the message. - - TO - Messages that contain the specified string in the envelope - structure's TO field. - - UID - Messages with unique identifiers corresponding to the specified - unique identifier set. Sequence set ranges are permitted. - UNANSWERED Messages that do not have the \Answered flag set. @@ -197,6 +132,44 @@ For example to convert flag IMPORTANT to flag CANWAIT option --debugflags is usefull to see in details what imapsync does with flags. + +======================================================================= +Q. Exchange sends an email to any sender whose email is deleted + without reading. It's called "unread notifications". + How to set the \Seen flag on host1 (source system) before syncing? + +R. You can add \Seen (if missing) to the host1 account by applying a + first sync to the same account, same at source and destination, + and the help of option --regexflag. It can also be done on the fly + from account1 to account2 in case account1 has to stay as it is. + +Add the \Seen flag to all messages like this: + +On Winwows: + + imapsync.exe ... --regexflag "s,^((?!\\Seen)).*$,$1 \\Seen," + +On Unix: + + imapsync ... --regexflag 's,^((?!\\Seen)).*$,$1 \\Seen,' + +R2. You can also filter with --search1 UNSEEN and use a simpler + regex: + +On Winwows: + + imapsync.exe ... --search1 UNSEEN --regexflag "s/(.*)/$1 \\Seen/" + +On Unix: + + imapsync ... --search1 UNSEEN --regexflag 's/(.*)/$1 \\Seen/' + +R3. Fix it on the server Exchange: +Google translate: +https://translate.google.com/translate?sl=auto&tl=en&u=https%3A%2F%2Fwww.ci-solution.com%2Fblog%2Fartikel%2Fungelesen-geloescht-verhindern.html +German original: +https://www.ci-solution.com/blog/artikel/ungelesen-geloescht-verhindern.html +(Link from Oliver B.) ======================================================================= Q. Does imapsync retain the \Answered and $Forwarded flags? @@ -224,7 +197,7 @@ R. Filter flag \FORWARDED with --regexflag like this: On Windows: - imapsync ... --regexflag "s/\\FORWARDED//gi" + imapsync.exe ... --regexflag "s/\\FORWARDED//gi" On Unix: @@ -234,6 +207,19 @@ or imapsync ... --regexflag "s/\\\\FORWARDED//gi" +Other related flags to remove are \Indexed and \ATTACHED + +Windows: imapsync.exe ... --regexflag "s/\\Indexed//gi" +Unix: imapsync ... --regexflag 's/\\Indexed//gi' + +Windows: imapsync.exe ... --regexflag "s/\\ATTACHED//gi" +Unix: imapsync ... --regexflag 's/\\ATTACHED//gi' + +All usually problematic flags in one line: + +Windows: imapsync.exe ... --regexflag "s/\\FORWARDED|\\Indexed|\\ATTACHED//gi" +Unix: imapsync ... --regexflag 's/\\FORWARDED|\\Indexed|\\ATTACHED//gi' + ======================================================================= Q. How to convert flags with $ to \ character? @@ -280,5 +266,37 @@ Two solutions: option --syncflagsaftercopy does it again using the imap STORE command. +======================================================================= +Q. Flags are resynced at each run for already synced/copied messages, + how can I avoid this feature? + +R. It is not possible to avoid this feature by an option for now. + If you really need this then ask for it and I might code it. + ======================================================================= +Q. Is it possible to sync labels and stars made by Thunderbird to + Exchange categories? Or a way in Outlook to show labels created by + Thunderbird? + +R. Imapsync syncs all flags possible by default, so if it doesn't do +that it might means there are not on the server but stay only on the +client or that the host2 server claims to accept only a given set +of flags. + +Check those claims by accessing the same mailbox on the same server +from another thunderbird on another host, you should not retrieve +those labels. If you do find them it then might mean that host2 +server don't want them, try --nofilterflags + + imapsync ... --nofilterflags + +You can try --nofilterflags straightaway without the +"other thunderbird" proposal. + +There is also the possibility to map flags across servers +with --regexflags + + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Folders_Mapping.txt b/FAQ.d/FAQ.Folders_Mapping.txt index 0aecbd7..b58374f 100644 --- a/FAQ.d/FAQ.Folders_Mapping.txt +++ b/FAQ.d/FAQ.Folders_Mapping.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Folders_Mapping.txt,v 1.10 2016/01/28 14:34:15 gilles Exp gilles $ +$Id: FAQ.Folders_Mapping.txt,v 1.13 2017/05/24 19:18:41 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -=============================================== +======================================================================= Imapsync tips about changing folders names. -=============================================== +======================================================================= Folders names are by default reproduced identical except for the prefix and the separator which are automatically adapted @@ -46,22 +46,22 @@ Here *) Good method to elaborate any --regextrans2 string - First elaborate the --regextrans2 string with --dry --justfolders - --nofoldersizes options. - With --dry imapsync shows the transformations it will do without - really doing them. - With --justfolders imapsync will work only with folders, - messages won't be taken into account. - With --nofoldersizes imapsync won't spend time useless time on - evaluating folders sizes. + First, elaborate the --regextrans2 string with --dry --justfolders options. - When the output shows what you escape imapsync to do with folders + imapsync ... --dry --justfolders + + With --dry imapsync shows the transformations it will do without + really doing them, --dry is the "do nothing" mode. + With --justfolders imapsync will work only with folders, + messages won't be taken into account, so it will be fast. + + When the output shows what you expect imapsync to do with folders names, you can remove the --dry option. Keep the --justfolders option in order to see if the destination server host2 accepts to create the folders. - When everything is ok with folders you can remove --justfolders - and --nofoldersizes imapsync will also transfer messages. + When everything is ok with folders you might remove --justfolders, + imapsync will also transfer messages. Showing folders sizes is good then transferring messages, it allows ETA calculation and it's a supplementary check on folders. @@ -183,7 +183,7 @@ to folder INBOX only on host2: 1) First try (safe mode): - --regextrans2 "s/(.*)/INBOX/" --dry --justfolders + --regextrans2 "s/.*/INBOX/" --dry --justfolders 2) See if the output says everything you want imapsync to do, --dry option is safe and does nothing real. @@ -247,5 +247,4 @@ imapsync ... \ --folder INBOX ======================================================================= - - +======================================================================= diff --git a/FAQ.d/FAQ.Folders_Selection.txt b/FAQ.d/FAQ.Folders_Selection.txt index 9d874c8..43dfc00 100644 --- a/FAQ.d/FAQ.Folders_Selection.txt +++ b/FAQ.d/FAQ.Folders_Selection.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Folders_Selection.txt,v 1.4 2016/06/07 22:19:04 gilles Exp gilles $ +$Id: FAQ.Folders_Selection.txt,v 1.6 2017/07/20 11:02:11 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -===================================== +======================================================================= Imapsync tips to select folders. -===================================== +======================================================================= By default, Imapsync syncs all folders, one by one, in alphanumeric order. @@ -19,7 +19,7 @@ square brackets, the right column is the human utf8 view. -====================================================================== +======================================================================= Q. How can I sync only one folder? R. Use --folder option. @@ -31,25 +31,24 @@ If you have more specific folders to sync just add several --folder imapsync ... --folder MyFolder --folder ThisFolder --folder ThatFolder -====================================================================== +======================================================================= Q. What are --subscribe and --subscribed for, and how can they be used? R. In the IMAP protocol each user can subscribe to one or more folders. Then one can configure his email software to just see his subscribed folders. That's an IMAP feature. - Knowing that, the imapsync help mentions: + Imapsync can use this imap feature to select subscribed folders + and also subscribe to folders on host2. Here are the options: - imapsync --help - ... - --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. + --subscribed : Transfers subscribed folders. + --subscribe : Subscribe to the folders transferred on the + host2 that are subscribed on host1. On by default. + --subscribeall : Subscribe to the folders transferred on the + host2 even if they are not subscribed on host1. -====================================================================== +======================================================================= Q. I want to exclude a folder hierarchy like "public" R. Use: @@ -65,7 +64,7 @@ output line : From folders list : [INBOX] [public.dreams] [etc.] -====================================================================== +======================================================================= Q. I want to exclude only INBOX R. Use: @@ -76,7 +75,7 @@ A good way to see what will be done is to first use: imapsync ... --exclude "^INBOX$" --justfolders --nofoldersizes --dry -====================================================================== +======================================================================= Q. I want to exclude folders matching SPAM no matter the case, aka how to be case insensitive @@ -89,7 +88,7 @@ A good way to see what will be done is to first use: imapsync ... --exclude "(?i)spam" --justfolders --nofoldersizes --dry -====================================================================== +======================================================================= Q. I want the --folder "MyFolder" option be recursive. Two solutions: @@ -102,5 +101,5 @@ R2. Use --include "^MyFolder" Then the folder "MyFolder" and all its subfolders will be handled and only them. - - +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.General.txt b/FAQ.d/FAQ.General.txt new file mode 100644 index 0000000..68955b5 --- /dev/null +++ b/FAQ.d/FAQ.General.txt @@ -0,0 +1,797 @@ +#!/bin/cat +# $Id: FAQ.General.txt,v 1.233 2017/09/07 22:08:42 gilles Exp gilles $ + +======================================================================= + General FAQ for imapsync +======================================================================= + +This document is also available at +https://imapsync.lamiral.info/#doc +https://imapsync.lamiral.info/FAQ.d/FAQ.General.txt + +Questions anwswered in this FAQ are: + +Q. Do I need to create IMAP mailboxes at the destination platform? + +Q. Am I forced to publish the IMAP service on internet since the two + environment are not in the same location or same LAN? + +Q. What are the most important differences between the Unix shell syntax + and the Windows batch syntax. + +Q. How to install imapsync? + +Q. How to use imapsync? + +Q. Can you give some configuration examples? + +Q. How can I have commercial support? + +Q. How can I have gratis support? + +Q. Where I can find old imapsync releases? + +Q. Where I can find free open and gratis imapsync releases? + +Q. Is is legal to find imapsync gratis (or not) elsewhere? + +Q. How "Facts and figures" are known + https://imapsync.lamiral.info/#NUMBERS + +Q. I use --useuid which uses a cache in /tmp or --tmpdir, the hostnames + host1 or host2 has changed but mailboxes are the same. Will imapsync + generate duplicate messages on next runs? + +Q. How can I speed up transfers? + +Q. I see warning messages like the following: + "Host1 Sent/15 size 1428 ignored (no header so we ignore this message. + To solve this: use --addheader)". + What can I do to transfer those messages? + +Q. How can I try imapsync with latest Mail::IMAPClient 3.xx perl module? + +Q. How can I use imapsync with Mail::IMAPClient 2.2.9 perl module? + +Q. How to verify imapsync.exe I got is the right file bit per bit? + +Q. Can I use imapsync to migrate emails from pop3 server to imap server? + +Q. Folders are not created on host2. What happens? + +Q. I am interested in creating a local clone of the IMAP on a LAN + server for faster synchronizations, email will always be delivered + to the remote server and so the synchronization will be one way - from + remote to local. How suited is imapsync for continuous one-way + synchronization of mailboxes? Is there a better solution? + +Q. I need to log every output on a file named log.txt + +Q. Quantifier in {,} bigger than 32766 in regex; marked by <-- HERE in + m/(.{ <-- HERE 1,49947})(?:,|$)/ at Mail/IMAPClient.pm line 2121. + +Q. Couldn't create [INBOX.Ops/foo/bar]: NO Invalid mailbox name: + INBOX.Ops/foo/bar + +Q. Is it possible to sync also the UIDL of the POP3 server? + +Q. Is it possible to sync also the UIDs of the IMAP server? + +Q. The option --subscribe does not seem to work + +Q. With huge account (many messages) when it comes to reading the + destination server it comes out this error: + "To Folder [INBOX.foobar] Not connected" + What can I do? + +Q. Can Imapsync filter Spam during the sync? + +Q. How to migrate from uw-imap with an admin/authuser account? + +Q. How to migrate from cyrus with an admin account? + +Q: How to migrate from Sun Java Enterprise System / Sun One / iPlanet / + Netscape servers with an admin account? + +Q. Is there a way to delete the destination folder when the source + folder is no longer there? + +Q. I would love to have a function to inject lines in the header. + Things like "X-migrated-from-foo: 20100617" + +Q. I want to play with headers line and --regexmess but I want to leave + the body as is. + +Q. My imap server does not accept a message and warns + "Invalid header". What is the problem? + +Q. The contact folder isn't well copied. + How to copy the contact folder? + +Q: How can I write an .rpm with imapsync + +Q. Where I can read up on the various IMAP RFCs? + + +======================================================================= +Q. Do I need to create IMAP mailboxes at the destination platform? + +R. Yes! + Imapsync does only IMAP and there is no way to create an account + with the standard IMAP protocol. So you have to create them first. + +======================================================================= +Q. Am I forced to publish the IMAP service on internet since the two + environment are not in the same location or same LAN? + +R. The host where you run imapsync has to contact both servers via imap. + You are not obliged to publish the imap service on internet if the host + where you run imapsync can contact both imap servers via imap. + Use their names or their IP addresses. + +======================================================================= +Q. What are the most important differences between the Unix shell syntax + and the Windows batch syntax. + +R. There are several differences between Unix and Windows +in the command line syntax. +- Character \ on Unix versus ^ on Windows +- Character ' on Unix versus " on Windows + +Details: + +A) \ versus ^ + +On Unix shells you can write a single command on multiple lines +by using the escape character \ at the end of each line +(except the last one). On Windows this character is ^ + +Unix example: + +./imapsync \ + --host1 imap.truc.org --user1 foo --password1 secret1 \ + --host2 imap.trac.org --user2 bar --password2 secret2 + + +Windows example: + +imapsync ^ + --host1 imap.truc.org --user1 foo --password1 secret1 ^ + --host2 imap.trac.org --user2 bar --password2 secret2 + + +Of course you can write the command on a single line without +characters \ nor ^. I use them because the output is +better, no truncation, pretty print. It's just sugar! + +In this FAQ I use \ for examples. Transcript to ^ if +you're on a Windows system. + +B) Quote vs Double-quote, ie ' versus " + +On Windows the single quote character ' doesn't work +like on Unix so in the examples of this FAQ the +command containing single quotes ' will fail on Windows. +To fix this, just replace single quotes ' by double quotes " + +Also on Windows, in examples with \$1, replace +any \$1 by $1 (remove the \ before $). + +======================================================================= +Q. How to install imapsync? + +R. Read the INSTALL files in the tarball. also available at + https://imapsync.lamiral.info/#doc + https://imapsync.lamiral.info/INSTALL.d/ + +======================================================================= +Q. How to use imapsync? + +R. Read the TUTORIAL_Unix.txt file, maybe the README and, if you + encounter problems, the FAQ.d/* files in the tarball. + All are also available and updated at: + https://imapsync.lamiral.info/#doc + +======================================================================= +Q. Can you give some configuration examples? + +R1. Basic usage is described there: + https://imapsync.lamiral.info/#DOC_BASIC + +It is: + + imapsync --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ + --host2 test2.lamiral.info --user2 test2 --password2 secret2 + +R2. Some FAQ files contains many examples for several scenarios + https://imapsync.lamiral.info/#doc + (Gmail, Office365, Exchange, Darwin, etc.) + +======================================================================= +Q. How can I have commercial support? + +R. Buy support from imapsync author: Gilles LAMIRAL +https://imapsync.lamiral.info/#buy_all + +======================================================================= +Q. How can I have gratis support? + +R. Write to the imapsync author: Gilles LAMIRAL +https://imapsync.lamiral.info/#AUTHOR + +I help all users as long as I have time to help them all, +users who bought the support get my help first. + +======================================================================= +Q. Where I can find old imapsync releases? + +R. https://imapsync.lamiral.info/dist/old_releases/ + +======================================================================= +Q. Where I can find free open and gratis imapsync releases? + +R. https://imapsync.lamiral.info/dist/ + Github has a copy at + https://github.com/imapsync/imapsync + +Q. Is is legal to find imapsync gratis (or not) elsewhere? + +R. Yes, the license permits it + https://imapsync.lamiral.info/NOLIMIT + +======================================================================= +Q. How "Facts and figures" are known + https://imapsync.lamiral.info/#NUMBERS + +R. To know wether a newer imapsync exists or not, imapsync does a http + GET to http://imapsync.lamiral.info/VERSION + Via the User-agent parameter it also send: + + * imapsync release + * Perl version + * Mail::IMAPClient version + * Operating System + +You can remove this behavior by adding option --noreleasecheck on the +command line (or by setting $releasecheck = 0 in the source code) +or by using the github release. + +======================================================================= +Q. I use --useuid which uses a cache in /tmp or --tmpdir, the hostnames + host1 or host2 has changed but mailboxes are the same. Will imapsync + generate duplicate messages on next runs? + +R. Yes + +Q. How can I fix this? + +R. The cache path reflects exactly hostnames or ip addresses given via + --host1 and --host2 values. So just change the directory names + of host1 or host2. Use --dry to see if next runs will generate + duplicates. + By default on Unix the cache is like + + /tmp/imapsync_cache/host1/user1/host2/user2/... + +======================================================================= +Q. How can I speed up transfers? + +R. By using --useuid imapsync avoid getting messages headers and build + a cache. On Unix a good thing is to add also --tmpdir /var/tmp + to keep the cache since /tmp is often cleared on reboot. + + imapsync ... --useuid + +On Unix: + + imapsync ... --useuid --tmpdir /var/tmp/ + +R. Add also --nofoldersizes since the default behavior is to compute + folder sizes. Folder sizes are useless for the transfer, just + useful to see what has to be done on each folder and guess when + the transfer will end (ETA). + +R. Add also --noexpungeaftereach if you use --delete. + But be warn that an interrupted transfer can loose messages + on host2 in a second run if you use a (silly) combination like + + imapsync ... --delete --noexpunge --noexpungeaftereach --expunge2 + +R. Add also --nocheckmessageexists + --nocheckmessageexists is on by default since release 1.520. + Since transfer can be long on a huge mailbox imapsync checks + a message exist before copying it, but it takes time and + cpu on the host1 server. + +Notes about --useuid + +Case where building the cache first is necessary (to avoid multiples transfers) + +If you run again imapsync with --useuid on a transfer already done without +--useuid then, to avoid messages be copied again, first run imapsync +with --usecache but without --useuid, example scenario: + +A] Running with the default options, I began without --useuid + +1) First run with default options + + imapsync ... + +Too slow, I want to speed up! + +2) Build the cache + + imapsync ... --usecache + +3) Speed up now + + imapsync ... --useuid + +B] I began with --useuid from the first time + +1) First run and next runs with --useuid + + imapsync ... --useuid + + +Inodes number issue. + +The cache is simple, it uses the file-system natively, +it's just an empty file per message transfered. +When mailboxes are huge the cache can exhaust the number of inodes +allowed in the filesystem, that's a limitation like limitation +size but it's less often encountered. + +On Unix, to predict whether your tmpdir filesystem used by imapsync +will support the whole cache, just run the command "df -i /var/tmp", +if /var/tmp is the --tmpdir argument. + +On windows, search and drop me a note about how to count the number +of files allowed in the filesystem. +It seems FAT32 supports 268 435 445 clusters. + +Choosing the number of inodes allowed by a filesystem can be done +at the creation of it with "mkfs -N number-of-inodes ..." + +imapsync can predict how many messages have to be synced with the +option --justfoldersizes (no transfer will be done) + + imapsync ... --justfoldersizes + + +======================================================================= +Q. I see warning messages like the following: + "Host1 Sent/15 size 1428 ignored (no header so we ignore this message. + To solve this: use --addheader)". + What can I do to transfer those messages? + + +R1. Like suggested inline, use --addheader option. +Option --addheader will add an header line like +Message-Id: <15@imapsync> +where 15 is the message UID number on host1. +Then imapsync will transfer the changed message on host2. +Duplicates won't happen on next runs. + + imapsync ... --addheader + +R2. Other solution. +Use --useuid then imapsync will avoid dealing with headers. + + imapsync ... --useuid + +======================================================================= +Q. How can I try imapsync with latest Mail::IMAPClient 3.xx perl module? + +Three solutions at least. + +R1 - Look at the script named "i3" in the tarball, it can be used to + run imapsync with the included Mail-IMAPClient-3.39/ wherever you + unpacked the imapsync tarball + +R2 Run: + + cpanm Mail::IMAPClient # this uses cpanminus + + or + + cpan -i Mail::IMAPClient + + or + + perl -MCPAN -e "install Mail::IMAPClient" + + +R3 If you want to install the Perl module locally in a directory + + - Download latest Mail::IMAPClient 3.xx at + http://search.cpan.org/dist/Mail-IMAPClient/ + + - untar it anywhere: + tar xzvf Mail-IMAPClient-3.xx.tar.gz + + - Get any imapsync (latest is better). + + - run imapsync with perl and -I option tailing to use the perl + module Mail-IMAPClient-3.xx. Example: + + perl -I./Mail-IMAPClient-3.39/lib ./imapsync ... + + or if imapsync is in directory /path/ + perl -I./Mail-IMAPClient-3.39/lib /path/imapsync ... + + +======================================================================= +Q. How can I use imapsync with Mail::IMAPClient 2.2.9 perl module? + +R. Mail::IMAPClient 2.2.9 is no longer supported. + +======================================================================= +Q. How to verify imapsync.exe I got is the right file bit per bit? + +R. Use md5sum to check integrity of the file. + Get md5sum.exe at http://etree.org/md5com.html + + md5sum imapsync.exe + + Then compare the checksum with the one given by the author. + +======================================================================= +Q. Can I use imapsync to migrate emails from pop3 server to imap server? + +R1. No, but you can migrate emails from a pop3 server to an imap server +with the command line tool pop2imap: +http://www.linux-france.org/prj/pop2imap/ + +R2. Yes, sometimes, because many pop3 servers runs in parallel +with an imap server on exactly the same mailboxes. They serve +the same INBOX (imap serves INBOX and several other folders, +pop3 serves only INBOX). +So have a try with imapsync on the same host1. + +======================================================================= +Q. Folders are not created on host2. What happens? + +R. Do you use IMAP or POP3 with your client software? +It looks like you use POP3 instead of IMAP, POP3 sees only INBOX. + + +======================================================================= +Q. I am interested in creating a local clone of the IMAP on a LAN + server for faster synchronizations, email will always be delivered + to the remote server and so the synchronization will be one way - from + remote to local. How suited is imapsync for continuous one-way + synchronization of mailboxes? Is there a better solution? + +R. If messages are delivered remotely and you play locally with the + copy, in order to have fast access, then the synchronization can't + be one way. You may change flags, you may move messages in + different folders etc. The issue described is clearly + two-ways sync. + + A better tool with this scenario is offlineimap, + designed for this issue, and faster than imapsync. + + +======================================================================= +Q. I need to log every output on a file named log.txt + +R1. imapsync logs on a file by default, its name is given at the + beginning and the end of each run. This name is unique since + it is compound of the current date and time and user2 value. + +R2. To change this default name, use --logfile log.txt + + imapsync ... --logfile log.txt + + +======================================================================= +Q. Quantifier in {,} bigger than 32766 in regex; marked by <-- HERE in + m/(.{ <-- HERE 1,49947})(?:,|$)/ at Mail/IMAPClient.pm line 2121. + +R. Do not use a bigger value than 3276 with --split1 or --split2 + +======================================================================= +Q. Couldn't create [INBOX.Ops/foo/bar]: NO Invalid mailbox name: + INBOX.Ops/foo/bar + +Let begin by an explanation. + +Example: +sep1 = / +sep2 = . + +imapsync reverts each separator automatically. + +a) All / character coming from host1 are converted to . (convert the separator) +b) All . character coming from host1 are converted to / (to avoid +intermediate unwanted folder creation). + +So +INBOX/Ops.foo.bar (Ops.foo.bar is just one folder name) will be translated to +INBOX.Ops/foo/bar + +Sometimes the sep1 character is not valid on host2 (character "/" usually) + +R. Try : + + --regextrans2 "s,/,X,g" + +It'll convert / character to X +Choose X as you wish: _ or SEP or +any string (including the empty string). + +This issue is automatically fixed by default since imapsync +release 1.513, use --nofixslash2 to suppress the fix. + +======================================================================= +Q. Is it possible to sync also the UIDL of the POP3 server? + +R. imapsync doesn't talk POP3 but I think you mean UID in IMAP. + See next question. + +======================================================================= +Q. Is it possible to sync also the UIDs of the IMAP server? + +R. UIDs in IMAP are chosen and created by the server, not by the + client software. imapsync is a client software. So UIDs cannot + be synced by any imap method. + + UIDs may be synced via a rsync command between the imap servers but + it implies they are the same software, among other constraints. + +======================================================================= +Q. The option --subscribe does not seem to work + +R1. Use it with --subscribed + +R2. There is also the --subscribe_all option that subscribe + to all folders on host2. + +======================================================================= +Q. With huge account (many messages) when it comes to reading the + destination server it comes out this error: + "To Folder [INBOX.foobar] Not connected" + What can I do? + +R. May be spending too much time on the source server, the connection + timed out on the destination server. + Try options --nofoldersizes + +====================================================================== +Q. Can Imapsync filter Spam during the sync? + +R. No, imapsync doesn't detect Spam by itself. But I've seen blogs and + Spamassassin documentation explaining solutions to apply Spamassassin + to a imap mailbox. So you can apply one of these solutions on the host1 + source mailbox before the imapsync run or on the destination host2 + mailbox after the imapsync transfer. + +http://www.stearns.org/doc/spamassassin-setup.current.html#isbg +http://euer.krebsco.de/using-spamassassin-on-a-remote-imap-host.html +https://github.com/ook/isbg + + Imapsync can delegate this job during its IMAP syncs via the + --pipemess option but the underlying spam tool has to be written. + +====================================================================== +Q. How to migrate from uw-imap with an admin/authuser account? + +R. Use the following syntax: + + imapsync ... --user1="loginuser*admin_user" --password1 "admin_user_password" + + +====================================================================== +Q. How to migrate from cyrus with an admin account? + +R. Use: + + imapsync ... \ + --authuser1 admin_user ----password1 admin_user_password \ + --user1 foo_user --ssl1 + +Instead of --ssl1 the alternative --tls1 can be used. +With --authuser1, the option --authmech1 PLAIN is set +automatically, you don't have to add it. + +PLAIN authentication is the only way to go with --authuser1 for now. +So don't use --authmech1 SOMETHING with --authuser1 admin_user, +it will not work. +Same behavior with the --authuser2 option. + +Do not forget the option --ssl1 or --tls1 since PLAIN auth is only +supported with ssl encryption most of the time. But it can +work without --ssl1 nor --tls1 if PLAIN is permitted in clear text +transmissions (the normal mode). + +Add the AdminAccount to admins line in /etc/imapd.conf +Give AdminAccount lrswipkxtecda to the Cyrus Imap account +being migrated from, "joe" here. + + +Here is an example: + imapsync \ + --host1 server1 \ + --user1 joe \ + --authuser1 AdminAccount \ + --password1 AdminAccountPassword \ + --ssl1 \ + --host2 server2 \ + --user2 joe \ + --password2 joespassonserver2 \ + --exclude "^user\." + +====================================================================== +Q: How to migrate from Sun Java Enterprise System / Sun One / iPlanet / + Netscape servers with an admin account? + +R: Those imap servers don't allow the typical use of --authuser1 to use an +administrative account. They expect the use of an IMAP command called +proxyauth that is issued after login in as an administrative account. + +For example, consider the administrative account 'administrator' and your +real user 'real_user'. The IMAP sequence would be: + + OK [CAPABILITY IMAP4 IMAP4rev1 ACL QUOTA LITERAL+ NAMESPACE UIDPLUS + CHILDREN BINARY UNSELECT LANGUAGE STARTTLS XSENDER X-NETSCAPE XSERVERINFO + AUTH=PLAIN] imap.server IMAP4 service (Sun Java(tm) System Messaging + Server ...)) + 1 LOGIN administrator password + 1 OK User logged in + 2 PROXYAUTH real_user + 2 OK Completed + +In imapsync, you can achieve this by using the following options: + + --host1 source.imap.server \ + --user1 real_user \ + --authuser1 administrator \ + --proxyauth1 \ + --passfile admin.txt + +====================================================================== +Q. Is there a way to delete the destination folder when the source + folder is no longer there? + +R. Yes, use --delete2folders + +--delete2folders : Delete folders in host2 that are not in host1 server. + For safety, first try it like this (it is safe): + --delete2folders --dry --justfolders --nofoldersizes +--delete2foldersonly : Deleted only folders matching regex. + Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" +--delete2foldersbutnot : Do not delete folders matching regex. + Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" + +======================================================================= +Q. I would love to have a function to inject lines in the header. + Things like "X-migrated-from-foo: 20100617" + +R. You can do that with: + + imapsync ... --regexmess 's/\A/X-migrated-from-foo: 20100617\n/' + +It will insert a first header line containing "X-migrated-from-foo: 20100617" + +======================================================================= +Q. I want to play with headers line and --regexmess but I want to leave + the body as is. + +R. The header/body separation is a blank line so an example: + --regexmess 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}gxms' + +Will replace the next three lines + +Message-ID: <499EF800.4030002@blabla.fr> +Date: Fri, 20 Feb 2009 19:35:44 +0100 +From: Gilles LAMIRAL + +by the next four lines + +Message-ID: <499EF800.4030002@blabla.fr> +Date: Fri, 20 Feb 2009 19:35:44 +0100 +X-Date: Fri, 20 Feb 2009 19:35:44 +0100 +From: Gilles LAMIRAL + + +This example just add an header line "X-Date:" based on "Date:" line. + +======================================================================= +Q. My imap server does not accept a message and warns + "Invalid header". What is the problem? + +R. You fall in the classical mbox versus Maildir/ format + problem. May be you use a misconfigured procmail rule. + +A header beginning like the following one is in the mbox +format, header line 1 has no colon behind "From", header +lines 2 through N do have a colon : + +From foo@yoyo.org Sat Jun 22 01:10:21 2002 +Return-Path: +Received: ... + +Any Maildir/ configured imap server may refuse this message since its +header is invalid. The first "From " line is not valid. It lacks a +colon character ":". To solve this issue you have several solutions + +a) Remove manually this first "From " line for each message before + using imapsync. + +b) Replace manually the whitespace by a colon in string "From " but you + might end with two "From:" lines (just have a look at the other + header lines of the message) + +c) Run imapsync with the following option (this replaces "From "by "From:"): + --regexmess 's/\AFrom /From: /' + +or may be better (no other "From:" collision): + +d) Run imapsync with the following option (this replaces "From "by "X-om:"): + --regexmess 's/\AFrom /X-From: /' + +e) Run imapsync with the following option (this removes the whole "From " line): + --regexmess 's{\AFrom\ [^\n]*(\n)?}{}gxms' + +Solution e) is solution a) made by imapsync itself. +Solutions c) and d) keep "From " lines information +(normally it's useless to keep them) + +Best solutions are e) or d). + +======================================================================= +Q. The contact folder isn't well copied. + How to copy the contact folder? + +R. Forget the destination server (choose the same) +Change the script around line 1426 + # ITSD + $new_id = $from->copy($t_fold,$f_msg); + #$new_id = $to->append_string($t_fold,$string, $flags_f, $d); + +and tried a copy of the mail instead an append_string. Because we are +using the same server, we can use $from->copy Therefore we seem to not +download and upload the message and therefore we do not have any +format issues. And now it works fine. (Thanks to Hansjoerg.Maurer) + + +====================================================================== +Q: How can I write an .rpm with imapsync + +R. You'll find an RPM imapsync.spec file in the directory learn/rpm/ + It has been downloaded from + https://svn.fysik.dtu.dk/projects/rpmbuild/trunk/SPECS/imapsync.spec + It has been tested with imapsync 1.434 (May 2011) on CentOS5 + and RedHat RHEL5 Linux. (Thanks to Ole Holm Nielsen). + This imapsync.spec is coming from Neil Brown work in 2007. + +======================================================================= +Q. Where I can read up on the various IMAP RFCs? + +R. Here: + +RFC 3501 - INTERNET MESSAGE ACCESS PROTOCOL - VERSION 4rev1 +http://www.faqs.org/rfcs/rfc3501.html + +RFC2683 - IMAP4 Implementation Recommendations +http://www.faqs.org/rfcs/rfc2683.html + +RFC 2595 - Using TLS with IMAP, POP3 and ACAP +http://www.faqs.org/rfcs/rfc2595.html + +RFC 2822 - Internet Message Format +http://www.faqs.org/rfcs/rfc2822.html + +RFC 2342 - IMAP4 Namespace +http://www.faqs.org/rfcs/rfc2342.html + +RFC2180 - IMAP4 Multi-Accessed Mailbox Practice +http://www.faqs.org/rfcs/rfc2180.html + +RFC 4549 - Synchronization Operations for Disconnected IMAP4 Clients +http://www.faqs.org/rfcs/rfc4549.html + + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Gmail.txt b/FAQ.d/FAQ.Gmail.txt index ecf797d..20405f9 100644 --- a/FAQ.d/FAQ.Gmail.txt +++ b/FAQ.d/FAQ.Gmail.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Gmail.txt,v 1.25 2016/07/22 00:18:35 gilles Exp gilles $ +$Id: FAQ.Gmail.txt,v 1.33 2017/09/05 15:11:20 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -===================================== - Imapsync tips for Gmail accounts. -===================================== +======================================================================= + Imapsync tips for Gmail accounts. +======================================================================= Questions anwswered in this FAQ are: @@ -19,17 +19,22 @@ Q. How to synchronize from XXX to Gmail? Q. How to synchronize from Gmail to XXX? -Q. Can I use the Extension of the SEARCH command: X-GM-RAW described at - https://support.google.com/mail/answer/7190?hl=en - -Q. How to avoid the [IMAP] prefix on Gmail side? - Q. I can't authenticate with Gmail via IMAP and Gmail says "Please log in via your web browser" Q. Can not open imap connection on [imap.gmail.com] + Unable to connect to imap.gmail.com + +Q. Can I safely use --useuid for Gmail transfers? Q. Gmail does not really delete messages in folder [Gmail]/All Mail + What happens? What can I do? + +Q. Can I use the Extension of the SEARCH command: X-GM-RAW described at + https://support.google.com/mail/answer/7190?hl=en + https://developers.google.com/gmail/imap_extensions#extension_of_the_search_command_x-gm-raw + +Q. How to avoid the [IMAP] prefix on Gmail side? Q. Does imapsync have the capability to do 2 stage authentication? @@ -55,13 +60,25 @@ it has to be allowed in the Gmail configuration part: Q. How many days does it take to transfer X GB? R. Basically it takes X days to transfer X GB per account. - Gmail has usage limits per day + Gmail has usage limits per day and use throttlers when + they are overtaken http://support.google.com/a/bin/answer.py?hl=en&answer=1071518 - From the previous link, - it's 2X days to upload X GB to Gmail - it's X/2 days to download X BG from Gmail - but that's the theory. + From the previous link: + * it's 2X days to upload X GB to Gmail, it's why I suggest to add + --maxbytespersecond 10000 + for uploading messages to Gmail + * it's X/2 days to download X BG from Gmail, it's why I suggest to add + --maxbytespersecond 20000 + for downloading messages from Gmail + + That's theoretical values that always work in practice. Try + upper values and see if they still work. + + How Gmail says limits are reached? + This is either a disconnection with + "BYE Session expired, please login again" + or a very small rate, less than 1 Kib/s ======================================================================= Q. How to synchronize from Gmail to Gmail? @@ -275,6 +292,8 @@ label CanWait and only it. --skipcrossduplicates, will only put in "[Gmail]/All Mail" the messages that are not labeled at all. + + ======================================================================= Q. I can't authenticate with Gmail via IMAP and Gmail says "Please log in via your web browser" @@ -310,10 +329,16 @@ R0. It looks like this issue is related to ipv6. Both ipv4 and ipv6 protocols should work with gmail and imapsync, I test that regularly, imapsync works fine for both ipv4 and ipv6. If you disable ipv6 then disable also ipv6 resolution! -Or at least, make ipv4 answers be taken before ipv6 since the default -names resolution order is to present ipv6 name resolutions first. -R1. A first simple solution is to use directly gmail ipv4 ip address: +The default names resolution order is to present ipv6 name resolutions +first. If you know how to make ipv4 answers be taken before ipv6 +then tell me. + +R1. First solution, run imapsync with the option --inet4: + + imapsync ... --inet4 + +R2. A second solution is to use directly gmail ipv4 ip address: imapsync ... --host1 64.233.184.108 @@ -326,12 +351,23 @@ name resolution, try one of those: Or go to http://ping.eu/nslookup/ to get the resolution. -R2. Second solution. Fix imapsync with the line: - - use IO::Socket::SSL 'inet4' ; - Thanks to Chris Nolan to report, understand and fix this issue! +======================================================================= +Q. Can I safely use --useuid for Gmail transfers? + +R. Yes, but I suggest to not use --useuid for Gmail transfers. + +Using UIDs is useless with Gmail in the case of global duplicates +(duplicates across different folders). Gmail always accept a global +duplicate message as a new message, giving imapsync a new UID for this +message, and throw it away because it already has it. Gmail +will do this at each run so imapsync will always try to copy the +message, and Gmail will always accept and throw away the new copy. It +ends up with no duplicates on Gmail but a waste of bandwith and time, +which is the opposite goal of --usecache implied by --useuid. + + ======================================================================= Q. Gmail does not really delete messages in folder [Gmail]/All Mail What happens? What can I do? @@ -407,6 +443,8 @@ Q. How to migrate email from gmail to google apps? R. Take a look at: http://www.linux-france.org/prj/imapsync_list/msg00639.html -http://biasecurities.com/blog/2009/migrate-email-from-gmail-to-google-apps/ +http://biasecurities.com/2009/02/migrate-email-from-gmail-to-google-apps/ http://www.thamtech.com/blog/2008/03/29/gmail-to-google-apps-email-migration/ +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.ISP.txt b/FAQ.d/FAQ.ISP.txt index d42fac7..8ecd7c4 100644 --- a/FAQ.d/FAQ.ISP.txt +++ b/FAQ.d/FAQ.ISP.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.ISP.txt,v 1.4 2016/01/28 14:34:15 gilles Exp gilles $ +$Id: FAQ.ISP.txt,v 1.8 2017/06/21 18:09:00 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -========================================================= - Imapsync tips for ISP. Specific issues and solutions. -========================================================= +======================================================================= + Imapsync tips for ISP. Specific issues and solutions. +======================================================================= * IMAPSync - usage scenario with ISP - by Flávio Zarur Lucarelli. @@ -18,12 +18,43 @@ Lamiral for all his help and hard work. First of all, remember to use --dry to test things first always and check the log file to see what would actually happen. +Initially, I used a method where I'd do an exact sync of source to +destination, deleting messages which were in destination, but not +source. I call this "Method 2", below. In this cenario, customer +shouldn't be using the destination account yet. Then, after I switch MX, +I'd do a final sync based on date. The big advantage of this is, you +get an exact sync. + +Easier, however, is method 1, where I sync based on message ID, this +way, I can use the same syntax before and after MX change, with no +worries. Only disadvantage, you might not get an exact sync, there +might be some difference in terms of total emails in folders, due to +duplicates, emails that had same message ID in source server. + +* Method 1 - sync based on message ID, can use same syntax before and + after MX change + + imapsync --host1 imap.myisp.com --user1 user@domain.com --password1 pwd \ + --host2 imap.myisp.com --user2 user@domain.com --password2 pwd \ + --addheader + +Note: add header adds message ID when it doesn't exist. + +This syntax can also be used to sync different source accounts to one +same destination account, simply execute it as many times as desired, +switching source user (user1). + +* Method 2 - exact sync source do destination, then sync based on date + after MX change + My first goal is to have an exact sync of an account from current/source host to the new/destination host and be able to sync several times. The --useuid parameter is very important for that purpose. This is what I use: - imapsync --host1 imap.gmail.com --user1 user@domain.com --password1 pwd --ssl1 --host2 imap.myisp.com --user2 user@domain.com --password2 pwd --ssl2 --useuid --delete2 --delete2folders + imapsync --host1 imap.gmail.com --user1 user@domain.com --password1 pwd --ssl1 \ + --host2 imap.myisp.com --user2 user@domain.com --password2 pwd --ssl2 \ + --useuid --delete2 --delete2folders This makes it so imap.myisp.com (destination) is an exact copy of the account at imap.gmail.com (source). This is not a problem, since the @@ -51,7 +82,9 @@ cache) and delete such emails from source server. This way, customer's mailbox is still intact on the source server, except new emails, which get synced to new server and deleted from source. - imapsync --host1 imap.gmail.com --user1 user@domain.com --password1 pwd --ssl2 --folder INBOX --useuid --noexpungeaftereach --skipemptyfolders --maxage 1 --delete1 + imapsync --host1 imap.gmail.com --user1 user@domain.com --password1 pwd --ssl1 \ + --host2 imap.myisp.com --user2 user@domain.com --password2 pwd --ssl2 \ + --folder INBOX --useuid --noexpungeaftereach --skipemptyfolders --maxage 1 --delete1 I personally prefer to keep a copy of users box intact in source, but if that's not an issue for you, you can remove --folder INBOX and even @@ -70,5 +103,22 @@ lixeira (trash) and rascunhos (drafts). So this was added: - --regextrans2 "s,\[Gmail\].,," --regextrans2 "s,E-mails enviados,Sent," --regextrans2 "s,/Lixeira,Trash," --regextrans2 "s,/Rascunhos,Drafts," + --regextrans2 "s,\[Gmail\].,," \ + --regextrans2 "s,E-mails enviados,Sent," \ + --regextrans2 "s,Lixeira,Trash," \ + --regextrans2 "s,Rascunhos,Drafts," +*** Other cenarios + +- Sync entire account into 1 folder of another account + + imapsync --host1 xxx --user1 user1@domain.com --password1 secret1 --ssl1 \ + --host2 yyy --user2 user2@domain.com --password2 secret2 --ssl2 \ + --useuid --subfolder2 otheraccountfolder --delete2 --delete2foldersonly /otheraccountfolder/ + +Above is based on message UID, advantage of no dupes, however, user +must not be using such destination folder in destination account until +you finish syncing. + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Massive.txt b/FAQ.d/FAQ.Massive.txt index 30d4a94..9c277f7 100644 --- a/FAQ.d/FAQ.Massive.txt +++ b/FAQ.d/FAQ.Massive.txt @@ -1,20 +1,20 @@ #!/bin/cat -$Id: FAQ.Massive.txt,v 1.9 2016/03/25 19:59:45 gilles Exp gilles $ +$Id: FAQ.Massive.txt,v 1.15 2017/06/17 13:45:15 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -============================================== - Imapsync tips for massive/bulk migrations. -============================================== +======================================================================= + Imapsync tips for massive/bulk migrations. +======================================================================= Questions answered here are: Q. I need to migrate hundred accounts, how can I do? Q. I have to migrate 500k users using 400 TB of disk space. - How do I proceed? + How do I proceed? How about speed? -Q. How to determine what is the bottleneck in my current imapsync process? +Q. How to determine where is the bottleneck in an imapsync process? Q. Can I run more instances of imapsync in parallel on a Windows host? @@ -29,7 +29,7 @@ Q. I need to migrate hundred accounts, how can I do? R. If you have many mailboxes to migrate think about a little script program. Write a file called file.txt (for example) -containing hosts users and passwords on both sides. +containing hosts, users and passwords on both sides. The separator used in this example is ";" The file.txt file contains for example: @@ -40,16 +40,23 @@ host003_1;user003_1;password003_1;host003_2;user003_2;password003_2; host004_1;user004_1;password004_1;host004_2;user004_2;password004_2; etc. +Most of the times, the first column (host001_1, host002_1 ...) will +contains the same value, the value of --host1 parameter. Same +thing for the third column (host001_2, host002_2). + On Unix the shell script can be: #!/bin/sh { while IFS=';' read h1 u1 p1 h2 u2 p2 fake do imapsync --host1 "$h1" --user1 "$u1" --password1 "$p1" \ - --host2 "$h2" --user2 "$u2" --password2 "$p2" + --host2 "$h2" --user2 "$u2" --password2 "$p2" "$@" done } < file.txt +You can add extra options inside this script, just after the variable "$@". +You can also pass extra options via the parameters of this script +since they will go in "$@" Here is a complete Unix example ready to use: http://imapsync.lamiral.info/examples/sync_loop_unix.sh @@ -59,54 +66,142 @@ On Windows the batch script can be: CD /D %~dp0 SET csvfile=file.txt -FOR /F "tokens=1,2,3,4,5,6 delims=; eol=#" %%G IN (%csvfile%) DO ( +FOR /F "tokens=1,2,3,4,5,6,7 delims=; eol=#" %%G IN (%csvfile%) DO ( imapsync ^ --host1 %%G --user1 %%H --password1 %%I ^ - --host2 %%J --user2 %%K --password2 %%L ... + --host2 %%J --user2 %%K --password2 %%L %%M ... ) -The final ... can be replaced by nothing or any supplementary imapsync option. +You can add extra options inside this script, just after the variable %%M. +You can add extra options inside the file.txt, in the last column. Add +an extra semicolon at the end (optional) +Example: +host001_1;user001_1;password001_1;host001_2;user001_2;password001_2; +host002_1;user002_1;password002_1;host002_2;user002_2;password002_2; +becomes +host001_1;user001_1;password001_1;host001_2;user001_2;password001_2; --automap --addheader +host002_1;user002_1;password002_1;host002_2;user002_2;password002_2; --automap --addheader -Here is a complete Windows example nearly ready to use: +With this solution, options can be added, changed or removed per account. +Technically those options will go in %%M in the loop body + +Here is a complete Windows example ready to use: http://imapsync.lamiral.info/examples/sync_loop_windows.bat +Another solution to add extra arguments is to write another .bat that +calls sync_loop_windows.bat with the extra arguments, like this +for example: + + sync_loop_windows.bat --automap --addheader --maxmessagespersecond 4 + +Technically those options will go in %arguments% in the loop body +of sync_loop_windows.bat + ======================================================================= Q. I have to migrate 500k users using 400 TB of disk space. - How do I proceed? + How do I proceed? How about speed? R. Solution to this issue is two words: parallelism and measurements. -Since all 500k mailboxes are independent against each other, -they can be processed independently. -500k on 400TB is 800 MB per account on average. +Since all mailboxes are functionnaly independent, they can be processed +independently, here comes parallelism, lunching several imapsync +processes in parallel. -On any process involving several mechanisms there is always a -bottleneck among all elements taking part on the process. No one knows -in advance what is the first bottleneck. The first bottleneck has to -be determined, by measurements, not by guesses. Once this first +Meanwhile, mailboxes usually belong to the same server and syncs +share the same imapsync host via the same bandwidth, here come +some limitations and bottlenecks. + +How many syncs can we run in parallel? here comes measurements. + +1) Measure the total transfer rate by adding each one printed in each run. + Since adding this way is not so easy, just look at the overall + network rate of the imapsync host. + + On Linux, nload is good candidate to measure this overall + network rate, every 6 seconds, on eth0 interface, values in Kbytes: + + nload -t 6000 eth0 -u K + + Another excellent network tool is dstat: + + dstat -n -N eth0 6 + + On Windows, get the overall network rate with the classical + task manager (Ctrl-Alt-Sup), there is a network tab in it. + Don't hesitate to send me free good tools to measure the + overall transfer rate (the best would be one to sum up only + imap traffic but that's not mandatory at all). + +2) Launch new parallel runs, one by one, as long as the total + transfer rate increase. + +3) When the total transfer rate starts to diminish, stop new launches. + Note N as the number of parallel runs you got until then. + +4) Only keep N-2 parallel runs for the future. + + +======================================================================= +Q. How to determine where is the bottleneck in an imapsync process? + +R1. Divide and conquer. + +In order to detect whether host1/link1 is the bottleneck or +host2/link2, we have several tests to explore: + +1) run a sync from host1 to host1, with a host1 test account as destination. +This way, only host1+link1 are tested, host2 is not directly concerned. +If performances increase a lot then host2/link2 is the bottleneck. + +2) run a sync from host2 to host2, with a host2 test account as destination. +This way, only host2+link2 are tested, host1 is not concerned. +If performances increase a lot then host1/link1 is the bottleneck. + +If performances increase on both tests 1) and 2), I have no clue to explain that. +Same thing if they both decrease! + +R2. Isolating and overcoming bottlenecks + +On any process involving several mechanisms, among all elements taking +part on the process there is always a bottleneck. No one knows in +advance what is the first bottleneck. The first bottleneck has to be +determined, by measurements, not by guesses. Once this first bottleneck is known and overcome then the next bottleneck has to be determined and overcome too, if needed. Repeat the process of looking -for the next bottleneck and its resolution until you estimate the +for the next bottleneck and its elimination until you estimate the transfer rates, money costs and final dates are good enough to proceed -the whole 500k/400TB migration. +the whole huge migration. Possible bottlenecks: -- IMAP servers have artificial limits. For example Gmail and Office365 - have throttle limits. +- Throttles. + IMAP servers have artificial limits. + For example Gmail, Office365, Exchange have throttle limits. -- Bandwidth, on any side, especially on small Internet connexions. But - usually bandwidth is not a bottleneck. +- Bandwidth. + Usually available bandwidth is not a bottleneck. + Meanwhile, it can be a bottleneck on small Internet connexions. + Imapsync downloads messages from host1 and upload messages to host2, + consider this in case the connexion are asymetric. + +- I/O on disks. + I/O are a classical bottleneck, almost always forgotten. + Unlike CPU and RAM, Input/Output performances don't improve + very much as time goes on so it's often a bottleneck. -- Memory, on any side. Monitor your system doesn't swap on disk. +- RAM memory. + On all sides, monitor that your systems don't swap on disk, + because swapping memory on disks decreases performance by + a factor of 20, at least. -- CPU, on any side. When measuring that CPU is always 100% during a - transfer then it's useless to add imapsync processus on that host. - -- I/O on disks. A classical one always forgotten. Unlike CPU and RAM - Input/Output performances don't improve very much as time goes on. +- CPU. + 100% CPU during a whole transfer means the system is busy. + Usually CPU is not a problem with imapsync but it can be a problem + with one of the imap servers. + Most often CPU is not the real bottleneck, I/O are. +Other possible bottlenecks: - Number of hosts available to run imapsync processes. - Imapsync itself. - Errors management. @@ -116,25 +211,6 @@ Possible bottlenecks: - Bad luck. - ... -======================================================================= -Q. How to determine what is the bottleneck in my current imapsync process? - -R. Divide and conquer. - -In order to detect whether host1/link1 is the bottleneck or -host2/link2, we have several tests to explore: - -1) run a sync from host1 to host1, with a host1 test account as destination. -This way, only host1+link1 are tested. host2 is not concerned. -If performances increase a lot then host2/link2 is the bottleneck. - -2) run a sync from host2 to host2, with a host2 test account as destination. -This way, only host2+link2 are tested. host1 is not concerned. -If performances increase a lot then host1/link1 is the bottleneck. - -If performances increase on both tests 1) and 2), I have no clue to explain that. -Same thing if they both decrease! - ======================================================================= Q. Can I run more instances of imapsync in parallel on a Windows host? @@ -181,4 +257,5 @@ This file is removed at the end of a normal run. You can safely ignore the warning if you don't use imapsync.pid file to manage imapsync processes. - +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Memory.txt b/FAQ.d/FAQ.Memory.txt index 716c3e8..f6ebf6d 100644 --- a/FAQ.d/FAQ.Memory.txt +++ b/FAQ.d/FAQ.Memory.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Memory.txt,v 1.3 2016/05/09 13:01:22 gilles Exp gilles $ +$Id: FAQ.Memory.txt,v 1.4 2017/01/06 14:11:13 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -============================================ - Imapsync tips about memory issues. -============================================ +======================================================================= + Imapsync tips about memory issues. +======================================================================= ======================================================================= @@ -27,4 +27,5 @@ R2. Usually "Out of memory" errors are related to old days, Look at imapsync output first lines to get the Mail::IMAPClient release used. Then upgrade Mail::IMAPClient Perl module if needed. -======================================================================= \ No newline at end of file +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Messages_Selection.txt b/FAQ.d/FAQ.Messages_Selection.txt index d387264..b8be84f 100644 --- a/FAQ.d/FAQ.Messages_Selection.txt +++ b/FAQ.d/FAQ.Messages_Selection.txt @@ -1,22 +1,55 @@ #!/bin/cat -$Id: FAQ.Messages_Selection.txt,v 1.6 2016/04/18 12:45:20 gilles Exp gilles $ +$Id: FAQ.Messages_Selection.txt,v 1.12 2017/09/05 15:11:20 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -===================================== - Imapsync tips to select messages. -===================================== +======================================================================= + Imapsync tips to select messages. +======================================================================= -By default, Imapsync syncs all messages, avoiding duplicates. +Questions anwswered in this FAQ are: + +Q. What messages imapsync syncs by default? + +Q. Is there a way we can specify a date range to sync emails? + If yes, can you please share an example? + +Q. Is there a way we can specify an age to sync emails? + If yes, can you please share some examples? + +Q. I want to sync messages based on their UID. + +Q. Can I migrate only mails with attachments? + +Q. How can I move messages marked \Deleted from all folders to + a dedicated folder? + +Q. What are the selection criteria available with --search option? + + +======================================================================= +Q. What messages imapsync syncs by default? + +R. By default, Imapsync syncs all messages, except duplicates. ======================================================================= Q. Is there a way we can specify a date range to sync emails? If yes, can you please share an example? -R. Yes, with the --search option. +R. Yes, a date range is possible with the --search option. + imapsync ... --search "SENTSINCE 1-Jan-2010" + +or + + imapsync ... --search "SENTBEFORE 31-Dec-2010" + +or + imapsync ... --search "SENTSINCE 1-Jan-2010 SENTBEFORE 31-Dec-2010" + Months are specified like this: + Jan Feb Mar @@ -80,7 +113,8 @@ timezone) is earlier than the specified date. If --noabletosearch is on then --minage and --maxage deal with the internal dates given by a FETCH imap command but not the Date: header. Internal date is the arrival date -in the mailbox. +in the mailbox. Same remark for --noabletosearch1 and +--noabletosearch2 but only for one side then. ======================================================================= Q. I want to sync messages based on their UID. @@ -109,9 +143,29 @@ UIDs 20000 20002 20004: If you search n UIDs then you have to put n-1 OR in the search line, that's IMAP. +======================================================================= +Q. Can I migrate only mails with attachments? + +R. Use: + + imapsync ... --search "HEADER Content-Type multipart/mixed" + +or more generally: + + imapsync ... --search "OR HEADER Content-Disposition attachment HEADER Content-Type multipart/mixed" + ======================================================================= -Q. What is the selection criteria available with --search option? +Q. How can I move messages marked \Deleted from all folders to + a dedicated folder? + +R. To move \Deleted messages from all folders to a specific folder, + let's call it Trash, use: + + imapsync ... --search DELETED --regextrans2 "s/.*/Trash/" + +======================================================================= +Q. What are the selection criteria available with --search option? R. The list of search criteria are listed below, an excerpt from RFC3501. @@ -250,4 +304,5 @@ http://www.faqs.org/rfcs/rfc3501.html Messages that do not have the \Seen flag set. ======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.OnlineUI.txt b/FAQ.d/FAQ.OnlineUI.txt new file mode 100644 index 0000000..c4e2520 --- /dev/null +++ b/FAQ.d/FAQ.OnlineUI.txt @@ -0,0 +1,36 @@ +#!/bin/cat +$Id: FAQ.OnlineUI.txt,v 1.1 2017/05/04 23:24:55 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +===================================================================== + Imapsync tips about the online visual user interface + https://imapsync.lamiral.info/X/ +===================================================================== + +Q .Will I have any issues with browser timing out? What happens + if the connection is closed for whatever reason? + +R. It should be ok + +With the /X interface there is two connections (three connections in +fact but let simplify the picture), 1 is the Browser-WebServer +connection, 2 is the WebServer-ImapServers connections (imapsync +stuff). + +If the Browser-WebServer connection is timeout (but it shouldn't +because of the log refresh), the imapsync sync might continue +anyway. To see if it continues or not, just do a sync again and the +interface will tell you that a sync is already going on, if the +"Sync!" button is grey/inactive then just reload the page (F5 or +similar). + +Anyway, on the /X you can try to do several parallel runs on the same +mailbox even if there is no timeout, open a new tab/windows with /X +and start a same sync, it's safe, the /X will say, if any, that there +is already a current sync. + +You can stop this sync with the "Abort!" button from any /X +tab/window, even from another browser or place. To doing this with +success, you have to give the same account parameters, same +credentials, or imapsync will ignore the demand. diff --git a/FAQ.d/FAQ.Oracle-UCS.txt b/FAQ.d/FAQ.Oracle-UCS.txt index 43132b0..b855ada 100644 --- a/FAQ.d/FAQ.Oracle-UCS.txt +++ b/FAQ.d/FAQ.Oracle-UCS.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Oracle-UCS.txt,v 1.3 2016/01/28 14:34:15 gilles Exp gilles $ +$Id: FAQ.Oracle-UCS.txt,v 1.4 2017/01/06 14:11:13 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -================================================== - Imapsync tips for Oracle-UCS. Specific issues. -================================================== +======================================================================= + Imapsync tips for Oracle-UCS. Specific issues. +======================================================================= Oracle-UCS was previously Sun JES, IPlanet, etc. @@ -16,3 +16,5 @@ Oracle-UCS was previously Sun JES, IPlanet, etc. --skipmess 'm/[\x80-\xff]/' +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Passwords_on_Unix.txt b/FAQ.d/FAQ.Passwords_on_Unix.txt new file mode 100644 index 0000000..a67a161 --- /dev/null +++ b/FAQ.d/FAQ.Passwords_on_Unix.txt @@ -0,0 +1,21 @@ +#!/bin/cat +$Id: FAQ.Passwords_on_Unix.txt,v 1.1 2017/01/06 14:11:13 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +======================================================================= + Imapsync issues with passwords on Unix. +======================================================================= + + +======================================================================= +Q. On Unix, some passwords contain some *(),;& characters. Login fails. + +R. Use double-quotes within single-quotes in order to enclose the + password within double-quotes in the imap LOGIN command: + + imapsync ... --password1 '"passw*(),;&rd"' + + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Passwords_on_Windows.txt b/FAQ.d/FAQ.Passwords_on_Windows.txt index ac46c33..e536457 100644 --- a/FAQ.d/FAQ.Passwords_on_Windows.txt +++ b/FAQ.d/FAQ.Passwords_on_Windows.txt @@ -1,16 +1,18 @@ #!/bin/cat -$Id: FAQ.Passwords_on_Windows.txt,v 1.2 2016/05/10 19:19:16 gilles Exp gilles $ +$Id: FAQ.Passwords_on_Windows.txt,v 1.3 2017/01/06 14:11:13 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -====================================================== - Imapsync issues with passwords on Windows. -====================================================== +======================================================================= + Imapsync issues with passwords on Windows. +======================================================================= http://www.robvanderwoude.com/escapechars.php http://stackoverflow.com/questions/3288552/how-can-i-escape-an-exclamation-mark-in-cmd-scripts +In case you're brave and relentless, understand and try this: +http://www.dostips.com/forum/viewtopic.php?f=3&t=1733 ======================================================================= Q. On Windows, some passwords contain $ characters. Login fails. @@ -42,3 +44,5 @@ or even imapsync ... --password1 "==secret" +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Release_Checklist.txt b/FAQ.d/FAQ.Release_Checklist.txt new file mode 100644 index 0000000..ce498cd --- /dev/null +++ b/FAQ.d/FAQ.Release_Checklist.txt @@ -0,0 +1,22 @@ +#!/bin/cat +$Id: FAQ.Release_Checklist.txt,v 1.5 2017/09/07 12:38:45 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +=================================== + Imapsync developper notes +=================================== + + +Checklist before release a new release: + +- Generate the README +- Run a spell checker on the README +- Read the README again slowly. Fix all issues, all +- Read the OPTIONS section of README and read it very slowly +- Read slowly README_Windows.txt +- Read slowly the TUTORIAL_Unix file in html +- Review the newsletter by running: + m4 -P W/ml_announce.in + +- Review the general FAQ.d/FAQ.General.txt \ No newline at end of file diff --git a/FAQ.d/FAQ.Reporting_Bugs.txt b/FAQ.d/FAQ.Reporting_Bugs.txt new file mode 100644 index 0000000..bc641f0 --- /dev/null +++ b/FAQ.d/FAQ.Reporting_Bugs.txt @@ -0,0 +1,29 @@ +#!/bin/cat +$Id: FAQ.Reporting_Bugs.txt,v 1.2 2017/09/07 12:10:49 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +=================================================== + Imapsync bugs reports +=================================================== + +======================================================================= +Q. How can I report bugs or problems I encountered with Imapsync? + +R. Help me to help you: follow the following guidelines. + +Report any bug or feature request directly to the author by +email at + +Put a useful title with word "imapsync" in it: my spam filters +won't filter it. + +Provide me any useful information. The simplest way is to attach +the complete log file, in case it is not too big, let say less +than 1MB. Don't zip it, it will slow my response. + +Thanks! + +======================================================================= + + diff --git a/FAQ.d/FAQ.SSL_errors.txt b/FAQ.d/FAQ.SSL_errors.txt new file mode 100644 index 0000000..64fa665 --- /dev/null +++ b/FAQ.d/FAQ.SSL_errors.txt @@ -0,0 +1,56 @@ +#!/bin/cat +$Id: FAQ.SSL_errors.txt,v 1.1 2017/05/24 19:16:40 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +===================================================== + Imapsync SSL errors +===================================================== + +Questions anwswered in this FAQ are: + +Q. What are the errors + DEBUG: .../IO/Socket/SSL.pm:1165: local error: SSL write error + or + DEBUG: .../IO/Socket/SSL.pm:1088: local error: SSL read error + + +Q. What can I do to avoid those "SSL read/write errors"? + +======================================================================= +Q. What are the errors + DEBUG: .../IO/Socket/SSL.pm:1165: local error: SSL write error + or + DEBUG: .../IO/Socket/SSL.pm:1088: local error: SSL read error + +R. Like they claim, those errors are SSL errors. SSL is not directly + done by imapsync but by an underlying Perl module called + IO::Socket::SSL. Those errors arise sometimes and sometimes + they form a serie that ends with imapsync auto-abortion. + Those errors happen with some hosts but not with others, + it's often Exchange or Office365. I don't know what exactly happens. + Those errors happen more often on Windows than on Linux. + + +======================================================================= +Q. What can I do to avoid those "SSL read/write errors"? + +R1. Remove all ssl/tls encryption + + imapsync ... --nossl1 --notls1 --nossl2 --notls2 + +R2. If you don't want to quit encryption, rerun imapsync until the + complete sync is over. Those errors are not at the same place + each time, so imapsync will sync remaining messages at each run + until none remains. + +R3. Run imapsync on a Linux machine, a VM is ok, there are less + SSL errors on Unix. + +R4. Use https://imapsync.lamiral.info/X/ + It's a Linux host so R3 applies there. + +R5. Set up a ssltunnel proxy to the host. + Read the file FAQ.Security.txt + +======================================================================= \ No newline at end of file diff --git a/FAQ.d/FAQ.Security.txt b/FAQ.d/FAQ.Security.txt index 17537a6..2d8da17 100644 --- a/FAQ.d/FAQ.Security.txt +++ b/FAQ.d/FAQ.Security.txt @@ -1,44 +1,108 @@ #!/bin/cat -# $Id: FAQ.Security.txt,v 1.9 2016/08/19 17:53:21 gilles Exp gilles $ +# $Id: FAQ.Security.txt,v 1.16 2017/04/26 21:50:00 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -======================================================= - Imapsync tips about security. Issues and solutions. -======================================================= +======================================================================= + Imapsync tips about security. Issues and solutions. +======================================================================= + +SSL: going to encryption before the imap session start. + It is on port 993. + +TLS: going to encryption after the imap session start but before + the credential are sent. It is on port 143. + +======================================================================= +Q. Is running this program a secure method of transferring emails? + Are there any security concerns? + +R. Well, it depends. Use encryption, secure the access to the host running + imapsync and everything shall be safe. + +======================================================================= +Q. I noticed that the online UI has no option for TLS/SSL + Is this secure? Is this more secure that using the .bat file + on my computer? + +R1. The online UI does TLS/SSL imap connections if the imap + servers support TLS/SSL. If you are concerned by security then + using the .bat file or .sh on your computer should be more secure + since you can examine and secure it by yourself, no matter high is + your paranoïd spirit. The online UI security is mine, I am + concerned by security, not to the upmost high level possible + but I won't give you direct access to the host to discover my level. + With a good guy spirit, feel free to try to break the online UI + security and report me any security issue you encounter, I'll do my + best to fix them as soon as possible. Drop me a note before + starting because I may detect a sort of abuse and ban + definitively your IPs. + +======================================================================= +Q. Are transferred emails/attachments stored on any other + server/location aside from my originating/destination server(s)? + +R. No! + +======================================================================= +Q. Other than changing passwords on the originating/destination email + accounts once the relevant emails have been moved, + are there any other security tips I should know? + +R. Secure the host where imapsync is running since credentials are + on it. + +======================================================================= +Q. I need to transfer mail from an imap server to an other imap server. + Which ports need to be open on the firewall to make this possible? + +R. It depends. Open either: + * port 143 in basic (no special option) or tls mode (--tls1 or --tls2) + * port 993 in ssl mode (--ssl1 or --ssl2) ======================================================================= Q. Does imapsync support IMAP TLS? -R. Use --tls1 and/or --tls2 options +R1. Yes. + Use --tls1 and/or --tls2 options: ---tls1 tells imapsync to use tls on host1. ---tls2 tells imapsync to use tls on host2. + --tls1 tells imapsync to use tls on host1. + --tls2 tells imapsync to use tls on host2. +R2. Since imapsync release 1.755 TLS mode is activated automatically + if the server announce it supports it, STARTTLS inside the response + to CAPABILITY, and if neither --notls nor --ssl is explicitely + mentioned on the command line options. ======================================================================= Q. Does imapsync support IMAP over SSL (IMAPS)? R. Yes natively since release 1.161. -still, 2 ways, at least to use ssl: + Still, there are 2 ways, at least, to use ssl: a) Use native --ssl1 and/or --ssl2 options ---ssl1 tells imapsync to use ssl on host1. ---ssl2 tells imapsync to use ssl on host2. + --ssl1 tells imapsync to use ssl on host1. + --ssl2 tells imapsync to use ssl on host2. b) Use stunnel http://www.stunnel.org/ Assuming there is an imaps (993) server on imap.foo.org, - on your localhost machine (or bar machine) run : - stunnel -c -d imap -r imap.foo.org:imaps - or using names instead of numbers - stunnel -c -d 143 -r imap.foo.org:993 - then use imapsync on localhost (or bar machine) imap (143) port. - If the local port 143 is already taken then use a free one, 10143. + on your localhost machine (or bar machine), run: -c) Other example for gmail with no root access to open port 143 + stunnel -c -d imap -r imap.foo.org:imaps + + or using numbers instead of names: + + stunnel -c -d 143 -r imap.foo.org:993 + + then use imapsync on localhost (or bar machine) imap (143) port. + If the local port 143 is already taken then use a free one, + like 10143 for example. + +c) Other example for accessing gmail with no local root access + to open port 143 stunnel -f -P '' -c -d 9993 -r imap.gmail.com:993 @@ -47,12 +111,36 @@ Then, to access gmail as host2 use: imapsync ... --host2 localhost --port2 9993 --nossl2 +======================================================================= +Q.How can I test an ssl imap connection without imapsync? + +R1. Use either ncat or telnet-ssl or openssl commands like in the + following examples with imap.gmail.com server: + + ncat --ssl -C imap.gmail.com 993 + + telnet-ssl -z ssl imap.gmail.com 993 + + openssl s_client -crlf -connect imap.gmail.com:993 + +The previous commands are interactive, hit ctrl-c +to finish them. If you want to finish automatically, then use: + + { sleep 2; echo "a logout"; sleep 1; } | ncat --ssl -C imap.gmail.com 993 + + ======================================================================= Q. How can I manually test a login via ssl? -R. Use ncat or telnet-ssl like in this example: +R. Use either ncat or telnet-ssl or openssl commands like in the + following examples with imap.gmail.com server: -ncat --ssl -C imap.gmail.com 993 + ncat --ssl -C imap.gmail.com 993 + telnet-ssl -z ssl imap.gmail.com 993 + openssl s_client -crlf -connect imap.gmail.com:993 + +Tipical dialog for an imap LOGIN command: + * OK Gimap ready for requests from 78.196.254.58 q1mb175739668wix a LOGIN "gilles.lamiral@gmail.com" "secret" * CAPABILITY IMAP4rev1 UNSELECT IDLE NAMESPACE ... ESEARCH @@ -61,21 +149,27 @@ b LOGOUT * BYE LOGOUT Requested b OK 73 good day (Success) -The client part to type is "a LOGIN ..." and "b LOGOUT" without -the double-quotes. +The client part you have to type is +a LOGIN ... +b LOGOUT +while replacing ... by your credentials values. + ======================================================================= -Q.How to test a ssl imap connection without imapsync? +Q.How can I test an tls imap connection without imapsync? -R1.Use openssl command like the following, - an example with imap.gmail.com server: +R1. Use openssl command like the following example with + an outlook.office365.com server: - openssl s_client -crlf -connect imap.gmail.com:993 + openssl s_client -crlf -starttls imap -connect outlook.office365.com:143 -The previous command is an interactive connection, hit ctrl-c -to finish it. If you want to finish it gently, then use: +The previous commands are interactive, hit ctrl-c +to finish them. If you want to finish automatically, then use: + + { sleep 2; echo "a logout"; sleep 1; } | openssl s_client -crlf -starttls imap -connect outlook.office365.com:143 + +Replace outlook.office365.com with your imap server name. - { sleep 2; echo "a logout"; sleep 1; } | openssl s_client -crlf -connect imap.gmail.com:993 ====================================================================== Q. Imapsync used to use SSL_VERIFY_PEER now it uses SSL_VERIFY_NONE. @@ -130,3 +224,5 @@ b) or use stunnel : c) or use stunnel on inetd imaps stream tcp nowait cyrus /usr/sbin/stunnel -s cyrus -p /etc/ssl/certs/imapd.pem -r localhost:imap2 +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.SmarterMail.txt b/FAQ.d/FAQ.SmarterMail.txt index 2dda9c7..8cb5033 100644 --- a/FAQ.d/FAQ.SmarterMail.txt +++ b/FAQ.d/FAQ.SmarterMail.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.SmarterMail.txt,v 1.8 2016/01/28 14:34:15 gilles Exp gilles $ +$Id: FAQ.SmarterMail.txt,v 1.11 2017/09/05 15:11:20 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -================================================================= - Imapsync tips for SmarterMail. Specific issues and solutions. -================================================================= +======================================================================= + Imapsync tips for SmarterMail. Specific issues and solutions. +======================================================================= ======================================================================= @@ -14,7 +14,7 @@ Q. Synchronizing from SmarterMail to XXX On Unix: imapsync --host1 imap.d1.org --user1 joe --password1 secret1 \ --host2 imap.d2.org --user2 joe --password2 secret2 \ - --sep1 "/" --prefix1 "" --useheader Message-Id \ + --sep1 "/" --prefix1 "" --useheader Message-Id --noabletosearch1 \ --regextrans2 "s,Deleted Items,Trash," \ --regextrans2 "s,Junk E-Mail,Junk," \ --regextrans2 "s,Sent Items,Sent," @@ -22,7 +22,7 @@ imapsync --host1 imap.d1.org --user1 joe --password1 secret1 \ On Windows: imapsync.exe --host1 imap.d1.org --user1 joe --password1 secret1 ^ --host2 imap.d2.org --user2 joe --password2 secret2 ^ - --sep1 "/" --prefix1 "" --useheader Message-Id ^ + --sep1 "/" --prefix1 "" --useheader Message-Id --noabletosearch1 ^ --regextrans2 "s,Deleted Items,Trash," ^ --regextrans2 "s,Junk E-Mail,Junk," ^ --regextrans2 "s,Sent Items,Sent," @@ -36,13 +36,14 @@ Q. Synchronizing from XXX to SmarterMail On Unix: imapsync --host1 imap.d1.org --user1 joe --password1 secret1 \ --host2 imap.d2.org --user2 joe --password2 secret2 \ - --sep2 "/" --prefix2 "" --useheader Message-Id + --sep2 "/" --prefix2 "" --useheader Message-Id --noabletosearch2 On Windows: imapsync.exe --host1 imap.d1.org --user1 joe --password1 secret1 ^ --host2 imap.d2.org --user2 joe --password2 secret2 ^ - --sep2 "/" --prefix2 "" --useheader Message-Id + --sep2 "/" --prefix2 "" --useheader Message-Id --noabletosearch2 ======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.TTL.txt b/FAQ.d/FAQ.TTL.txt new file mode 100644 index 0000000..db769c3 --- /dev/null +++ b/FAQ.d/FAQ.TTL.txt @@ -0,0 +1,32 @@ +#!/bin/cat +$Id: FAQ.TTL.txt,v 1.1 2017/05/03 22:27:45 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +===================================================================== + Imapsync tips about TTL when changing name resolution of hosts +===================================================================== + +Why decrease the TTL (Time To Live) delay in DNS configuration, down +to 5 minutes? + +A small TTL is not mandatory, it's safer and more easy to work with when +migrating. + +It's about how long it takes to be sure the users are using the new +imap host, and how long it takes to be sure all new incoming messages +are going right now at the right place. Will you shut down the old +server just after the resolution change? I guess you won't and you'll +be right. + +The TTL is just a value, very well supported by machines, with a +little name resolution supplementary work for them when it is set to a +small value like 5 minutes, but it's a tremendous comfort for migrator +people like us. + +Be sure to wait 24h after this TTL change before changing any +resolution since the TTL change has to be propagated as well. After +the migration done, no problem to set back the TTL to 24h or more. If +you can't decrease TTL under 4h or even 24h, it's ok anyway, imapsync +can sync the new messages dropped in the old server. + diff --git a/FAQ.d/FAQ.Use_addheader.txt b/FAQ.d/FAQ.Use_addheader.txt index 61bca11..144a2ef 100644 --- a/FAQ.d/FAQ.Use_addheader.txt +++ b/FAQ.d/FAQ.Use_addheader.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Use_addheader.txt,v 1.1 2016/06/01 12:25:56 gilles Exp gilles $ +$Id: FAQ.Use_addheader.txt,v 1.4 2017/01/25 23:54:02 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -============================================ - Imapsync --addheader suggestion. -============================================ +======================================================================= + Imapsync --addheader suggestion. +======================================================================= ======================================================================= Q. What means this log message: @@ -22,9 +22,12 @@ R. In order to sync messages from one account to another Imapsync has messages except for special folders like Sent or Draft where messages in those folders don't have "Message-Id:" nor "Received:" headers. - Here comes -addheader option. Option --addheader adds - a "Message-Id" header consisting of the imap UID of the message - on the host1 folder, like "Message-Id: 12345@imapsync". - This way, messages are well identified on both sides. + Here comes --addheader option. When a message has no "Message-Id:" + nor "Received:", option --addheader adds a "Message-Id" header + consisting of the imap UID of the message on the host1 folder, + like "Message-Id: 12345@imapsync". + This way, messages are well identified on both sides, + transferred, and only once. ======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Use_cache.txt b/FAQ.d/FAQ.Use_cache.txt new file mode 100644 index 0000000..ef77939 --- /dev/null +++ b/FAQ.d/FAQ.Use_cache.txt @@ -0,0 +1,99 @@ + +$Id: FAQ.Use_cache.txt,v 1.4 2017/02/14 17:35:22 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +============================================ + Imapsync --usecache option +============================================ + +Questions anwswered in this FAQ are: + +Q. On Windows, with --useuid or --usecache a problem occurs with long + nested folder names. The error message is: + "No such file or directory; The filename or extension is too long" + +Q. Inode problem with --usecache on Linux + + +Questions and their answers: + +======================================================================= +Q. On Windows, with --useuid or --usecache a problem occurs with long + nested folder names. The error message is: + "No such file or directory; The filename or extension is too long" + +R. This comes from a Windows limitation on pathnames. +No more than 260 characters are allowed for pathnames. +See more details on page +http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx#maxpath +The workaround solution given at the previous link, +ie using \\?\D:", does not work for imapsync. +So this imapsync Windows bug is still pending and needs a fix using +a different technique to cache, like a database file for example. + +A solution to fix the issue is to use a Linux virtual host on a +Windows box, with VirtualBox or VmWare etc. There is no bug this way, +pathnames can be several thousands characters long. +Better said that done but not so difficult nor expensive these days, +VirtualBox is free and VmWare Player is free for personal or test use. + +If you have to stick on Windows, there are two good workarounds +to reduce the cache directory name: + +1) Use --tmpdir "D:\\temp" or simply --tmpdir "D:" and imapsync +will build and use the cache in the sub directory +D:\imapsync_cache\ + +2) add two equivalent entries in the etc/hosts for host1 imap.truc.org +and host2 imap.trac.org. +If you map the ip of imap.truc.org just with the letter a +and same thing for imap.trac.org then you gain characters + +etc/hosts + +192.168.12.1 a +192.168.55.3 b + +Then use: + + imapsync --host1 a --host2 b ... + +You can get the ip of a host with the ping command line +C:\> ping imap.truc.org + +3) A third solution is to not use options --useuid nor --usecache + +Fixing this long path problem directly in imapsync is in the TODO file +for a very long time. + +======================================================================= +Q. Inode problem with --usecache on Linux + +R. You may run out of inodes using --usecache, especially with large +migration. Option --usecache creates a empty file per email message +in order to keep the UIDs mapping between account1 and account2. + +So, if you plan to sync regularly 10 millions messages over a period +of migration then the filesystem of --tmpdir needs 10 millions of free +inodes. If it hasn't those free inodes then create a new special +filesystem devoted to the imapsync cache. + +# Create a file of 10 GB (10 millions*1024): + + dd if=/dev/zero of=/var/tmp/fscache bs=1M count=10000 + +# Create a filesystem where each file is only 1024 bytes per inode: + + mkfs.ext2 -F -i 1024 /var/tmp/fscache + +# Mount this brand new filesystem + + mount -o loop /var/tmp/fscache /var/tmp/cachedir + +# Tell imapsync to use it + + imapsync ... --tmpdir /var/tmp/cachedir/ + +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.User_Concurrent_Access.txt b/FAQ.d/FAQ.User_Concurrent_Access.txt index b5d2e6a..34ef0eb 100644 --- a/FAQ.d/FAQ.User_Concurrent_Access.txt +++ b/FAQ.d/FAQ.User_Concurrent_Access.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.User_Concurrent_Access.txt,v 1.1 2016/07/22 00:00:08 gilles Exp gilles $ +$Id: FAQ.User_Concurrent_Access.txt,v 1.2 2017/01/06 14:11:13 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -======================================= - Imapsync and user concurrent access. -======================================= +======================================================================= + Imapsync and user concurrent access. +======================================================================= ======================================================================= Q. What happens if a user access the mailbox during the transfer process? @@ -33,3 +33,4 @@ on what he does, where he does and when: * message flag change => might be canceled by the sync ======================================================================= +======================================================================= \ No newline at end of file diff --git a/FAQ.d/FAQ.Various_Server_Softwares.txt b/FAQ.d/FAQ.Various_Server_Softwares.txt index 908f80c..99bca37 100644 --- a/FAQ.d/FAQ.Various_Server_Softwares.txt +++ b/FAQ.d/FAQ.Various_Server_Softwares.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.Various_Server_Softwares.txt,v 1.4 2016/01/28 14:34:15 gilles Exp gilles $ +$Id: FAQ.Various_Server_Softwares.txt,v 1.8 2017/09/05 15:11:20 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -==================================================== - Imapsync tips for various imap server softwares. -==================================================== +======================================================================= + Imapsync tips for various imap server softwares. +======================================================================= @@ -43,22 +43,6 @@ http://www.safetynet-it.com/it-support/mac-kerio-server-to-microsoft-exchange-20 http://www.safetynet-it.com/it-support/mac-kerio-server-to-microsoft-exchange-2010-migration-2/ -======================================================================= -Q. Synchronizing from Yahoo to XXX - -R. Use --host1 imap.mail.yahoo.com --ssl1 - -./imapsync \ - --host1 imap.mail.yahoo.com \ - --user1 billy \ - --password1 secret \ - --ssl1 \ - --host2 XXX \ - --user2 billy \ - --password2 secret - -SSL is mandatory for yahoo since november 2011. - ======================================================================= Q. from Microsoft's Exchange 2007 to Google Apps for your Domain (GAFYD) @@ -228,14 +212,14 @@ R. Old Softalk releases don't support the IMAP SEARCH command. Here are the options to get it working. imapsync ... --sep1 '.' --prefix1 '' \ - --noabletosearch --nocheckmessageexists --addheader + --noabletosearch1 --nocheckmessageexists --addheader (Thanks to Andrew Tucker) ====================================================================== Q. From or to QQMail IMAP4Server -R. imapsync ... --noabletosearch +R. imapsync ... --noabletosearch1 ====================================================================== Q. From FirstClass to XXX @@ -264,8 +248,20 @@ Here is a command line used to migrate from FirtClass release 12: --regextrans2 "s,&AC8-,-,g" \ --regextrans2 "s,&APg-,oe,g" -On Windows, in the previous example containing \$1 you have to -replace the two \$1 by $1 (remove the \ before $). +On Windows: + imapsync.exe ... ^ + --automap ^ + --usecache ^ + --useheader Message-ID ^ + --idatefromheader ^ + --addheader ^ + --regextrans2 "s,(/|^) +,$1,g" ^ + --regextrans2 "s, +(/|$),$1,g" ^ + --regextrans2 "s/[\^]/_/g" ^ + --regextrans2 "s/['\\]/_/g" ^ + --regextrans2 "s,^&AC8-,-,g" ^ + --regextrans2 "s,^&APg-,oe,g" + Special thanks to Kristian Wind and Joey Alexander for helping me writing this FAQ item. @@ -283,3 +279,5 @@ R. Do NOT use --usecache since new UIDs are not given by FTGate and also --sep2 / --prefix2 "" \ --useheader Message-Id \ +======================================================================= +======================================================================= \ No newline at end of file diff --git a/FAQ.d/FAQ.Virus.txt b/FAQ.d/FAQ.Virus.txt new file mode 100644 index 0000000..6932aed --- /dev/null +++ b/FAQ.d/FAQ.Virus.txt @@ -0,0 +1,34 @@ + +$Id: FAQ.Virus.txt,v 1.2 2017/07/03 19:30:19 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +======================================================================= + Imapsync and virus scanners +======================================================================= + +======================================================================= +Q. My virus scanner claims imapsync.exe is a virus/malware/trojan etc. + What the hell? + +R. Yes, I found the same. Two antivirus, Baidu and Jiangmin, report that + imapsync might have a trojan in it. + All others virus scanner say imapsync.exe is ok. + I've done this test on imapsync.exe release 1.727 on the two following + meta-virus-scanners: + https://www.virustotal.com/ + https://www.metadefender.com/ + +R2. Explanation: + It may come from the fact that imapsync checks whether there is a + new realease available at http://imapsync.lamiral.info/VERSION + It's explained here: + https://imapsync.lamiral.info/#NUMBERS + + Any other explanation is welcome! + +R3. There is no virus alerts reported for the Perl script imapsync + itself. The binary imapsync.exe is just a compiled version of + the script imapsync, with perl interpreter itself and all modules + needed by imapsync in order to make imapsync.exe a standalone software. + diff --git a/FAQ.d/FAQ.XOAUTH2.txt b/FAQ.d/FAQ.XOAUTH2.txt index ba25ffc..92e76a6 100644 --- a/FAQ.d/FAQ.XOAUTH2.txt +++ b/FAQ.d/FAQ.XOAUTH2.txt @@ -1,11 +1,11 @@ #!/bin/cat -$Id: FAQ.XOAUTH2.txt,v 1.11 2016/07/27 23:08:19 gilles Exp gilles $ +$Id: FAQ.XOAUTH2.txt,v 1.12 2017/01/06 14:11:13 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc -====================================================================== +======================================================================= Imapsync tips to use XOAUTH2 authentication (Gmail) and old XOAUTH -====================================================================== +======================================================================= ======================================================================= @@ -187,4 +187,6 @@ Some notes about configuring the Google Apps XOAUTH: "https://mail.google.com/" configured (https://support.google.com/a/bin/answer.py?answer=162106). +======================================================================= +======================================================================= diff --git a/FAQ.d/FAQ.Yahoo.txt b/FAQ.d/FAQ.Yahoo.txt new file mode 100644 index 0000000..392f395 --- /dev/null +++ b/FAQ.d/FAQ.Yahoo.txt @@ -0,0 +1,54 @@ + +$Id: FAQ.Yahoo.txt,v 1.6 2017/06/17 14:42:01 gilles Exp gilles $ + +This documentation is also at http://imapsync.lamiral.info/#doc + +======================================================================= + Imapsync tips for Yahoo. +======================================================================= + + +======================================================================= +Q. Synchronizing from Yahoo to XXX + +R. Use --host1 imap.mail.yahoo.com --ssl1 + +./imapsync \ + --host1 imap.mail.yahoo.com \ + --user1 billy \ + --password1 secret \ + --ssl1 \ + --host2 XXX \ + --user2 billy \ + --password2 secret + +SSL is mandatory for yahoo since November 2011. + +You also need to go to Yahoo, security and enable +"Allow less secure apps to login", +otherwise the login will not work. + +To enable less secure apps to login: + * Login to the Yahoo mail account, + * click on the account name or the avatar and select "Account Info", + * click on "Account security", + * turn off "Two steps verification" + * turn on "Allow apps that use less secure authentication".​ + +Thanks to Eugen Mayer for this last point. + +Another solution: + + * Login to the Yahoo mail account, + * click on the account name or the avatar and select "Account Info", + * click on "Account security", + * Turn on "Two-step verification" + * Click on "Manage app passwords" and + generate a specific password for imapsync, + choose "Other app" at the bottom and type imapsync + since it is not in the predefined apps. + * Use this password with imapsync. + + +======================================================================= +======================================================================= diff --git a/FAQ.d/htaccess.txt b/FAQ.d/htaccess.txt index 46d7ab8..283af7b 100644 --- a/FAQ.d/htaccess.txt +++ b/FAQ.d/htaccess.txt @@ -1,31 +1,40 @@ -# $Id: htaccess.txt,v 1.10 2016/07/22 00:20:13 gilles Exp gilles $ +# $Id: htaccess.txt,v 1.18 2017/09/03 03:14:48 gilles Exp gilles $ -AddDescription "Back to Imapsync main page." .. -AddDescription "Archiving tips." FAQ.Archiving.txt -AddDescription "Connection issues." FAQ.Connection.txt -AddDescription "Contacts & Calendars issues." FAQ.Contacts_Calendars.txt -AddDescription "Dates issues." FAQ.Dates.txt -AddDescription "Domino." FAQ.Domino.txt -AddDescription "Dovecot." FAQ.Dovecot.txt -AddDescription "Duplicated messages issues." FAQ.Duplicates.txt -AddDescription "Emptying an account." FAQ.Emptying.txt -AddDescription "Exchange 20xx and Office365." FAQ.Exchange.txt -AddDescription "Changing folders names." FAQ.Folders_Mapping.txt -AddDescription "Selecting folders." FAQ.Folders_Selection.txt -AddDescription "Flags." FAQ.Flags.txt -AddDescription "Gmail accounts." FAQ.Gmail.txt -AddDescription "ISP tips." FAQ.ISP.txt -AddDescription "Massive/bulk migrations." FAQ.Massive.txt + +AddDescription "Back to Imapsync main page." .. +AddDescription "Authenticate via an admin account." FAQ.Admin_Authentication.txt +AddDescription "Authentication failures." FAQ.Authentication_failure.txt +AddDescription "Archiving tips." FAQ.Archiving.txt +AddDescription "Connection issues." FAQ.Connection.txt +AddDescription "Contacts & Calendars issues." FAQ.Contacts_Calendars.txt +AddDescription "Dates issues." FAQ.Dates.txt +AddDescription "Domino." FAQ.Domino.txt +AddDescription "Dovecot." FAQ.Dovecot.txt +AddDescription "Duplicated messages issues." FAQ.Duplicates.txt +AddDescription "Emptying an account." FAQ.Emptying.txt +AddDescription "Exchange 20xx and Office365." FAQ.Exchange.txt +AddDescription "Changing folders names." FAQ.Folders_Mapping.txt +AddDescription "Selecting folders." FAQ.Folders_Selection.txt +AddDescription "Flags." FAQ.Flags.txt +AddDescription "General and pot-pourri issues" FAQ.General.txt +AddDescription "Gmail accounts." FAQ.Gmail.txt +AddDescription "ISP tips." FAQ.ISP.txt +AddDescription "Massive/bulk migrations." FAQ.Massive.txt AddDescription "Memory issues." FAQ.Memory.txt AddDescription "Password & special characters on Windows." FAQ.Passwords_on_Windows.txt +AddDescription "Password & special characters on Unix." FAQ.Passwords_on_Unix.txt AddDescription "Selecting messages." FAQ.Messages_Selection.txt -AddDescription "Oracle-UCS." FAQ.Oracle-UCS.txt -AddDescription "Security." FAQ.Security.txt -AddDescription "SmarterMail." FAQ.SmarterMail.txt -AddDescription "User concurrent access." FAQ.User_Concurrent_Access.txt -AddDescription "Why use --addheader?." FAQ.Use_addheader.txt -AddDescription "Various imap server softwares." FAQ.Various_Server_Softwares.txt -AddDescription "XOAUTH2 (Gmail)." FAQ.XOAUTH2.txt +AddDescription "Oracle-UCS." FAQ.Oracle-UCS.txt +AddDescription "Guidelines to report bugs." FAQ.Reporting_Bugs.txt +AddDescription "Security." FAQ.Security.txt +AddDescription "SSL errors." FAQ.SSL_errors.txt +AddDescription "SmarterMail." FAQ.SmarterMail.txt +AddDescription "Option --usecache and inodes." FAQ.Use_cache.txt +AddDescription "User concurrent access." FAQ.User_Concurrent_Access.txt +AddDescription "Why use --addheader?." FAQ.Use_addheader.txt +AddDescription "Various imap server softwares." FAQ.Various_Server_Softwares.txt +AddDescription "XOAUTH2 (Gmail)." FAQ.XOAUTH2.txt +AddDescription "Yahoo." FAQ.Yahoo.txt AddDescription "Where this Description column comes from." htaccess.txt diff --git a/INSTALL b/INSTALL deleted file mode 100644 index e4c8903..0000000 --- a/INSTALL +++ /dev/null @@ -1,171 +0,0 @@ -# $Id: INSTALL,v 1.50 2016/01/21 15:06:34 gilles Exp gilles $ -# -# This is the main INSTALL file for imapsync. -# imapsync : IMAP sync and migrate tool. - -INTRODUCTION -============ - - imapsync works fine under any operating system with Perl and Perl modules (listed below). - imapsync.exe works fine standalone under Windows XP, Vista, Seven, 20XX, either 32 or 64bit. - -==================================== -== Installing imapsync on WINDOWS == -==================================== - -Read the file README_Windows.txt -Also available at -http://imapsync.lamiral.info/README_Windows.txt - - -================================= -== Installing imapsync on Unix == -================================= - -There are specific INSTALL files in the imapsync directory INSTALL.d/ -also available at http://imapsync.lamiral.info/INSTALL.d/ - -- Mac OS X -- FreeBSD -- CentOS -- CPanel -- Debian -- Ubuntu - -If you are not on one of these systems then read the section -below called "Installing imapsync on other Unixes". - -===================================== -== Installing imapsync on Mac OS X == -===================================== - -Easy. -Read the file INSTALL.d/INSTALL.Darwin.txt -Also available at -http://imapsync.lamiral.info/INSTALL.d/INSTALL.Darwin.txt - -===================================== -== Installing imapsync on FreeBSD == -===================================== - -Easy. -Read the file INSTALL.d/INSTALL.FreeBSD.txt -Also available at -http://imapsync.lamiral.info/INSTALL.d/INSTALL.FreeBSD.txt - - -=================================== -== Installing imapsync on CentOS == -=================================== - -Easy. -Read the file INSTALL.d/INSTALL.Centos.txt -Also available at -http://imapsync.lamiral.info/INSTALL.d/INSTALL.Centos.txt - - -=================================== -== Installing imapsync on CPanel == -=================================== - -Easy. -Read the file INSTALL.d/INSTALL.CPanel.txt -Also available at -http://imapsync.lamiral.info/INSTALL.d/INSTALL.CPanel.txt - - -========================================== -== Installing imapsync on Debian 6 or 7 == -========================================== - -Not so easy. -See the file INSTALL.d/INSTALL.Debian.txt -Also available at -http://imapsync.lamiral.info/INSTALL.d/INSTALL.Debian.txt - -============================================ -== Installing imapsync on Ubuntu 12 or 14 == -============================================ - -Not so easy. -See the file INSTALL.d/INSTALL.Ubuntu.txt -Also available at -http://imapsync.lamiral.info/INSTALL.d/INSTALL.Ubuntu.txt - - -========================================= -== Installing imapsync on other Unixes == -========================================= - - -Purchase imapsync at -http://imapsync.lamiral.info/ -or get it anywhere. - -You have access to a compressed tarball called imapsync-1.xxx.tgz -where 1.xxx is the version number. Untar the tarball where -you want: - - cd - tar xzvf imapsync-1.xxx.tgz - -Go into the directory imapsync-1.xxx - - cd imapsync-1.xxx - -You can easily detect any missing Perl modules via the -script prerequisites_imapsync located in the INSTALL.d directory: - - sh INSTALL.d/prerequisites_imapsync - -or - - cd INSTALL.d/ - sh prerequisites_imapsync - -You don't need to be root to run the previous command. You have -to be root if you want the Perl modules to be available for the -whole system, for all users. - -You may be in one of following cases: -- you are not root. -- you are in a environment where modifying system Perl - modules can break other things or where you're not allowed to - change the whole system. - -In the previous cases, you have to reinit cpan in order to use -your local account: - -FIX. The following commands can be replaced by what is described in -"Installing imapsync script on Darwin / Mac OS X" -at http://imapsync.lamiral.info/INSTALL.d/INSTALL.Darwin.txt - - - perl -MCPAN -e shell - # then inside the cpan shell type "o conf init" - cpan> o conf init - cpan> exit - # finally source your modified local bashrc - . $HOME/.bashrc - -Run again prerequisites_imapsync - - sh INSTALL.d/prerequisites_imapsync - -Run the "cpan -i" command with the missing Perl modules as arguments. -For example it can be: - - cpan -i Authen::NTLM Data::Uniqid File::Copy::Recursive IO::Tee Mail::IMAPClient Unicode::String - -Once you've run the "cpan -i" command, you can rerun "sh prerequisites_imapsync" -to verify everything is ok: - - sh prerequisites_imapsync - -When everything is ok the script execution ends with this sentence -"All needed modules are already installed" - -Now imapsync should work on your system. - - - diff --git a/INSTALL b/INSTALL new file mode 120000 index 0000000..317b2b7 --- /dev/null +++ b/INSTALL @@ -0,0 +1 @@ +INSTALL.d/INSTALL.ANY.txt \ No newline at end of file diff --git a/INSTALL.d/INSTALL.ANY.txt b/INSTALL.d/INSTALL.ANY.txt new file mode 100644 index 0000000..6a29d62 --- /dev/null +++ b/INSTALL.d/INSTALL.ANY.txt @@ -0,0 +1,165 @@ +# $Id: INSTALL.ANY.txt,v 1.55 2017/04/18 15:11:29 gilles Exp gilles $ +# +# This is the main INSTALL file for imapsync. +# imapsync : IMAP sync and migrate tool. + +INTRODUCTION +============ + + imapsync works fine under any operating system with Perl and Perl modules (listed below). + imapsync.exe works fine standalone under Windows XP, Vista, Seven, 20XX, either 32 or 64bit. + +==================================== +== Installing imapsync on WINDOWS == +==================================== + +Read the file README_Windows.txt +Also available at +https://imapsync.lamiral.info/README_Windows.txt + + +================================= +== Installing imapsync on Unix == +================================= + +There are specific INSTALL files in the imapsync directory INSTALL.d/ +also available at https://imapsync.lamiral.info/INSTALL.d/ + +- Mac OS X +- FreeBSD +- CentOS +- CPanel +- Debian +- Ubuntu +- AWS EC2 + +If you are not on one of these systems then read the section +below called "Installing imapsync on other Unixes". + +===================================== +== Installing imapsync on Mac OS X == +===================================== + +Easy. +Read the file INSTALL.d/INSTALL.Darwin.txt +Also available at +https://imapsync.lamiral.info/INSTALL.d/INSTALL.Darwin.txt + +===================================== +== Installing imapsync on FreeBSD == +===================================== + +Easy. +Read the file INSTALL.d/INSTALL.FreeBSD.txt +Also available at +https://imapsync.lamiral.info/INSTALL.d/INSTALL.FreeBSD.txt + + +=================================== +== Installing imapsync on CentOS == +=================================== + +Easy. +Read the file INSTALL.d/INSTALL.Centos.txt +Also available at +https://imapsync.lamiral.info/INSTALL.d/INSTALL.Centos.txt + + +=================================== +== Installing imapsync on CPanel == +=================================== + +Easy. +Read the file INSTALL.d/INSTALL.CPanel.txt +Also available at +https://imapsync.lamiral.info/INSTALL.d/INSTALL.CPanel.txt + + +========================================== +== Installing imapsync on Debian 6 or 7 == +========================================== + +Not so easy. +See the file INSTALL.d/INSTALL.Debian.txt +Also available at +https://imapsync.lamiral.info/INSTALL.d/INSTALL.Debian.txt + +============================================ +== Installing imapsync on Ubuntu 12 or 14 == +============================================ + +Not so easy. +See the file INSTALL.d/INSTALL.Ubuntu.txt +Also available at +https://imapsync.lamiral.info/INSTALL.d/INSTALL.Ubuntu.txt + +================================== += Installing imapsync on AWS EC2 = +================================== + +Not so easy. +See the file INSTALL.d/INSTALL.AWS_EC2.txt +Also available at +https://imapsync.lamiral.info/INSTALL.d/INSTALL.AWS_EC2.txt + + +========================================= +== Installing imapsync on other Unixes == +========================================= + + +Purchase imapsync at +https://imapsync.lamiral.info/ +or get it anywhere. + +You have access to a compressed tarball called imapsync-1.xxx.tgz +where 1.xxx is the version number. Untar the tarball where +you want: + + cd + tar xzvf imapsync-1.xxx.tgz + +Go into the directory imapsync-1.xxx + + cd imapsync-1.xxx + +You can easily detect any missing Perl modules via the +script prerequisites_imapsync located in the INSTALL.d directory: + + sh INSTALL.d/prerequisites_imapsync + +or + + cd INSTALL.d/ + sh prerequisites_imapsync + +You don't need to be root to run the previous command. You have +to be root if you want the Perl modules to be available for the +whole system, for all users. + +You may be in one of following cases: +- you are not root. +- you are in a environment where modifying system Perl + modules can break other things or where you're not allowed to + change the whole system. + +The "make" command is a prerequisite to build some Perl modules. +Install make in case it is not already installed. + +Run the "cpanm" command with the missing Perl modules as arguments. +For example it can be: + + cpanm Authen::NTLM Data::Uniqid File::Copy::Recursive IO::Tee Mail::IMAPClient Unicode::String + +Once you've run the "cpanm" command, you can rerun "sh prerequisites_imapsync" +to verify everything is ok: + + sh prerequisites_imapsync + +When everything is ok the script execution ends with this sentence +"All needed modules are already installed" + +Now imapsync should work on your system. To check it run: + + ./imapsync --testslive + diff --git a/INSTALL.d/INSTALL.AWS_EC2.txt b/INSTALL.d/INSTALL.AWS_EC2.txt new file mode 100644 index 0000000..7b9c276 --- /dev/null +++ b/INSTALL.d/INSTALL.AWS_EC2.txt @@ -0,0 +1,57 @@ +#!/bin/cat +# $Id: INSTALL.AWS_EC2.txt,v 1.3 2017/04/18 15:06:35 gilles Exp gilles $ + +================================== += Installing imapsync on AWS EC2 = +================================== + +AWS: Amazon Web Service + +cat /etc/system-release +Amazon Linux AMI release 2017.03 + + +sudo yum install \ +perl-Class-Load-0.20-3.6.amzn1.noarch \ +perl-IO-Compress-2.061-2.12.amzn1.noarch \ +perl-Crypt-OpenSSL-RSA-0.28-7.8.amzn1.x86_64 \ +perl-Data-Dumper-2.145-3.5.amzn1.x86_64 \ +perl-Dist-CheckConflicts-0.06-2.5.amzn1.noarch \ +perl-File-Copy-Recursive-0.38-14.8.amzn1.noarch \ +perl-IO-Socket-INET6-2.69-5.8.amzn1.noarch \ +perl-IO-Socket-SSL-1.94-3.13.amzn1.noarch \ +perl-JSON-2.59-2.8.amzn1.noarch \ +perl-HTML-Parser-3.71-4.7.amzn1.x86_64 \ +perl-libwww-perl-6.05-2.17.amzn1.noarch \ +perl-Mail-IMAPClient-3.34-1.2.amzn1.noarch \ +perl-Module-Implementation-0.06-6.6.amzn1.noarch \ +perl-Module-Runtime-0.013-4.5.amzn1.noarch \ +perl-Module-ScanDeps-1.10-3.7.amzn1.noarch \ +perl-Net-SSLeay-1.65-2.10.amzn1.x86_64 \ +perl-Package-Stash-0.34-2.6.amzn1.noarch \ +perl-Package-Stash-XS-0.26-3.7.amzn1.x86_64 \ +perl-Parse-RecDescent-1.967009-5.13.amzn1.noarch \ +perl-Readonly-1.03-22.8.amzn1.noarch \ +perl-Sys-MemInfo-0.91-7.5.amzn1.x86_64 \ +perl-TermReadKey-2.30-20.9.amzn1.x86_64 \ +perl-Test-Fatal-0.010-5.5.amzn1.noarch \ +perl-Test-MockObject-1.20120301-3.8.amzn1.noarch \ +perl-Test-Simple-0.98-243.6.amzn1.noarch \ +perl-Test-Pod-1.48-3.9.amzn1.noarch \ +perl-Test-Requires-0.06-10.6.amzn1.noarch \ +perl-Try-Tiny-0.12-2.5.amzn1.noarch \ +perl-Unicode-String-2.09-29.7.amzn1.x86_64 \ +perl-URI-1.60-9.8.amzn1.noarch \ +perl-ExtUtils-Embed-1.30-286.38.amzn1.noarch \ +cpanminus + +sudo cpanm Authen::NTLM Data::Uniqid IO::Tee JSON::WebToken JSON::WebToken::Crypt::RSA Test::Mock::Guard + +wget -N https://imapsync.lamiral.info/imapsync + +chmod +x imapsync + +./imapsync + +./imapsync --testslive + diff --git a/INSTALL.d/INSTALL.CPanel.txt b/INSTALL.d/INSTALL.CPanel.txt index 870cf64..2d2b7de 100644 --- a/INSTALL.d/INSTALL.CPanel.txt +++ b/INSTALL.d/INSTALL.CPanel.txt @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: INSTALL.CPanel.txt,v 1.4 2015/09/19 08:55:25 gilles Exp gilles $ +# $Id: INSTALL.CPanel.txt,v 1.5 2016/11/07 10:40:53 gilles Exp gilles $ ================================= = Installing imapsync on CPanel = diff --git a/INSTALL.d/INSTALL.Centos.txt b/INSTALL.d/INSTALL.Centos.txt index ae0de06..c44b228 100644 --- a/INSTALL.d/INSTALL.Centos.txt +++ b/INSTALL.d/INSTALL.Centos.txt @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: INSTALL.Centos.txt,v 1.5 2016/01/14 20:25:32 gilles Exp gilles $ +# $Id: INSTALL.Centos.txt,v 1.6 2016/11/07 10:40:53 gilles Exp gilles $ ================================= = Installing imapsync on CentOS = diff --git a/INSTALL.d/INSTALL.Darwin.txt b/INSTALL.d/INSTALL.Darwin.txt index 39f5127..2268152 100644 --- a/INSTALL.d/INSTALL.Darwin.txt +++ b/INSTALL.d/INSTALL.Darwin.txt @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: INSTALL.Darwin.txt,v 1.14 2016/06/22 19:57:00 gilles Exp gilles $ +# $Id: INSTALL.Darwin.txt,v 1.16 2016/11/07 05:06:34 gilles Exp gilles $ =================================================== = Installing imapsync binary on Darwin / Mac OS X = @@ -57,32 +57,49 @@ you have to use: = Installing imapsync script on Darwin / Mac OS X = =================================================== -This part is only for advanced Unix users, or brave ones. +This part is only for advanced Unix users, or brave users. -wget --no-check-certificate -O- http://cpanmin.us | perl - -l ~/perl5 App::cpanminus local::lib -eval `perl -I ~/perl5/lib/perl5 -Mlocal::lib` -perl -I ~/perl5/lib/perl5 -Mlocal::lib +The "make" command is a prerequisite to build some Perl modules. +Install make in case it is not already installed. -echo 'eval `perl -I ~/perl5/lib/perl5 -Mlocal::lib`' >> ~/.profile -echo 'export MANPATH=$HOME/perl5/man:$MANPATH' >> ~/.profile -cat ~/.profile -cpanm CPAN +First let us install cpanminus locally in ~/perl5 -curl -L http://imapsync.lamiral.info/INSTALL.d/prerequisites_imapsync > prerequisites_imapsync -sh prerequisites_imapsync + wget --no-check-certificate -O- http://cpanmin.us | perl - -l ~/perl5 App::cpanminus local::lib -cpanm Authen::NTLM -cpanm File::Copy::Recursive IO::Tee -cpanm Mail::IMAPClient -cpanm Readonly -cpanm Unicode::String +Then take this install into account in the current environment -wget -c http://imapsync.lamiral.info/imapsync -./imapsync -perl ./imapsync -perl ./imapsync --modules -cpanm Data::Uniqid -cpanm JSON::WebToken + eval `perl -I ~/perl5/lib/perl5 -Mlocal::lib` + perl -I ~/perl5/lib/perl5 -Mlocal::lib + +If you want to have always this setting in your environment then run the commands + + echo 'eval `perl -I ~/perl5/lib/perl5 -Mlocal::lib`' >> ~/.profile + echo 'export MANPATH=$HOME/perl5/man:$MANPATH' >> ~/.profile + cat ~/.profile + +Now let's update the standard CPAN Perl module + + cpanm CPAN + +The specific install part for imapsync begins, the script "prerequisites_imapsync" +helps to verify what is needed to install on your system + + curl -L http://imapsync.lamiral.info/INSTALL.d/prerequisites_imapsync > prerequisites_imapsync + sh prerequisites_imapsync + + cpanm Authen::NTLM + cpanm File::Copy::Recursive IO::Tee + cpanm Mail::IMAPClient + cpanm Readonly + cpanm Unicode::String + cpanm Data::Uniqid + cpanm JSON::WebToken + +We're ready to install and test the latest imapsync + + wget -c http://imapsync.lamiral.info/imapsync + ./imapsync + ./imapsync --modules You can rerun "sh prerequisites_imapsync" to verify everything is ok: @@ -94,6 +111,8 @@ When everything is ok the script execution ends with this sentence Now imapsync should work on your system. + ./imapsync --testslive + ================================================= = Building imapsync binary on Darwin / Mac OS X = ================================================= diff --git a/INSTALL.d/INSTALL.Debian.txt b/INSTALL.d/INSTALL.Debian.txt index 8a347d1..4e008dc 100644 --- a/INSTALL.d/INSTALL.Debian.txt +++ b/INSTALL.d/INSTALL.Debian.txt @@ -1,7 +1,110 @@ #!/bin/cat -# $Id: INSTALL.Debian.txt,v 1.7 2016/06/22 19:58:32 gilles Exp gilles $ +# $Id: INSTALL.Debian.txt,v 1.15 2017/04/05 02:03:04 gilles Exp gilles $ + +There is three install sections in this document, +one for Debian 9 Stretch +one for Debian 8 Jessie +one for Debian 7 Wheezy + +First a call to Debian packagers +Why imapsync is not in Debian as a package? +Imapsync used to be in Debian from 2005-04-25 (release 1.125) to 2011-01-25 (release 1.315). +It could be in Debian nowadays, as always, my last words on this discussion were +"Do what you want, I promise I won't complain anymore about the fact imapsync is on Debian or not." +https://lists.debian.org/debian-legal/2011/01/msg00058.html +The license is now "No limits to do anything with this work and this license". +and full dist/ is back to https://imapsync.lamiral.info/dist/ +Feel free. +See also a more detailed story at +https://lists.debian.org/debian-user/2016/11/msg00849.html + + +=========================================== += Installing imapsync on Debian 9 Stretch = +=========================================== + +Here is the command to install imapsync dependencies. +You need root priviledge to run it. + +apt install -y \ + libjson-webtoken-perl \ + libauthen-ntlm-perl \ + libcgi-pm-perl \ + libcrypt-openssl-rsa-perl \ + libdata-uniqid-perl \ + libfile-copy-recursive-perl \ + libio-socket-ssl-perl \ + libio-tee-perl \ + libhtml-parser-perl \ + libjson-webtoken-perl \ + libmail-imapclient-perl \ + libparse-recdescent-perl \ + libmodule-scandeps-perl \ + libreadonly-perl \ + libsys-meminfo-perl \ + libterm-readkey-perl \ + libtest-mockobject-perl \ + libtest-pod-perl \ + libunicode-string-perl \ + liburi-perl \ + libwww-perl + +After installing the dependencies, imapsync should be working, +go to the section "After installing the dependencies" below. + + +========================================== += Installing imapsync on Debian 8 Jessie = +========================================== + +Here are the commands to install imapsync dependencies. +You need root priviledge to run them. + +The first command installs standard Debian packages: +apt install \ +libauthen-ntlm-perl \ +libcgi-pm-perl \ +libcrypt-openssl-rsa-perl \ +libdata-uniqid-perl \ +libfile-copy-recursive-perl \ +libio-socket-inet6-perl \ +libio-socket-ssl-perl \ +libio-tee-perl \ +libhtml-parser-perl \ +libmail-imapclient-perl \ +libparse-recdescent-perl \ +libmodule-scandeps-perl \ +libreadonly-perl \ +libterm-readkey-perl \ +libtest-mockobject-perl \ +libtest-pod-perl \ +libunicode-string-perl \ +liburi-perl \ +libwww-perl \ +make \ +cpanminus + + +The following second command installs "manually" the Perl module Sys::MemInfo +because Debian hasn't made it available via a package yet. + + cpanm Sys::MemInfo + +The following optional cpanm command updates Perl module Mail::IMAPClient +because it is good to be up to date with that imapsync dependency, +but it is not mandatory since Mail::IMAPClient is installed by +the Debian package libmail-imapclient-perl: + + cpanm Mail::IMAPClient + +Last, in case you need to use XOAUTH2 authentication you have to install +the module JSON::WebToken with the command: + + cpanm JSON::WebToken + +After installing the dependencies, imapsync should be working, +go to the section "After installing the dependencies" below. -There is one section for Debian 7 and one for Debian 6. ========================================== = Installing imapsync on Debian 7 Wheezy = @@ -12,125 +115,92 @@ You need root priviledge to run them. The first command installs standard Debian packages: - apt-get install \ -libauthen-ntlm-perl \ -libcrypt-ssleay-perl \ + apt-get install \ +libauthen-ntlm-perl \ +libclass-load-perl \ +libcrypt-openssl-rsa-perl \ libdigest-hmac-perl \ libfile-copy-recursive-perl \ -libio-compress-perl \ +libio-compress-perl \ libio-socket-inet6-perl \ libio-socket-ssl-perl \ libio-tee-perl \ +libmail-imapclient-perl \ +libmodule-implementation-perl \ +libmodule-runtime-perl \ libmodule-scandeps-perl \ -libnet-ssleay-perl \ +libpackage-stash-perl \ +libpackage-stash-xs-perl \ libpar-packer-perl \ libreadonly-perl \ libterm-readkey-perl \ +libtest-fatal-perl \ libtest-pod-perl \ +libtest-requires-perl \ libtest-simple-perl \ libunicode-string-perl \ liburi-perl \ +make \ cpanminus -The second command installs "manually" the Perl module Data::Uniqid -because Debian hasn't made it available via a package yet. -It also install manually Perl module Mail::IMAPClient because -it is good to be up to date: +The following second command installs "manually" the Perl modules +Data::Uniqid +Sys::MemInfo +because Debian hasn't made them available via a package yet. +This cpanm command also installs manually Perl module Mail::IMAPClient +because it is good to be up to date with that imapsync dependency, +but it is not mandatory since Mail::IMAPClient is installed by +the Debian package libmail-imapclient-perl: + + cpanm Data::Uniqid Sys::MemInfo + +In case you want to update the Perl module Mail::IMAPClient, +a major module for imapsync, but an old March 2012 release 3.31 in Wheezy, +the following command updates it "manually": + + cpanm Mail::IMAPClient + +Last, in case you need to use XOAUTH2 authentication you have to install +the module JSON::WebToken with the command: + + cpanm JSON::WebToken - cpanm Data::Uniqid Mail::IMAPClient After installing the dependencies, imapsync should be working. +===================================== += After installing the dependencies = +====================================== + You don't have to be root to test and use imapsync. -Take the compressed tarball called imapsync-1.xxx.tgz -where 1.xxx is the version number. -Untar the tarball where you want: - cd - tar xzvf imapsync-1.xxx.tgz +Take imapsync either on github or at the upstream site: -Go into the directory imapsync-1.xxx + wget -N https://imapsync.lamiral.info/dist/imapsync - cd imapsync-1.xxx +Add execution permission to the downloaded script: -A dependencies test that shows also the basic example: + chmod +x imapsync + +Check the dependencies and print also the basic example: ./imapsync -A live test showing imapsync job: +Perform a live test showing imapsync job: ./imapsync --testslive -Now the install command (need root priviledges again): +Now install imapsync on the system (need root priviledges again): cp imapsync /usr/bin/ That's finished for the installation part. -You can use imapsync. +You can now use imapsync without knowing where it is located +on the system: + + imapsync Now go to read http://imapsync.lamiral.info/#doc start with the tutorial. -=========================================== -= Installing imapsync on Debian 6 Squeeze = -=========================================== - - - apt-get install \ -libcrypt-ssleay-perl \ -libdigest-hmac-perl \ -libfile-copy-recursive-perl \ -libio-compress-perl \ -libio-socket-inet6-perl \ -libio-socket-ssl-perl \ -libio-tee-perl \ -libmodule-scandeps-perl \ -libnet-ssleay-perl \ -libpar-packer-perl \ -libreadonly-perl \ -libterm-readkey-perl \ -libtest-pod-perl \ -libtest-simple-perl \ -libunicode-string-perl \ -liburi-perl - - - perl -MCPAN -e "install Data::Uniqid" - perl -MCPAN -e "install Authen::NTLM" - perl -MCPAN -e "install Mail::IMAPClient" - -The Perl module Mail::IMAPClient is good to be recent -and installed manually. - -After installing the dependencies, imapsync should be working. - -You don't have to be root to test and use imapsync. -Take the compressed tarball called imapsync-1.xxx.tgz -where 1.xxx is the version number. -Untar the tarball where you want: - - cd - tar xzvf imapsync-1.xxx.tgz - -Go into the directory imapsync-1.xxx - - cd imapsync-1.xxx - -A dependencies test that shows also the basic example: - - ./imapsync - -A live test showing imapsync job: - - ./imapsync --testslive - -Now the install command (need root priviledges again): - - cp imapsync /usr/bin/ - -That's finished for the installation part. -You can use imapsync. - -Now go to read http://imapsync.lamiral.info/#doc -start with the tutorial. diff --git a/INSTALL.d/INSTALL.Docker.txt b/INSTALL.d/INSTALL.Docker.txt new file mode 100644 index 0000000..8064b82 --- /dev/null +++ b/INSTALL.d/INSTALL.Docker.txt @@ -0,0 +1,17 @@ +#!/bin/cat +# $Id: INSTALL.Docker.txt,v 1.1 2017/09/03 03:23:54 gilles Exp gilles $ + +======================================= += Installing imapsync docker image +======================================= + +== Installation == + + docker pull gilleslamiral/imapsync + +== Usage == + + docker run gilleslamiral/imapsync imapsync + + + diff --git a/INSTALL.d/INSTALL.Docker_build.txt b/INSTALL.d/INSTALL.Docker_build.txt new file mode 100644 index 0000000..355a173 --- /dev/null +++ b/INSTALL.d/INSTALL.Docker_build.txt @@ -0,0 +1,51 @@ +#!/bin/cat +# $Id: INSTALL.Docker_build.txt,v 1.5 2017/04/07 08:45:20 gilles Exp gilles $ + +================================================= += Building an imapsync docker image from Debian = +================================================= + + +# Dockerfile for building a docker imapsync image + +FROM debian:stretch + +LABEL maintainer "gilles.lamiral@laposte.net" + +RUN apt-get update \ + && apt-get install -y \ + libjson-webtoken-perl \ + libauthen-ntlm-perl \ + libcgi-pm-perl \ + libcrypt-openssl-rsa-perl \ + libdata-uniqid-perl \ + libfile-copy-recursive-perl \ + libio-socket-ssl-perl \ + libio-tee-perl \ + libhtml-parser-perl \ + libjson-webtoken-perl \ + libmail-imapclient-perl \ + libparse-recdescent-perl \ + libmodule-scandeps-perl \ + libpar-packer-perl \ + libreadonly-perl \ + libsys-meminfo-perl \ + libterm-readkey-perl \ + libtest-mockobject-perl \ + libtest-pod-perl \ + libunicode-string-perl \ + liburi-perl \ + libwww-perl \ + procps \ + wget \ + && rm -rf /var/lib/apt/lists/* + +RUN wget -N https://imapsync.lamiral.info/imapsync \ + && cp imapsync /usr/bin/imapsync \ + && chmod +x /usr/bin/imapsync + +USER nobody + +CMD ["/usr/bin/imapsync"] + +# End of Dockerfile diff --git a/INSTALL.d/INSTALL.FreeBSD.txt b/INSTALL.d/INSTALL.FreeBSD.txt index 2920100..fc8f331 100644 --- a/INSTALL.d/INSTALL.FreeBSD.txt +++ b/INSTALL.d/INSTALL.FreeBSD.txt @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: INSTALL.FreeBSD.txt,v 1.6 2015/09/19 08:55:25 gilles Exp gilles $ +# $Id: INSTALL.FreeBSD.txt,v 1.7 2016/11/07 10:40:53 gilles Exp gilles $ ================================== = Installing imapsync on FreeBSD = diff --git a/INSTALL.d/INSTALL.OnlineUI.txt b/INSTALL.d/INSTALL.OnlineUI.txt new file mode 100644 index 0000000..5370158 --- /dev/null +++ b/INSTALL.d/INSTALL.OnlineUI.txt @@ -0,0 +1,70 @@ +#!/bin/cat +# $Id: INSTALL.OnlineUI.txt,v 1.8 2017/09/01 22:50:06 gilles Exp gilles $ + +============================== += Installing imapsync online = +============================== + +Please consider this as relatively new and experimental. +I add I'm begining to be confident with /X since the /X service +is up and running quite well since january 2017. + +You have to be a little familiar with what is a CGI script +and how to activate it on an Apache (or any other) HTTP server. + +The web visual user interface frontend is the file +https://imapsync.lamiral.info/X/imapsync_form.html +You can do a "view source" to see it as it is written, +and a "save" to get it locally. + +This imapsync_form.html file in action calls the CGI location +/cgi-bin/imapsync +which has to be imapsync itself. + +The very latest and relatively stable imapsync is at +https://imapsync.lamiral.info/imapsync +It is the program file used verbatim for the service given at +https://imapsync.lamiral.info/X/ + +So copy both imapsync_form.html and imapsync on a HTTP server +allowing CGIs and you'll have your own imapsync visual interface. + + +Example on a Debian server with Apache: + +Imapsync place on the server disk: +/usr/lib/cgi-bin/imapsync + +This classical /cgi-bin directory is configured in Apache +configuration file +/etc/apache2/sites-available/default-ssl +or +/etc/apache2/sites-available/default + +It contains somewhere (maybe in comments for now, +with some # characters to make them ignored): + +ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/ + + AllowOverride None + Options +ExecCGI -MultiViews + Order allow,deny + Allow from all + + +The UI frontend file place on the server disk is +/var/www/X/imapsync_form.html +but it can be placed it anywhere on disk, the important +thing is that it has to be served by the web server. + +The imapsync working directory in cgi mode is +/var/tmp/imapsync_cgi/ +it is not configurable unless changing it in +imapsync directly, it is hardcoded in imapsync. +In this directory will go the log files and +the pid files. + +Use at least CGI.pm release 4.08 (2014-10-18) +to avoid the bug "Undefined subroutine CGI::multi_param" + + diff --git a/INSTALL.d/INSTALL.Ubuntu.txt b/INSTALL.d/INSTALL.Ubuntu.txt index bfe9d8d..744285f 100644 --- a/INSTALL.d/INSTALL.Ubuntu.txt +++ b/INSTALL.d/INSTALL.Ubuntu.txt @@ -1,43 +1,54 @@ #!/bin/cat -# $Id: INSTALL.Ubuntu.txt,v 1.7 2016/06/22 19:58:32 gilles Exp gilles $ +# $Id: INSTALL.Ubuntu.txt,v 1.10 2017/03/30 11:23:37 gilles Exp gilles $ ================================================= -= Installing imapsync on Ubuntu 12.04 or higher = += Installing imapsync on Ubuntu 16.04 or higher = ================================================= -Here are the two commands to install imapsync dependencies. -You need root priviledge to run them. - -The first command installs standard Ubuntu packages: +Here is the command to install imapsync dependencies, +you need root privilege to run them. +This command installs standard Ubuntu packages: sudo apt-get install \ -libauthen-ntlm-perl \ -libcrypt-ssleay-perl \ -libdigest-hmac-perl \ +libauthen-ntlm-perl \ +libclass-load-perl \ +libcrypt-ssleay-perl \ +libdata-uniqid-perl \ +libdigest-hmac-perl \ +libdist-checkconflicts-perl \ libfile-copy-recursive-perl \ -libio-compress-perl \ +libio-compress-perl \ libio-socket-inet6-perl \ -libio-socket-ssl-perl \ -libio-tee-perl \ +libio-socket-ssl-perl \ +libio-tee-perl \ +libmail-imapclient-perl \ libmodule-scandeps-perl \ libnet-ssleay-perl \ -libpar-packer-perl \ -libreadonly-perl \ -libterm-readkey-perl \ -libtest-pod-perl \ +libpar-packer-perl \ +libreadonly-perl \ +libsys-meminfo-perl \ +libterm-readkey-perl \ +libtest-fatal-perl \ +libtest-mock-guard-perl \ +libtest-pod-perl \ +libtest-requires-perl \ libtest-simple-perl \ -libunicode-string-perl \ -liburi-perl \ -libtest-mockobject-perl \ +libunicode-string-perl \ +liburi-perl \ +make \ cpanminus -The second command installs "manually" the Perl module Data::Uniqid -because Debian hasn't made it available via a package yet. -It also install manually Perl module Mail::IMAPClient because -it is good to be up to date: +In case you want to update the Perl module +Mail::IMAPClient, a major module for imapsync, +the following command installs it "manually": - sudo cpanm Data::Uniqid Mail::IMAPClient + sudo cpanm Mail::IMAPClient + +In case you need to use XOAUTH2 authentication you have to install +the module JSON::WebToken with the command: + + sudo cpanm JSON::WebToken After installing the dependencies, imapsync should be working. diff --git a/INSTALL.d/prerequisites_imapsync b/INSTALL.d/prerequisites_imapsync index a79d384..9604e9a 100755 --- a/INSTALL.d/prerequisites_imapsync +++ b/INSTALL.d/prerequisites_imapsync @@ -1,36 +1,54 @@ #!/bin/sh -# $Id: prerequisites_imapsync,v 1.16 2016/08/16 16:25:01 gilles Exp gilles $ +# $Id: prerequisites_imapsync,v 1.21 2017/08/31 02:12:36 gilles Exp gilles $ MODULES_MANDATORY=' Authen::NTLM +Class::Load Compress::Zlib +Crypt::OpenSSL::RSA Data::Dumper Data::Uniqid -Digest::HMAC_MD5 Digest::HMAC +Digest::HMAC_MD5 Digest::MD5 +Dist::CheckConflicts +Encode::Byte File::Copy::Recursive IO::Socket::INET IO::Socket::INET6 IO::Socket::SSL IO::Tee +JSON JSON::WebToken +JSON::WebToken::Crypt::RSA +HTML::Entities +LWP::UserAgent Mail::IMAPClient +Module::Implementation +Module::Runtime +Module::ScanDeps +Net::Ping +Net::SSLeay +Package::Stash +Package::Stash::XS +PAR::Packer Parse::RecDescent +Pod::Usage Readonly +Sys::MemInfo Term::ReadKey +Test::Fatal +Test::Mock::Guard Test::MockObject Test::More Test::Pod +Test::Requires +Try::Tiny Unicode::String URI::Escape ' -MODULES_DEVEL=' -Module::ScanDeps -PAR::Packer -' test_perl() { # First we need perl @@ -45,6 +63,21 @@ test_perl() { fi } +test_make() { +# Second we need make to build some Perl modules + + if make -v > /dev/null 2>&1 ; then + make_version=`make -v |head -1` + echo Ok: Found make $make_version + return 0 + else + echo Failure: make is not here. You have to install the make command. + return 1 + fi +} + + + test_module() { test -n $1 || return @@ -102,7 +135,7 @@ search_modules_yum() { for M in "$@" ; do echo "==== Searching rpm package name for $M" F=`echo $M|tr -s ":" "/"`.pm - #echo yum -q whatprovides "*/$F" + echo yum -q whatprovides "*/$F" echo yum -q whatprovides "*/$F" echo @@ -147,6 +180,7 @@ test_unix() { test_unix #exit test_perl || exit +test_make || exit test_mandatory_modules list_to_install EXIT=$? diff --git a/Makefile b/Makefile index 190c56b..f07ab3d 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.239 2016/08/19 14:17:26 gilles Exp gilles $ +# $Id: Makefile,v 1.257 2017/09/11 11:11:18 gilles Exp gilles $ .PHONY: help usage all doc @@ -17,10 +17,12 @@ usage: @echo "make test_quick # few tests verbosely" @echo "make W/test.bat # run --tests and W/test.bat on win32" @echo "make W/test_tests.bat # run --tests on win32" + @echo "make W/test_testsdebug.bat # run --testsdebug on win32" @echo "make W/test2.bat # run W/test2.bat on win32" @echo "make W/test3.bat # run W/test3.bat on win32" @echo "make W/test_reg.bat # run W/test_reg.bat on win32" @echo "make W/test_exe.bat # run W/test_exe.bat on win32" + @echo "make W/test_exe_tests.bat # run W/test_exe_tests.bat on win32" @echo "make W/test_exe_2.bat # run W/test_exe_2.bat on win32" @echo "make examples/sync_loop_windows.bat # run examples/sync_loop_windows.bat on win32" @@ -30,7 +32,9 @@ usage: @echo "make upload_tests # upload tests.sh" @echo "make upload_index" @echo "make upload_FAQ # upload FAQs and documentation" + @echo "make upload_X # upload online UI" @echo "make upload_latest # upload latest imapsync and binaries (dev)" + @echo "make upload_cgi # upload latest imapsync" @echo "make valid_index # check index.shtml for good syntax" @echo "make upload_ks" @echo "make imapsync.exe" @@ -39,10 +43,14 @@ usage: @echo "make win # build win binary" @echo "make lin # build linux binary" @echo "make publish" - @echo "make perlcritic" + @echo "make crit # run perlcritic on imapsync" @echo "make prereq # Generates W/prereq.*" @echo "make cl # Check links of index.shtml" - @echo "make cle # Check links of S/*.shtml" + @echo "make cle # Check links of S/*.shtml" + @echo "make mactestsdebug # run ./imapsync --testsdebug on Mac" + @echo "make mactests # run ./imapsync --tests on Mac" + @echo "make ks2testsdebug # run ./imapsync --testsdebug on ks2" + @echo "make ks2tests # run ./imapsync --tests on ks2" PREFIX ?= /usr @@ -55,13 +63,17 @@ VERSION_PREVIOUS=$(shell perl -I$(IMAPClient) ./dist/imapsync --version 2>/dev/n VERSION_EXE=$(shell cat ./VERSION_EXE) HELLO=$(shell date;uname -a) -IMAPClient_3xx=./W/Mail-IMAPClient-3.38/lib +IMAPClient_3xx=./W/Mail-IMAPClient-3.39/lib IMAPClient=$(IMAPClient_3xx) HOSTNAME = $(shell hostname -s) ARCH = $(shell uname -m) KERNEL = $(shell uname -s) BIN_NAME = imapsync_bin_$(KERNEL)_$(ARCH) +DISTRO_NAME = $(shell lsb_release -i -s || echo Unknown) +DISTRO_RELEASE = $(shell lsb_release -r -s || echo 0.0) +DISTRO_CODE = $(shell lsb_release -c -s || echo Unknown) +DISTRO = $(DISTRO_NAME)_$(DISTRO_RELEASE)_$(DISTRO_CODE) hello: @echo "$(VERSION)" @@ -70,6 +82,7 @@ hello: @echo "$(ARCH)" @echo "$(KERNEL)" @echo "$(BIN_NAME)" + @echo "$(DISTRO)" all: doc VERSION biz prereq allcritic bin VERSION_EXE @@ -82,12 +95,10 @@ ChangeLog: imapsync rlog imapsync > ChangeLog README: imapsync - perldoc -t imapsync > README - -OPTIONS: imapsync - perl -I./$(IMAPClient) ./imapsync --help > ./OPTIONS + pod2text --loose imapsync > README VERSION: imapsync + rcsdiff imapsync perl -I./$(IMAPClient) ./imapsync --version > ./VERSION touch -r ./imapsync ./VERSION @@ -99,21 +110,34 @@ VERSION_EXE: imapsync doc/GOOD_PRACTICES.html: doc/GOOD_PRACTICES.t2t txt2tags -i doc/GOOD_PRACTICES.t2t -t html --toc -o doc/GOOD_PRACTICES.html + ./W/tools/validate_html4 doc/GOOD_PRACTICES.html + ./W/tools/validate doc/GOOD_PRACTICES.html + doc/TUTORIAL_Unix.html: doc/TUTORIAL_Unix.t2t txt2tags -i doc/TUTORIAL_Unix.t2t -t html --toc -o doc/TUTORIAL_Unix.html + ./W/tools/validate_html4 doc/TUTORIAL_Unix.html + ./W/tools/validate doc/TUTORIAL_Unix.html -doc: README OPTIONS ChangeLog doc/TUTORIAL_Unix.html doc/GOOD_PRACTICES.html W/imapsync.1 -.PHONY: clean clean_tilde clean_test doc clean_log clean_bak +doc: README ChangeLog doc/TUTORIAL_Unix.html doc/GOOD_PRACTICES.html W/imapsync.1 -clean: clean_tilde clean_man clean_log clean_bak +.PHONY: clean clean_tilde clean_test doc clean_log clean_bak clean_permissions + +clean: clean_tilde clean_man clean_log clean_bak clean_permissions + +clean_permissions: + chmod a-x Makefile FAQ.d/FAQ.*.txt README_Windows.txt + chmod a-x INSTALL.d/INSTALL.*.txt + chmod a-x X/progress.html X/imapsync_form.html + chmod a-x S/*.shtml S/*.html + chmod a-x doc/*.t2t dist/*.txt clean_test: rm -f .test_3xx clean_tilde: - rm -f *~ W/*~ FAQ.d/*~ S/*~ INSTALL.d/*~ + rm -f *~ W/*~ FAQ.d/*~ S/*~ INSTALL.d/*~ examples/*~ clean_log: rm -f LOG_imapsync/*.txt @@ -130,7 +154,6 @@ clean_man: rm -f imapsync.1 W/imapsync.1: imapsync -# pod2man < /dev/null pod2man imapsync > W/imapsync.1 install: testp W/imapsync.1 @@ -149,18 +172,24 @@ ci: cidone cidone: rcsdiff W/*.bat W/*.sh W/*.out W/*.txt W/*.htaccess - rcsdiff S/*.txt S/*.shtml S/*.html rcsdiff doc/*.t2t rcsdiff INSTALL.d/*.txt INSTALL.d/prerequisites_imapsync rcsdiff FAQ.d/*.txt rcsdiff examples/*.sh examples/*.bat examples/*.txt rcsdiff RCS/* + rcsdiff W/tools/backup_old_dist W/tools/gen_README_dist W/tools/validate_html4 W/tools/validate_xml_html5 W/tools/fix_email_for_exchange.py + rcsdiff S/*.txt S/*.shtml S/*.html ############### # Local goals ############### -.PHONY: prereq test tests testp testf test3xx testv3 perlcritic allcritic compok +.PHONY: prereq test tests unitests testp testf test3xx testv3 perlcritic allcritic crit compok dev + +dev: test crit bin + +docker: + ssh ks3 'cd docker/imapsync && . memo' compok: W/.compok @@ -169,33 +198,38 @@ W/.compok: imapsync perl -c imapsync touch W/.compok -prereq: W/prereq.scandeps +prereq: W/prereq.scandeps.$(DISTRO).txt -W/prereq.scandeps: INSTALL.d/prerequisites_imapsync imapsync - scandeps -c -x imapsync | tee W/prereq.scandeps - rcsdiff W/prereq.scandeps || { echo 'rcsdiff detected a diff' | ci -l W/prereq.scandeps ; } - ./INSTALL.d/prerequisites_imapsync | tee W/prereq.`lsb_release -i -s || echo Unknown` +W/prereq.scandeps.$(DISTRO).txt: INSTALL.d/prerequisites_imapsync imapsync + scandeps -c -x imapsync | tee W/prereq.scandeps.$(DISTRO).txt + rcsdiff W/prereq.scandeps.$(DISTRO).txt || { echo 'rcsdiff detected a diff' | ci -l W/prereq.scandeps.$(DISTRO).txt ; } + ./INSTALL.d/prerequisites_imapsync | tee W/prereq.$(DISTRO).txt +crit: allcritic perlcritic: W/perlcritic_3.out W/perlcritic_2.out allcritic: W/perlcritic_4.out W/perlcritic_3.out W/perlcritic_2.out W/perlcritic_1.out W/perlcritic_1.out: imapsync W/.compok - perlcritic --statistics -1 imapsync > W/perlcritic_1.out || : + perlcritic --statistics -1 imapsync > W/perlcritic_1.out.tmp || : + mv W/perlcritic_1.out.tmp W/perlcritic_1.out echo | ci -l W/perlcritic_1.out W/perlcritic_2.out: imapsync W/.compok - perlcritic --statistics -2 imapsync > W/perlcritic_2.out || : + perlcritic --statistics -2 imapsync > W/perlcritic_2.out.tmp || : + mv W/perlcritic_2.out.tmp W/perlcritic_2.out echo | ci -l W/perlcritic_2.out W/perlcritic_3.out: imapsync W/.compok - perlcritic --statistics -3 imapsync > W/perlcritic_3.out || : + perlcritic --statistics -3 imapsync > W/perlcritic_3.out.tmp || : + mv W/perlcritic_3.out.tmp W/perlcritic_3.out echo | ci -l W/perlcritic_3.out W/perlcritic_4.out: imapsync W/.compok - perlcritic --statistics -4 imapsync > W/perlcritic_4.out || : + perlcritic --statistics -4 imapsync > W/perlcritic_4.out.tmp || : + mv W/perlcritic_4.out.tmp W/perlcritic_4.out echo | ci -l W/perlcritic_4.out @@ -215,6 +249,9 @@ test: .test_3xx tests: test +unitests: + perl -I./$(IMAPClient_3xx) ./imapsync --tests + # .test_3xx is created by tests.sh with success at all mandatory tests .test_3xx: imapsync tests.sh CMD_PERL='perl -I./$(IMAPClient_3xx)' /usr/bin/time sh tests.sh 1>/dev/null @@ -302,6 +339,12 @@ W/test_exe.bat: ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test_exe.bat' ./W/check_winerr test_exe.bat +W/test_exe_tests.bat: + unix2dos W/test_exe_tests.bat + scp W/test_exe_tests.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' + ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test_exe_tests.bat' + ./W/check_winerr test_exe_tests.bat + W/build_exe.bat: unix2dos W/build_exe.bat scp W/build_exe.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' @@ -333,6 +376,11 @@ W/install_module_one.bat: scp W/install_module_one.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/install_module_one.bat' +W/uninstall_module_one.bat: + unix2dos W/uninstall_module_one.bat + scp W/uninstall_module_one.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' + ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/uninstall_module_one.bat' + imapsync.exe: imapsync rcsdiff imapsync ssh Admin@c 'perl -V' @@ -365,7 +413,7 @@ zip: dosify_bat mkdir -p ../prepa_zip/imapsync_$(VERSION_EXE)/FAQ.d/ ../prepa_zip/imapsync_$(VERSION_EXE)/Cook/ cp -av examples/imapsync_example.bat examples/sync_loop_windows.bat examples/file.txt ../prepa_zip/imapsync_$(VERSION_EXE)/ cp -av W/build_exe.bat W/install_modules.bat W/test_cook_exe.bat W/test_cook_src.bat imapsync ../prepa_zip/imapsync_$(VERSION_EXE)/Cook/ - for f in FAQ README ; do cp -av $$f ../prepa_zip/imapsync_$(VERSION_EXE)/$$f.txt ; done + for f in README ; do cp -av $$f ../prepa_zip/imapsync_$(VERSION_EXE)/$$f.txt ; done cp -av FAQ.d/*.txt ../prepa_zip/imapsync_$(VERSION_EXE)/FAQ.d/ cp -av imapsync.exe README_Windows.txt ../prepa_zip/imapsync_$(VERSION_EXE)/ unix2dos ../prepa_zip/imapsync_$(VERSION_EXE)/*.txt @@ -386,32 +434,43 @@ imapsync_bin_Darwin: imapsync W/build_mac.sh INSTALL.d/prerequisites_imapsync ssh -p 995 gilleslamira@gate.polarhome.com 'sh build_mac.sh' rsync -P -e 'ssh -p 995' gilleslamira@gate.polarhome.com:imapsync_bin_Darwin . +mactests: + rsync -p -e 'ssh -p 995' imapsync gilleslamira@gate.polarhome.com: + ssh -p 995 gilleslamira@gate.polarhome.com '. .bash_profile; perl imapsync --tests' + +mactestsdebug: + rsync -p -e 'ssh -p 995' imapsync gilleslamira@gate.polarhome.com: + ssh -p 995 gilleslamira@gate.polarhome.com '. .bash_profile; perl imapsync --testsdebug --debug' + bin: lin mac win lin: $(BIN_NAME) win: imapsync.exe + + $(BIN_NAME): imapsync rcsdiff imapsync { pp -o $(BIN_NAME) -I $(IMAPClient_3xx) \ - -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL \ + -M Mail::IMAPClient \ + -M Net::SSLeay -M IO::Socket -M IO::Socket::INET6 -M IO::Socket::SSL \ -M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey \ - -M Authen::NTLM \ + -M Authen::NTLM -M HTML::Entities -M JSON::WebToken \ imapsync ; \ } || : ./$(BIN_NAME) + ./$(BIN_NAME) --tests + ./$(BIN_NAME) --testslive + ./$(BIN_NAME) --justbanner + lfo: upload_lfo .PHONY: tarball -tarball: ../prepa_dist/$(DIST_FILE) - - - -../prepa_dist/$(DIST_FILE): imapsync +tarball: echo making tarball ../prepa_dist/$(DIST_FILE) rcsdiff RCS/* cd W && rcsdiff RCS/* @@ -428,7 +487,7 @@ tarball: ../prepa_dist/$(DIST_FILE) DIST_PATH := ./dist/ -dist: cidone test clean all perlcritic dist_prepa dist_zip README_dist.txt +dist: cidone test clean all perlcritic dist_prepa dist_zip README_dist md5: @@ -437,17 +496,17 @@ md5: sha: cd $(DIST_PATH)/ && sha512sum * -.PHONY: moveoldrelease +.PHONY: moveoldrelease ks2testsdebug ks2tests README_dist moveoldrelease: - ls -dl dist/imapsync dist/imapsync-$(VERSION_PREVIOUS).tgz dist/imapsync_$(VERSION_PREVIOUS).zip - test -d dist/old_releases/$(VERSION_PREVIOUS) || mkdir dist/old_releases/$(VERSION_PREVIOUS) && cd dist/old_releases/$(VERSION_PREVIOUS) - mv -vf dist/imapsync dist/imapsync-$(VERSION_PREVIOUS).tgz dist/imapsync_$(VERSION_PREVIOUS).zip dist/old_releases/$(VERSION_PREVIOUS) + ./W/tools/backup_old_dist + dist_prepa: tarball moveoldrelease ln -f ../prepa_dist/$(DIST_FILE) $(DIST_PATH)/ rcsdiff imapsync cp -a ../prepa_dist/$(DIST_NAME)/imapsync $(DIST_PATH)/ + cp -a ../prepa_dist/$(DIST_NAME)/imapsync_bin_Darwin $(DIST_PATH)/ #cd $(DIST_PATH)/ && md5sum $(DIST_FILE) > $(DIST_FILE).md5.txt #cd $(DIST_PATH)/ && md5sum -c $(DIST_FILE).md5.txt ls -l $(DIST_PATH)/ @@ -456,9 +515,9 @@ dist_prepa: tarball moveoldrelease dist_zip: zip cp -a ../prepa_zip/imapsync_$(VERSION_EXE).zip $(DIST_PATH)/ -README_dist.txt: - sh W/tools/gen_README_dist > $(DIST_PATH)/README_dist.txt - unix2dos $(DIST_PATH)/README_dist.txt +README_dist: + sh W/tools/gen_README_dist > $(DIST_PATH)/README.txt + unix2dos $(DIST_PATH)/README.txt .PHONY: publish upload_ks ks valid_index biz @@ -476,6 +535,9 @@ ksa: rsync -avHz --delete -P \ . gilles@ks.lamiral.info:public_html/imapsync/ +ks3: + rsync -avHz --delete -P \ + . gilles@ks3.lamiral.info:public_html/imapsync/ upload_tests: tests.sh rsync -avHz --delete -P \ @@ -483,7 +545,13 @@ upload_tests: tests.sh gilles@ks.lamiral.info:public_html/imapsync/ +ks2testsdebug: + rsync -aP imapsync gilles@ks.lamiral.info:public_html/imapsync/imapsync + ssh gilles@ks.lamiral.info 'public_html/imapsync/imapsync --testsdebug' +ks2tests: + rsync -aP imapsync gilles@ks.lamiral.info:public_html/imapsync/imapsync + ssh gilles@ks.lamiral.info 'public_html/imapsync/imapsync --tests' publish: dist upload_ks ksa echo Now ou can do make ml @@ -491,7 +559,7 @@ publish: dist upload_ks ksa PUBLIC = ./ChangeLog ./NOLIMIT ./LICENSE ./CREDITS ./FAQ \ ./index.shtml ./INSTALL ./README_Windows.txt \ ./VERSION ./VERSION_EXE ./imapsync \ -./README ./OPTIONS ./TODO +./README ./TODO @@ -542,9 +610,10 @@ upload_bin: rsync -aHvz --delete ../imapsync_website/ root@ks.lamiral.info:/var/www/imapsync/ upload_index: W/.valid.index.shtml - rcsdiff index.shtml S/*.shtml FAQ FAQ.d/*.txt INSTALL LICENSE CREDITS TODO W/*.bat examples/*.bat index.shtml INSTALL.d/*.txt - rsync -avH index.shtml FAQ INSTALL OPTIONS NOLIMIT LICENSE CREDITS TODO ../imapsync_website/ - rsync -avH S/ ../imapsync_website/S/ + rcsdiff index.shtml S/style.css S/*.shtml FAQ.d/*.txt LICENSE CREDITS TODO examples/*.bat index.shtml INSTALL.d/*.txt + rsync -avH index.shtml FAQ INSTALL NOLIMIT LICENSE CREDITS TODO S/robots.txt S/favicon.ico ../imapsync_website/ + rsync -aHv --delete ./W/ks.htaccess ../imapsync_website/.htaccess + rsync -aHv --delete S/ ../imapsync_website/S/ rsync -aHv --delete ./examples/ ../imapsync_website/examples/ rsync -aHv --delete ./INSTALL.d/ ../imapsync_website/INSTALL.d/ rsync -aHv --delete ./FAQ.d/ ../imapsync_website/FAQ.d/ @@ -555,13 +624,24 @@ upload_index: W/.valid.index.shtml ci_imapsync: rcsdiff imapsync -upload_latest: ci_imapsync bin +upload_latest: unitests ci_imapsync bin rsync -a imapsync imapsync_bin_Linux_i686 imapsync_bin_Darwin imapsync.exe ../imapsync_website/ rsync -aHvz --delete ../imapsync_website/ root@ks.lamiral.info:/var/www/imapsync/ +upload_cgi: unitests ks2tests ci_imapsync + rsync -a imapsync ../imapsync_website/ + rsync -aHvz --delete ../imapsync_website/ root@ks.lamiral.info:/var/www/imapsync/ + + +upload_X: + ./W/tools/validate_xml_html5 X/imapsync_form.html + rcsdiff X/imapsync_form.html + rsync -av --delete X/ ../imapsync_website/X/ + rsync -aHvz --delete ../imapsync_website/ root@ks.lamiral.info:/var/www/imapsync/ + upload_FAQ: - rcsdiff FAQ FAQ.d/*.txt INSTALL LICENSE CREDITS TODO INSTALL.d/*.txt - rsync -avH FAQ INSTALL OPTIONS CREDITS TODO ../imapsync_website/ + rcsdiff FAQ.d/*.txt LICENSE CREDITS TODO INSTALL.d/*.txt + rsync -avH FAQ INSTALL CREDITS TODO ../imapsync_website/ rsync -aHv --delete ./INSTALL.d/ ../imapsync_website/INSTALL.d/ rsync -aHv --delete ./FAQ.d/ ../imapsync_website/FAQ.d/ rsync -avH --delete ./doc/ ../imapsync_website/doc/ diff --git a/OPTIONS b/OPTIONS index e637ced..407aea9 100644 --- a/OPTIONS +++ b/OPTIONS @@ -1,283 +1,4 @@ - usage: ./imapsync [options] - - Several options are mandatory. - str means string - int means integer - reg means regular expression - cmd means command - - --dry : Makes imapsync doing nothing, just print what would - be done without --dry. - - --host1 str : Source or "from" imap server. Mandatory. - --port1 int : Port to connect on host1. Default is 143, 993 if --ssl1 - --user1 str : User to login on host1. Mandatory. - --showpasswords : Shows passwords on output instead of "MASKED". - Useful to restart a complete run by just reading the log. - --password1 str : Password for the user1. - --host2 str : "destination" imap server. Mandatory. - --port2 int : Port to connect on host2. Default is 143, 993 if --ssl2 - --user2 str : User to login on host2. Mandatory. - --password2 str : Password for the user2. - - --passfile1 str : Password file for the user1. It must contain the - password on the first line. This option avoids to show - the password on the command line like --password1 does. - --passfile2 str : Password file for the user2. Contains the password. - - --ssl1 : Use a SSL connection on host1. - --ssl2 : Use a SSL connection on host2. - --tls1 : Use a TLS connection on host1. - --tls2 : Use a TLS connection on host2. - --debugssl int : SSL debug mode from 0 to 4. - --sslargs1 str : Pass any ssl parameter for host1 ssl or tls connection. Example: - --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3 - See all possibilities in the new() method of IO::Socket::SSL - http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods - --sslargs2 str : Pass any ssl parameter for host2 ssl or tls connection. - See --sslargs1 - - --timeout1 int : Connection timeout in seconds for host1. - Default is 120 and 0 means no timeout at all. - --timeout2 int : Connection timeout in seconds for host2. - Default is 120 and 0 means no timeout at all. - - --authmech1 str : Auth mechanism to use with host1: - PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. - --authmech2 str : Auth mechanism to use with host2. See --authmech1 - - --authuser1 str : User to auth with on host1 (admin user). - Avoid using --authmech1 SOMETHING with --authuser1. - --authuser2 str : User to auth with on host2 (admin user). - --proxyauth1 : Use proxyauth on host1. Requires --authuser1. - Required by Sun/iPlanet/Netscape IMAP servers to - be able to use an administrative user. - --proxyauth2 : Use proxyauth on host2. Requires --authuser2. - - --authmd51 : Use MD5 authentification for host1. - --authmd52 : Use MD5 authentification for host2. - --domain1 str : Domain on host1 (NTLM authentication). - --domain2 str : Domain on host2 (NTLM authentication). - - --folder str : Sync this folder. - --folder str : and this one, etc. - --folderrec str : Sync this folder recursively. - --folderrec str : and this one, etc. - - --folderfirst str : Sync this folder first. --folderfirst "Work" - --folderfirst str : then this one, etc. - --folderlast str : Sync this folder last. --folderlast "[Gmail]/All Mail" - --folderlast str : then this one, etc. - - --nomixfolders : Do not merge folders when host1 is case sensitive - while host2 is not (like Exchange). Only the first - similar folder is synced (ex: Sent SENT sent -> Sent). - - --skipemptyfolders : Empty host1 folders are not created on host2. - - --include reg : Sync folders matching this regular expression - --include reg : or this one, etc. - in case both --include --exclude options are - use, include is done before. - --exclude reg : Skips folders matching this regular expression - Several folders to avoid: - --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. - --exclude reg : or this one, etc. - - --subfolder2 str : Move whole host1 folders hierarchy under this - host2 folder str . - It does it by adding two --regextrans2 options before - all others. Add --debug to see what's really going on. - - --automap : guesses folders mapping, for folders like - "Sent", "Junk", "Drafts", "All", "Archive", "Flagged". - --f1f2 str1=str2 : Force folder str1 to be synced to str2, - --f1f2 overrides --automap and --regextrans2. - --regextrans2 reg : Apply the whole regex to each destination folders. - --regextrans2 reg : 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. - Have in mind that --regextrans2 is applied after prefix - and separator inversion. For examples see - http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt - - --tmpdir str : Where to store temporary files and subdirectories. - Will be created if it doesn't exist. - Default is system specific, Unix is /tmp but - it's often small and deleted at reboot. - --tmpdir /var/tmp should be better. - --pidfile str : The file where imapsync pid is written. - --pidfilelocking : Abort if pidfile already exists. Usefull to avoid - concurrent transfers on the same mailbox. - - --nolog : Turn off logging on file - --logfile str : Change the default log filename (can be dirname/filename). - --logdir str : Change the default log directory. Default is LOG_imapsync - - --prefix1 str : Remove prefix to all destination folders - (usually INBOX. or INBOX/ or an empty string "") - you have to use --prefix1 if host1 imap server - does not have NAMESPACE capability, so imapsync - suggests to use it. All other cases are bad. - --prefix2 str : Add prefix to all host2 folders. See --prefix1 - --sep1 str : Host1 separator in case NAMESPACE is not supported. - --sep2 str : Host2 separator in case NAMESPACE is not supported. - - --skipmess reg : Skips messages maching the regex. - Example: 'm/[\x80-ff]/' # to avoid 8bits messages. - --skipmess is applied before --regexmess - --skipmess reg : or this one, etc. - - --pipemess cmd : Apply this cmd command to each message content - before the copy. - --pipemess cmd : and this one, etc. - - --disarmreadreceipts : Disarms read receipts (host2 Exchange issue) - - --regexmess reg : Apply the whole regex to each message before transfer. - Example: 's/\000/ /g' # to replace null by space. - --regexmess reg : and this one, etc. - - --regexflag reg : Apply the whole regex to each flags list. - Example: 's/"Junk"//g' # to remove "Junk" flag. - --regexflag reg : and this one, etc. - - --delete : Deletes messages on host1 server after a successful - transfer. Option --delete has the following behavior: - it marks messages as deleted with the IMAP flag - \Deleted, then messages are really deleted with an - EXPUNGE IMAP command. - - --delete2 : Delete messages in host2 that are not in - host1 server. Useful for backup or pre-sync. - --delete2duplicates : Delete messages in host2 that are duplicates. - Works only without --useuid since duplicates are - detected with an header part of each message. - - --delete2folders : Delete folders in host2 that are not in host1 server. - For safety, first try it like this (it is safe): - --delete2folders --dry --justfolders --nofoldersizes - --delete2foldersonly reg : Deleted only folders matching regex. - Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" - --delete2foldersbutnot reg : Do not delete folders matching regex. - Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" - --noexpunge : Do not expunge messages on host1. - Expunge really deletes messages marked deleted. - Expunge is made at the beginning, on host1 only. - Newly transferred messages are also expunged if - option --delete is given. - No expunge is done on host2 account (unless --expunge2) - --expunge1 : Expunge messages on host1 after messages transfer. - --expunge2 : Expunge messages on host2 after messages transfer. - --uidexpunge2 : uidexpunge messages on the host2 account - that are not on the host1 account, requires --delete2 - --nomixfolders : Avoid merging folders that are considered different on - host1 but the same on destination host2 because of - case sensitivities and insensitivities. - - --syncinternaldates : Sets the internal dates on host2 same as host1. - Turned on by default. Internal date is the date - a message arrived on a host (mtime). - --idatefromheader : Sets the internal dates on host2 same as the - "Date:" headers. - - --maxsize int : Skip messages larger (or equal) than int bytes - --minsize int : Skip messages smaller (or equal) than int bytes - --maxage int : Skip messages older than int days. - final stats (skipped) don't count older messages - see also --minage - --minage int : Skip messages newer than int days. - final stats (skipped) don't count newer messages - You can do (+ are the messages selected): - past|----maxage+++++++++++++++>now - past|+++++++++++++++minage---->now - past|----maxage+++++minage---->now (intersection) - past|++++minage-----maxage++++>now (union) - - --search str : Selects only messages returned by this IMAP SEARCH - command. Applied on both sides. - --search1 str : Same as --search for selecting host1 messages only. - --search2 str : Same as --search for selecting host2 messages only. - --search CRIT equals --search1 CRIT --search2 CRIT - - --exitwhenover int : Stop syncing when total bytes transferred reached. - Gmail per day allows - 2500000000 = 2.5 GB downloaded from Gmail as host2 - 500000000 = 500 MB uploaded to Gmail as host1. - - --maxlinelength int : skip messages with a line length longer than int bytes. - RFC 2822 says it must be no more than 1000 bytes. - - --useheader str : Use this header to compare messages on both sides. - Ex: Message-ID or Subject or Date. - --useheader str and this one, etc. - - --subscribed : Transfers subscribed folders. - --subscribe : Subscribe to the folders transferred on the - host2 that are subscribed on host1. On by default. - --subscribeall : Subscribe to the folders transferred on the - host2 even if they are not subscribed on host1. - - --nofoldersizes : Do not calculate the size of each folder in bytes - and message counts. Default is to calculate them. - --nofoldersizesatend: Do not calculate the size of each folder in bytes - and message counts at the end. Default is on. - --justfoldersizes : Exit after having printed the folder sizes. - - --syncacls : Synchronises acls (Access Control Lists). - --nosyncacls : Does not synchronize acls. This is the default. - Acls in IMAP are not standardized, be careful. - - --usecache : Use cache to speedup. - --nousecache : Do not use cache. Caveat: --useuid --nousecache creates - duplicates on multiple runs. - --useuid : Use uid instead of header as a criterium to recognize - messages. Option --usecache is then implied unless - --nousecache is used. - - --debug : Debug mode. - --debugfolders : Debug mode for the folders part only. - --debugcontent : Debug content of the messages transfered. Huge ouput. - --debugflags : Debug mode for flags. - --debugimap1 : IMAP debug mode for host1. Very verbose. - --debugimap2 : IMAP debug mode for host2. Very verbose. - --debugimap : IMAP debug mode for host1 and host2. - --debugmemory : Debug mode showing memory consumption after each copy. - - --errorsmax int : Exit when int number of errors is reached. Default is 50. - - --tests : Run local non-regression tests. Exit code 0 means all ok. - --testslive : Run a live test with test1.lamiral.info imap server. - Useful to check the basics. Needs internet connexion. - - --version : Print only software version. - --noreleasecheck : Do not check for new imapsync release (a http request). - --releasecheck : Check for new imapsync release (a http request). - --noid : Do not send/receive ID command to imap servers. - --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 : Do only things about folders (ignore messages). - - --help : print this help. - - Example: to synchronize imap account "test1" on "test1.lamiral.info" - to imap account "test2" on "test2.lamiral.info" - with test1 password "secret1" - and test2 password "secret2" - - ./imapsync \ - --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ - --host2 test2.lamiral.info --user2 test2 --password2 secret2 - -Here is a [linux] system (Linux petite 3.13.0-92-generic #139-Ubuntu SMP Tue Jun 28 20:42:32 UTC 2016 i686) -with Perl 5.18.2 Mail::IMAPClient 3.38 -$Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ -This imapsync is up to date - -Homepage: http://imapsync.lamiral.info/ +Options are in the README file now. (since August 2017) diff --git a/README b/README index 0a1b132..7f36b99 100644 --- a/README +++ b/README @@ -1,14 +1,14 @@ NAME + imapsync - Email IMAP tool for syncing, copying and migrating email - mailboxes. + mailboxes between two imap servers, one way, and without duplicates. - The imapsync command synchronises mailboxes between two imap servers. - More than 69 different IMAP server softwares supported with success, few - failures. +VERSION - $Revision: 1.727 $ + This documentation refers to Imapsync $Revision: 1.4 $ + +USAGE -SYNOPSIS To synchronize the source imap account "test1" on server "test1.lamiral.info" with password "secret1" to the destination imap account @@ -19,78 +19,94 @@ SYNOPSIS --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ --host2 test2.lamiral.info --user2 test2 --password2 secret2 -REQUIRED ARGUMENTS - The required argmuments are the six values, three on each sides, needed - to login into the IMAP servers, a host, a username, and a password, two +DESCRIPTION + + We sometimes need to transfer mailboxes from one imap server to another. + + Imapsync command is a tool allowing incremental and recursive imap + transfers from one mailbox to another. + + By default all folders are transferred, recursively, meaning the whole + folder hierarchy is taken, all messages in them, and all messages flags + (\Seen \Answered \Flagged etc.) are synced too. + + Imapsync reduces the amount of data transferred by not transferring a + given message if it resides already on both sides. Same specific headers + and the transfer is done only once (by default it's "Message-Id:" and + "Received:" lines but it can be changed with --useheader option). + + 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 and interruptions. + + You can decide to delete the messages from the source mailbox after a + successful transfer, it can be a good feature when migrating live + mailboxes since messages will be only on one side. In that case, use the + --delete1 option. Option --delete1 implies also option --expunge1 so all + messages marked deleted on host1 will be really deleted. + + A different scenario is synchronizing a mailbox B from another mailbox A + in case you just want to keep a "live" copy of A in B. In that case + --delete2 has to be used, it deletes messages in host2 folder B that are + not in host1 folder A. If you also need to destroy host2 folders that + are not in host1 then use --delete2folders (see also + --delete2foldersonly and --delete2foldersbutnot). + + Imapsync is not adequate for maintaining two active imap accounts in + synchronization when the user plays independently on both sides. Use + offlineimap (written by John Goerzen) or mbsync (written by Michael R. + Elkins) for a 2 ways synchronization. + +OPTIONS + + usage: imapsync [options] + + Mandatory options are the six values, three on each sides, needed to log + in into the IMAP servers, ie, a host, a username, and a password, two times. -INSTALL - Imapsync works under any Unix with perl. - Imapsync works under Windows (2000, XP, Vista, Seven) - as a standalone binary software called imapsync.exe - Imapsync works under OS X as a standalone binary - software called imapsync_bin_Darwin. + Conventions used: - Purchase latest imapsync at - http://imapsync.lamiral.info/ - - You'll receive a link to a compressed tarball called imapsync-x.xx.tgz - where x.xx is the version number. Untar the tarball where - you want (on Unix): - - tar xzvf imapsync-x.xx.tgz - - Go into the directory imapsync-x.xx and read the INSTALL file. - As mentioned at http://imapsync.lamiral.info/#install - the INSTALL file can also be found at - http://imapsync.lamiral.info/INSTALL - It is now split in several files for each system - http://imapsync.lamiral.info/INSTALL.d/ - -CONFIGURATION - There is no specific configuration file for imapsync, everything is - specified by the command line parameteres and the default behavior. - -USAGE - To get a description of each option just run imapsync with no argument, - like this: - - imapsync - - This description of options is also available at - http://imapsync.lamiral.info/OPTIONS and is reproduced here: - - usage: ./imapsync [options] - - Several options are mandatory. str means string int means integer reg means regular expression cmd means command - --dry : Makes imapsync doing nothing, just print what would - be done without --dry. + --dry : Makes imapsync doing nothing for real, just print what + would be done without --dry. + + OPTIONS/credentials --host1 str : Source or "from" imap server. Mandatory. --port1 int : Port to connect on host1. Default is 143, 993 if --ssl1 --user1 str : User to login on host1. Mandatory. - --showpasswords : Shows passwords on output instead of "MASKED". - Useful to restart a complete run by just reading the log. --password1 str : Password for the user1. --host2 str : "destination" imap server. Mandatory. --port2 int : Port to connect on host2. Default is 143, 993 if --ssl2 --user2 str : User to login on host2. Mandatory. --password2 str : Password for the user2. + --showpasswords : Shows passwords on output instead of "MASKED". + Useful to restart a complete run by just reading the log, + or to debug passwords. It's not a secure practice. + --passfile1 str : Password file for the user1. It must contain the password on the first line. This option avoids to show the password on the command line like --password1 does. --passfile2 str : Password file for the user2. Contains the password. - --ssl1 : Use a SSL connection on host1. - --ssl2 : Use a SSL connection on host2. - --tls1 : Use a TLS connection on host1. - --tls2 : Use a TLS connection on host2. + OPTIONS/encryption + + --nossl1 : Do not use a SSL connection on host1. + --ssl1 : Use a SSL connection on host1. On by default if possible. + --nossl2 : Do not use a SSL connection on host2. + --ssl2 : Use a SSL connection on host2. On by default if possible. + --notls1 : Do not use a TLS connection on host1. + --tls1 : Use a TLS connection on host1. On by default if possible. + --notls2 : Do not use a TLS connection on host2. + --tls2 : Use a TLS connection on host2. On by default if possible. --debugssl int : SSL debug mode from 0 to 4. --sslargs1 str : Pass any ssl parameter for host1 ssl or tls connection. Example: --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3 @@ -104,6 +120,8 @@ USAGE --timeout2 int : Connection timeout in seconds for host2. Default is 120 and 0 means no timeout at all. + OPTIONS/authentication + --authmech1 str : Auth mechanism to use with host1: PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. --authmech2 str : Auth mechanism to use with host2. See --authmech1 @@ -116,11 +134,12 @@ USAGE be able to use an administrative user. --proxyauth2 : Use proxyauth on host2. Requires --authuser2. - --authmd51 : Use MD5 authentification for host1. - --authmd52 : Use MD5 authentification for host2. + --authmd51 : Use MD5 authentication for host1. + --authmd52 : Use MD5 authentication for host2. --domain1 str : Domain on host1 (NTLM authentication). --domain2 str : Domain on host2 (NTLM authentication). + OPTIONS/folders --folder str : Sync this folder. --folder str : and this one, etc. @@ -132,17 +151,16 @@ USAGE --folderlast str : Sync this folder last. --folderlast "[Gmail]/All Mail" --folderlast str : then this one, etc. - --nomixfolders : Do not merge folders when host1 is case sensitive + --nomixfolders : Do not merge folders when host1 is case-sensitive while host2 is not (like Exchange). Only the first similar folder is synced (ex: Sent SENT sent -> Sent). --skipemptyfolders : Empty host1 folders are not created on host2. - --f1f2 str1=str2 : Force folder str1 to be synced to str2. --include reg : Sync folders matching this regular expression --include reg : or this one, etc. - in case both --include --exclude options are - use, include is done before. + If both --include --exclude options are used, then + include is done before. --exclude reg : Skips folders matching this regular expression Several folders to avoid: --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. @@ -153,37 +171,69 @@ USAGE It does it by adding two --regextrans2 options before all others. Add --debug to see what's really going on. + --automap : guesses folders mapping, for folders like + "Sent", "Junk", "Drafts", "All", "Archive", "Flagged". + --f1f2 str1=str2 : Force folder str1 to be synced to str2, + --f1f2 overrides --automap and --regextrans2. + + --nomixfolders : Avoid merging folders that are considered different on + host1 but the same on destination host2 because of + case sensitivities and insensitivities. + + --subscribed : Transfers subscribed folders. + --subscribe : Subscribe to the folders transferred on the + host2 that are subscribed on host1. On by default. + --subscribeall : Subscribe to the folders transferred on the + host2 even if they are not subscribed on host1. + + --prefix1 str : Remove prefix str to all destination folders, + usually INBOX. or INBOX/ or an empty string "". + imapsync guesses the prefix if host1 imap server + does not have NAMESPACE capability. This option + should not be used, most of the time. + --prefix2 str : Add prefix to all host2 folders. See --prefix1 + --sep1 str : Host1 separator in case NAMESPACE is not supported. + --sep2 str : Host2 separator in case NAMESPACE is not supported. + --regextrans2 reg : Apply the whole regex to each destination folders. --regextrans2 reg : 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. Have in mind that --regextrans2 is applied after prefix - and separator inversion. + and separator inversion. For examples see + http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt + + OPTIONS/folders sizes + + --nofoldersizes : Do not calculate the size of each folder at the + beginning of the sync. Default is to calculate them. + --nofoldersizesatend: Do not calculate the size of each folder at the + end of the sync. Default is to calculate them. + --justfoldersizes : Exit after having printed the initial folder sizes. + + OPTIONS/tmp --tmpdir str : Where to store temporary files and subdirectories. Will be created if it doesn't exist. Default is system specific, Unix is /tmp but - it's often small and deleted at reboot. + /tmp is often too small and deleted at reboot. --tmpdir /var/tmp should be better. - --pidfile str : The file where imapsync pid is written. - --pidfilelocking : Abort if pidfile already exists. Usefull to avoid + --pidfile str : The file where imapsync pid is written, + it can be dirname/filename. + Default name is imapsync.pid in tmpdir. + --pidfilelocking : Abort if pidfile already exists. Useful to avoid concurrent transfers on the same mailbox. + OPTIONS/log + --nolog : Turn off logging on file --logfile str : Change the default log filename (can be dirname/filename). - --logdir str : Change the default log directory. Default is LOG_imapsync + --logdir str : Change the default log directory. Default is LOG_imapsync/ - --prefix1 str : Remove prefix to all destination folders - (usually INBOX. or INBOX/ or an empty string "") - you have to use --prefix1 if host1 imap server - does not have NAMESPACE capability, so imapsync - suggests to use it. All other cases are bad. - --prefix2 str : Add prefix to all host2 folders. See --prefix1 - --sep1 str : Host1 separator in case NAMESPACE is not supported. - --sep2 str : Host2 separator in case NAMESPACE is not supported. + OPTIONS/messages - --skipmess reg : Skips messages maching the regex. + --skipmess reg : Skips messages matching the regex. Example: 'm/[\x80-ff]/' # to avoid 8bits messages. --skipmess is applied before --regexmess --skipmess reg : or this one, etc. @@ -198,15 +248,30 @@ USAGE Example: 's/\000/ /g' # to replace null by space. --regexmess reg : and this one, etc. + OPTIONS/flags + --regexflag reg : Apply the whole regex to each flags list. Example: 's/"Junk"//g' # to remove "Junk" flag. - --regexflag reg : and this one, etc. + --regexflag reg : then this one, etc. - --delete : Deletes messages on host1 server after a successful - transfer. Option --delete has the following behavior: + OPTIONS/deletions + + --delete1 : Deletes messages on host1 server after a successful + transfer. Option --delete1 has the following behavior: it marks messages as deleted with the IMAP flag \Deleted, then messages are really deleted with an - EXPUNGE IMAP command. + EXPUNGE IMAP command. If expunging after each message + slows down too much the sync then use + --noexpungeaftereach to speed up. + --expunge1 : Expunge messages on host1 just before syncing a folder. + Expunge is done per folder. + Expunge aims is to really delete messages marked deleted. + An expunge is also done after each message copied + if option --delete1 is set. + --noexpunge1 : Do not expunge messages on host1. + --delete1emptyfolders : Deletes empty folders on host1, INBOX excepted. + Useful with --delete1 since what remains on host1 + is only what failed to be synced. --delete2 : Delete messages in host2 that are not in host1 server. Useful for backup or pre-sync. @@ -221,19 +286,12 @@ USAGE Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" --delete2foldersbutnot reg : Do not delete folders matching regex. Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" - --noexpunge : Do not expunge messages on host1. - Expunge really deletes messages marked deleted. - Expunge is made at the beginning, on host1 only. - Newly transferred messages are also expunged if - option --delete is given. - No expunge is done on host2 account (unless --expunge2) - --expunge1 : Expunge messages on host1 after messages transfer. + --expunge2 : Expunge messages on host2 after messages transfer. --uidexpunge2 : uidexpunge messages on the host2 account that are not on the host1 account, requires --delete2 - --nomixfolders : Avoid merging folders that are considered different on - host1 but the same on destination host2 because of - case sensitivities and insensitivities. + + OPTIONS/dates --syncinternaldates : Sets the internal dates on host2 same as host1. Turned on by default. Internal date is the date @@ -241,6 +299,8 @@ USAGE --idatefromheader : Sets the internal dates on host2 same as the "Date:" headers. + OPTIONS/message selection + --maxsize int : Skip messages larger (or equal) than int bytes --minsize int : Skip messages smaller (or equal) than int bytes --maxage int : Skip messages older than int days. @@ -260,44 +320,32 @@ USAGE --search2 str : Same as --search for selecting host2 messages only. --search CRIT equals --search1 CRIT --search2 CRIT - --exitwhenover int : Stop syncing when total bytes transferred reached. - Gmail per day allows - 2500000000 = 2.5 GB downloaded from Gmail as host2 - 500000000 = 500 MB uploaded to Gmail as host1. - --maxlinelength int : skip messages with a line length longer than int bytes. RFC 2822 says it must be no more than 1000 bytes. + --useheader str : Use this header to compare messages on both sides. Ex: Message-ID or Subject or Date. --useheader str and this one, etc. - --subscribed : Transfers subscribed folders. - --subscribe : Subscribe to the folders transferred on the - host2 that are subscribed on host1. On by default. - --subscribeall : Subscribe to the folders transferred on the - host2 even if they are not subscribed on host1. - - --nofoldersizes : Do not calculate the size of each folder in bytes - and message counts. Default is to calculate them. - --nofoldersizesatend: Do not calculate the size of each folder in bytes - and message counts at the end. Default is on. - --justfoldersizes : Exit after having printed the folder sizes. - - --syncacls : Synchronises acls (Access Control Lists). - --nosyncacls : Does not synchronize acls. This is the default. - Acls in IMAP are not standardized, be careful. - - --usecache : Use cache to speedup. + --usecache : Use cache to speed up the sync. --nousecache : Do not use cache. Caveat: --useuid --nousecache creates duplicates on multiple runs. --useuid : Use uid instead of header as a criterium to recognize messages. Option --usecache is then implied unless --nousecache is used. + OPTIONS/miscelaneous + + --syncacls : Synchronizes acls (Access Control Lists). + --nosyncacls : Does not synchronize acls. This is the default. + Acls in IMAP are not standardized, be careful. + + OPTIONS/debugging + --debug : Debug mode. --debugfolders : Debug mode for the folders part only. - --debugcontent : Debug content of the messages transfered. Huge ouput. + --debugcontent : Debug content of the messages transferred. Huge output. --debugflags : Debug mode for flags. --debugimap1 : IMAP debug mode for host1. Very verbose. --debugimap2 : IMAP debug mode for host2. Very verbose. @@ -309,6 +357,38 @@ USAGE --tests : Run local non-regression tests. Exit code 0 means all ok. --testslive : Run a live test with test1.lamiral.info imap server. Useful to check the basics. Needs internet connexion. + --testslive6 : Run a live test with ks2ipv6.lamiral.info imap server. + Useful to check the ipv6 connectivity. Needs internet. + + OPTIONS/specific + + --gmail1 : sets --host1 to Gmail and options from FAQ.Gmail.txt + --gmail2 : sets --host2 to Gmail and options from FAQ.Gmail.txt + + --office1 : sets --host1 to Office365 options from FAQ.Exchange.txt + --office2 : sets --host2 to Office365 options from FAQ.Exchange.txt + + --exchange1 : sets options from FAQ.Exchange.txt, account1 part + --exchange2 : sets options from FAQ.Exchange.txt, account2 part + + --domino1 : sets options from FAQ.Domino.txt, account1 part + --domino2 : sets options from FAQ.Domino.txt, account2 part + + OPTIONS/behavior + + --maxmessagespersecond int : limits the number of messages transferred per second. + + --maxbytespersecond int : limits the average transfer rate per second. + --maxbytesafter int : starts --maxbytespersecond limitation only after + --maxbytesafter amount of data transferred. + + --maxsleep int : do not sleep more than int seconds. + On by default, 2 seconds max, like --maxsleep 2 + + --abort : terminates a previous call still running. + It uses the pidfile to know what processus to abort. + + --exitwhenover int : Stop syncing when total bytes transferred reached. --version : Print only software version. --noreleasecheck : Do not check for new imapsync release (a http request). @@ -322,89 +402,17 @@ USAGE --help : print this help. - Example: - To synchronize the source imap account - "test1" on server "test1.lamiral.info" with password "secret1" - to the destination imap account - "test2" on server "test2.lamiral.info" with password "secret2" - do: + Example: to synchronize imap account "test1" on "test1.lamiral.info" + to imap account "test2" on "test2.lamiral.info" + with test1 password "secret1" + and test2 password "secret2" imapsync \ --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ --host2 test2.lamiral.info --user2 test2 --password2 secret2 -DESCRIPTION - Imapsync command is a tool allowing incremental and recursive imap - transfers from one mailbox to another. - - By default all folders are transferred, recursively, all possible flags - (\Seen \Answered \Flagged etc.) are synced too. - - We sometimes need to transfer mailboxes from one imap server to another. - This is called migration. - - Imapsync reduces the amount of data transferred by not transferring a - given message if it resides already on both sides. Same specific headers - and the transfer is done only once; taken into account are by default - Message-Id and Received header lines. 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 and interruptions. - - You can decide to delete the messages from the source mailbox after a - successful transfer, it can be a good feature when migrating live - mailboxes since messages will be only on one side. In that case, use the - --delete option. Option --delete implies also option --expunge so all - messages marked deleted on host1 will be really deleted. (you can use - --noexpunge to avoid this but I don't see any good real world scenario - for the combination --delete --noexpunge). - - A different scenario is synchronizing a mailbox B from another mailbox A - in case you just want to keep a "live" copy of A in B. In that case - --delete2 has to be used, it deletes messages in host2 folder B that are - not in host1 folder A. If you also need to destroy host2 folders that - are not in host1 then use --delete2folders (see also - --delete2foldersonly and --delete2foldersbutnot). - - Imapsync is not adequate for maintaining two active imap accounts in - synchronization when the user plays independently on both sides. Use - offlineimap (written by John Goerzen) or mbsync (written by Michael R. - Elkins) for 2 ways synchronizations. - -OPTIONS - To get a description of each option just invoke: - - imapsync - - or read the previous section named USAGE, - - or read http://imapsync.lamiral.info/OPTIONS - -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 its 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). - -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. - 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 @@ -412,150 +420,62 @@ SECURITY 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. + Imapsync activates ssl or tls encryption by default, if possible. What + details are under this "if possible"? Imapsync activates ssl if the well + known port imaps port (993) is open on the imap servers. If the imaps + port is closed then it open a normal (clear) connection on port 143 but + it looks for TLS support in the CAPABILITY list of the servers. If TLS + is supported then imapsync goes to encryption. - 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. Authenticate with an admin account must be supported - by your imap server to work with imapsync. + If the automatic ssl/tls detection fails then imapsync will not protect + against sniffing activities on the network, especially for passwords. - When working on Sun/iPlanet/Netscape IMAP servers you must use - --proxyauth1 to enable administrative user to masquerade as another - user. Can also be used on destination server with --proxyauth2 - - You can authenticate with OAUTH when transfering from Google Apps. The - consumer key will be the domain part of the --user, and the --password - will be used as the consumer secret. It does not work with Google Apps - free edition. + See also the document FAQ.Security.txt in the FAQ.d/ directory or at + https://imapsync.lamiral.info/FAQ.d/FAQ.Security.txt EXIT STATUS - imapsync will exit with a 0 status (return code) if everything went + + 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 - LICENSE AND COPYRIGHT - imapsync is free, open, public but not always gratis software cover by + + Imapsync is free, open, public but not always gratis software cover by the NOLIMIT Public License. See the LICENSE file included in the - distribution or just read this simple sentence as it is the licence + distribution or just read this simple sentence as it IS the licence text: "No limit to do anything with this work and this license." - In case it is not long enough I repeat: + In case it is not long enough, I repeat: "No limit to do anything with this work and this license." -MAILING-LIST - The public mailing-list may be the best way to get free support. - - To write on the mailing-list, the address is: - - - To subscribe, send any message (even empty) to: - then just reply to the - confirmation message. - - To unsubscribe, send a message to: - - - To contact the person in charge for the list: - - - The list archives are 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. + https://imapsync.lamiral.info/LICENSE AUTHOR + Gilles LAMIRAL Feedback good or bad is very often welcome. Gilles LAMIRAL earns his living by writing, installing, configuring and - teaching free, open and often gratis softwares. It used to be "always - gratis" but now it is "often" because imapsync is sold by its author, a - good way to stay maintening and supporting free open public softwares - (see the license) over decades. + teaching free, open and often gratis software. Imapsync used to be + "always gratis" but now it is only "often gratis" because imapsync is + sold by its author, a good way to maintain and support free open public + software over decades. BUGS AND LIMITATIONS - Help me to help you: follow the following guidelines. - Report any bugs or feature requests to the public mailing-list or to the - author. + See https://imapsync.lamiral.info/FAQ.d/FAQ.Reporting_Bugs.txt - Before reporting bugs, read the FAQs, the README and the TODO files. - http://imapsync.lamiral.info/ +IMAP SERVERS supported - 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 there. - - Make a good title with word "imapsync" in it (my spam filters won't - filter it), Try to write an email title with more words than just - "imapsync" or "problem", a good title is made of keywords summary, but - not too long (one visible line). - - Help us to help you: in your report, please include: - - - imapsync version. - - - output near the first failures, a few lines before is good to get the context - of the issue. First failures messages are often more significant than - the last ones. - - - if the issue is always related to the same messages, include the output - with --debug --debugimap, near the failure point. For example, - Isolate a buggy message or two in a folder 'BUG' and use - - imapsync ... --folder 'BUG' --debug --debugimap - - - imap server softwares on both sides and their version number. - - - imapsync with all the options you use, the full command line - you use (except the passwords of course). - - - IMAPClient.pm version. - - - the run context. Do you run imapsync.exe, a unix binary - or the perl script imapsync. - - - operating system running imapsync. - - - virtual software context (vmware, xen etc.) - - - operating systems on both sides and the third side in case - you run imapsync on a foreign host from the both. - - Most of those values can be found as a copy/paste at the begining of the - output, so a carbon copy of the output is a very easy and very good - debug report for me. - - 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. - -IMAP SERVERS - See http://imapsync.lamiral.info/S/imapservers.shtml + See https://imapsync.lamiral.info/S/imapservers.shtml HUGE MIGRATION - Pay special attention to options --subscribed --subscribe --delete + + Pay special attention to options --subscribed --subscribe --delete1 --delete2 --delete2folders --maxage --minage --maxsize --useuid --usecache @@ -585,20 +505,46 @@ HUGE MIGRATION --host2 imap.side2.org --user2 %%I --password2 %%J ... The ... have to be replaced by nothing or any imapsync option. Welcome - in shell programming ! + in shell or batch programming ! You will find already written scripts at http://imapsync.lamiral.info/examples/ +INSTALL + + Imapsync works under any Unix with perl. + Imapsync works under Windows (2000, XP, Vista, Seven) + as a standalone binary software called imapsync.exe + Imapsync works under OS X as a standalone binary + software called imapsync_bin_Darwin. + + Purchase latest imapsync at + http://imapsync.lamiral.info/ + + You'll receive a link to a compressed tarball called imapsync-x.xx.tgz + where x.xx is the version number. Untar the tarball where + you want (on Unix): + + tar xzvf imapsync-x.xx.tgz + + Go into the directory imapsync-x.xx and read the INSTALL file. + As mentioned at http://imapsync.lamiral.info/#install + the INSTALL file can also be found at + http://imapsync.lamiral.info/INSTALL + It is now split in several files for each system + http://imapsync.lamiral.info/INSTALL.d/ + +CONFIGURATION + + There is no specific configuration file for imapsync, everything is + specified by the command line parameters and the default behavior. + HACKING + Feel free to hack imapsync as the NOLIMIT license permits it. -LINKS - Entries for imapsync: - https://web.archive.org/web/20070202005121/http://www.imap.org/products/ - showall.php - SIMILAR SOFTWARES + imap_tools : http://www.athensfbc.com/imap_tools offlineimap : https://github.com/nicolas33/offlineimap mbsync : http://isync.sourceforge.net/ @@ -617,5 +563,15 @@ SIMILAR SOFTWARES Feedback (good or bad) will often be welcome. - $Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ +HISTORY + + I wrote imapsync because an enterprise (basystemes) paid me to install a + new imap server without losing huge old mailboxes located in 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 then delete it after a good transfer. + Imapsync started its life as a patch of the copy_folder.pl script. The + script copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl module + tarball source (more precisely in the examples/ directory of the + Mail-IMAPClient tarball). diff --git a/README_Windows.txt b/README_Windows.txt index dbdf0d1..e5c790b 100644 --- a/README_Windows.txt +++ b/README_Windows.txt @@ -1,16 +1,16 @@ -# $Id: README_Windows.txt,v 1.5 2015/03/26 04:27:39 gilles Exp gilles $ +# $Id: README_Windows.txt,v 1.9 2017/09/11 02:57:38 gilles Exp gilles $ # -# README_Windows.txt file for imapsync +# This is the README_Windows.txt file for imapsync # imapsync : IMAP sync and migrate tool. WINDOWS ======= -Two ways to install and use imapsync on Windows systems: A) or B). +There is two ways to install and use imapsync on Windows systems: A) or B). Standard users should only take the A) way. -Developers, users that want to build their own imapsync.exe +Developers, or powerful users that want to build their own imapsync.exe or modify it, have to consider the B) way. A) Simplest way @@ -18,7 +18,7 @@ A) Simplest way A.1) Get imapsync. -Buy imapsync at http://imapsync.lamiral.info/ +Get imapsync at https://imapsync.lamiral.info/dist/ You'll then have access to a zip archive file named imapsync_1.xxx.zip where 1.xxx is the imapsync release number. @@ -33,12 +33,11 @@ A.3) Check the folder In the folder extracted imapsync_1.xxx you see 6 files and 2 directories: * README_Windows.txt is the current file you are reading +* README.txt is the imapsync general document. +* FAQ.d/* FAQs are a must read when something goes wrong. * imapsync_example.bat is a batch file example you will copy and edit * sync_loop_windows.bat is a batch file example for syncing many accounts -* FAQ.txt contains many useful tips, too many so I started -* FAQ.d/* to split them in FAQ.d/ folder. - FAQs are a must read when something goes wrong. -* README.txt imapsync general documentation. +* file.txt is an input file example for syncing many accounts * imapsync.exe is the imapsync binary. You don't have to run it directly. * Cook/ is the directory to build imapsync.exe from its source. @@ -47,8 +46,8 @@ its extension remains ".bat". On Windows systems .bat extension means "I'm a batch script". Same thing for sync_loop_windows.bat. The batch scripts have to stay with imapsync.exe because of the way they call it, they use ".\imapsync.exe", so -let them be in the same directory (or change the path if you -understand what you're doing). +let them be in the same directory (or change the path .\ +to whatever you want if you understand what you're doing). For the rest of this documentation I assume you copied imapsync_example.bat to a file named imapsync_stuff.bat @@ -58,12 +57,13 @@ A.4) Edit the batch file Edit imapsync_stuff.bat and change the values with yours. In order to edit it you have do a right click on it and select "modify" in the list presented in the small window menu. -Notepad is a good editor to modify it, -Office Word is not good for that job. +Notepad or Notepadd++ are good editors to modify it. +Office Word is not good for that job, don't use it! Files FAQ.txt and FAQ.d/* contain many tips and special options sometimes needed by specific imap server softwares like Exchange or Gmail. + A.5) Run the batch file To run imapsync with your values just double-clic on @@ -76,14 +76,16 @@ A.6) Loop on A.5) A.6) Loop the process of editing and running imapsync until you solve all issues and all values suit your needs. -A.7) Look the sync running. You can abort it at any time with a ctrl-c. +A.7) Look the sync running. You can abort it at any time with a + quick double ctrl-c, hit ctrl-c twice within one second. + (a single ctrl-c will reconnect to both imap servers) A.8) When the sync is finished you can find the whole log of the output in the folder named "LOG_imapsync", the logfile name is based -on the launching date, hour, minute, second and the user2 parameter, -one logfile per run. +on the launching date, hour, minute, second, miliseconds and the +user2 parameter. There is one logfile per run. The logfile name is printed at the end of the imapsync run. -If you do not want logging in a file use option --nolog +If you do not want logging to a file then use option --nolog B) Hard way. It is the hard way because it installs all software @@ -92,7 +94,8 @@ B) Hard way. It is the hard way because it installs all software B.1) Install Perl if it isn't already installed. Strawberry Perl is a very good candidate http://strawberryperl.com/ - I use 5.16 (March 2015) but later releases should work (5.18 and 5.20 do) + I use 5.26.0.1 (31 may 2017) but previous and later releases + should work (5.18 and 5.20 do) as well. B.2) Go into the Cook/ directory B.3) Double-clic build_exe.bat diff --git a/S/bc-payment.html b/S/bc-payment.html index d1eaa34..9b1f122 100755 --- a/S/bc-payment.html +++ b/S/bc-payment.html @@ -1,13 +1,13 @@ - + Pay with bitcoins +class="coinbase-button" +href="https://www.coinbase.com/checkouts/5c8544cfe2d17f92401e60fd9299760f" +data-code="5c8544cfe2d17f92401e60fd9299760f">Pay with bitcoins - + diff --git a/S/external.shtml b/S/external.shtml index 25cdaac..bbb30de 100755 --- a/S/external.shtml +++ b/S/external.shtml @@ -18,21 +18,24 @@ - + + -

Similar softwares (back to menu) +

Similar software (back to menu)

@@ -62,11 +65,13 @@ I don't think they use Imapsync. Prices are given par mailbox and may be outdated (December 2011).

    -
  • French Ovh imapcopy 0 EUR: https://ssl0.ovh.net/fr/imapcopy/
    • +
  • Imapsync.love 0 EUR: http://imapsync.love/
    • +
  • French Ovh imapcopy 0 EUR: https://mail.ovh.net/fr/imapcopy/
  • Turkish imapcopy.net 0 TRY: http://imapcopy.net/
    • +
  • Rackspace migration 0 USD: http://www.rackspace.com/email-hosting/migrations
  • Movemymail free for the first and 5 USD thereafter: https://movemymail.net .
    • -
  • Migrationwiz 10 USD: https://www.bittitan.com/products/migrationwiz/
    • -
  • Rackspace migration 5 USD: http://www.rackspace.com/email-hosting/migrations
    • +
  • Migrationwiz 10 USD: https://www.bittitan.com/products/migrationwiz/ + (See this remarkable comparaison Imapsync vs Migrationwiz!)
  • Audriga Gmbh 9.99 EUR: https://www.email-umzug.de/
  • Yippiemove 15 USD: http://www.yippiemove.com/
  • Dell ondemand-migration-for-email (price unknown): http://software.dell.com/products/ondemand-migration-for-email/
    • @@ -100,7 +105,7 @@ alt="Viewable With Any Browser" /> This document last modified on -($Id: external.shtml,v 1.7 2016/03/19 22:05:24 gilles Exp gilles $)
    +($Id: external.shtml,v 1.20 2017/09/11 03:04:46 gilles Exp gilles $)
    Top of the page

    diff --git a/S/favicon.ico b/S/favicon.ico new file mode 100644 index 0000000..5fd669c Binary files /dev/null and b/S/favicon.ico differ diff --git a/S/guestbook.shtml b/S/guestbook.shtml new file mode 100755 index 0000000..fbd5742 --- /dev/null +++ b/S/guestbook.shtml @@ -0,0 +1,57 @@ + + + + + + +Imapsync Guestbook + + + + + + + + + + + + + + + + + + +
    +

    Imapsync Guestbook

    +

    +Your name is mandatory to post but don't hesitate to use a pseudonym! +Email address is optional, only needed if you want a personnal reply. +Have fun! +

    + + +Feedback can also be done via: + + + + + + + +
    + +
    +
    + + + diff --git a/S/images/logo_imapsync_Xn.png b/S/images/logo_imapsync_Xn.png new file mode 100644 index 0000000..405aa7f Binary files /dev/null and b/S/images/logo_imapsync_Xn.png differ diff --git a/S/images/logo_paypal.png b/S/images/logo_paypal.png new file mode 100644 index 0000000..918d504 Binary files /dev/null and b/S/images/logo_paypal.png differ diff --git a/S/images/memo b/S/images/memo new file mode 100644 index 0000000..c1a5ff1 --- /dev/null +++ b/S/images/memo @@ -0,0 +1,3 @@ + +convert logo_imapsync.png -gravity center -resize 190x60 -extent 190x60 logo_paypal.png + diff --git a/S/imap_tools.V1.333/IMAP_Tools_User_Guide.pdf b/S/imap_tools.V1.333/IMAP_Tools_User_Guide.pdf new file mode 100644 index 0000000..c32833f Binary files /dev/null and b/S/imap_tools.V1.333/IMAP_Tools_User_Guide.pdf differ diff --git a/S/imap_tools.V1.333/IMAPtoMbox.pl b/S/imap_tools.V1.333/IMAPtoMbox.pl new file mode 100755 index 0000000..5e48ac1 --- /dev/null +++ b/S/imap_tools.V1.333/IMAPtoMbox.pl @@ -0,0 +1,959 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/IMAPtoMbox.pl,v 1.13 2015/04/30 12:22:21 rick Exp $ + +####################################################################### +# Program name IMAPtoMbox.pl # +# Written by Rick Sanders # +# # +# Description # +# # +# IMAPtoMbox.pl is a utility for extracting all of the mailboxes # +# in an IMAP user's account and writing them to files in the # +# Unix mbx format. # +# # +# The user supplies host/user/password information and the name # +# of a directory on the local system. IMAPtoMbox.pl connects to # +# the IMAP server and extracts each message in the user's IMAP # +# mailboxes. Those messages are written to a file with the same # +# name as the IMAP mailbox into the specified directory. # +# # +# For example: # +# ./IMAPtoMbox.pl -i localhost/rfs/mypass -m /var/rfs # +# # +# Optional arguments: # +# -d debug # +# -L logfile # +# -M IMAP mailbox list (dumps the specified mailboxes, see # +# the usage notes for syntax) # +####################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw(encode_base64 decode_base64); +use POSIX qw(strftime); + +################################################################# +# Main program. # +################################################################# + + $dir = init(); + + # Get list of all messages on the source host by Message-Id + # + connectToHost($sourceHost, \$dst); + login($sourceUser,$sourcePwd, $dst); + namespace($dst, \$prefix, \$delim ); + + @mbxs = getMailboxList( $prefix, $dst ); + $number = $#mbxs + 1; + + foreach $mbx ( @mbxs ) { + my $mbxname = $mbx; + $mbxname =~ s/^$prefix// if $prefix; + @msgs = (); + Log(" $mbxname"); + getMsgList( $mbx, \@msgs, $dst ); + + $mbxname =~ s/\//-/g; # Don't allow slashes in filename + $mbxfn = "$dir/$mbxname"; + if ( !open (M, ">>$mbxfn") ) { + Log("Error opening $mbxfn: $!"); + print STDERR "Error opening $mbxfn\n"; + next; + } + $summary{"$mbx"} = 0; + next if $#msgs == -1; + existingMboxMsgs( $mbxfn, \%mbox ) if $no_duplicates; + $copied=0; + next unless @msgs; + foreach $msg ( @msgs ) { + fetchMsg( $msg, $mbx, $dst, \$message, \$msgid ); + if ( $no_duplicates and ($mbox{"$msgid"}) ) { + Log(" message $msgid already exists") if $debug; + next; + } + print M $message; + print M "\n"; + $copied++; + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $copied == $msgs_per_folder; + } + } + close M; + + `chown $opt_o "$mbxfn"` if $opt_o; # Set ownership + + $summary{"$mbx"} = $copied++; + } + + logout( $dst ); + + Log("\nSummary of results"); + while (($x,$y) = each(%summary)) { + $x =~ s/^$prefix// if $prefix; + $line = pack("A50 A10\n", $x, $y); + push( @summary, $line ); + } + @summary = sort @summary; + foreach $line ( @summary ) { + Log("$line"); + } + + exit; + + +sub init { + + $os = $ENV{'OS'}; + + $dir = processArgs(); + + $timeout = 60 if !$timeout; + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("\n$0 starting"); + Log("arguments i = $opt_i m = $opt_m"); + Log("Mailfiles will be written to $dir"); +# Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + $installed = 1; + @date_modules = qw( DateTime Date::Parse POSIX); + foreach $module ( @date_modules ) { + eval "use $module"; + if ( $@ ) { + print STDERR "The Perl module $module is not installed. Please install it before proceeding.\n"; + $installed = 0; + } + } + exit if $installed == 0; + + return $dir; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ +local($fd) = shift @_; +local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + print STDERR "$str\n"; + +} + +# connectToHost +# +# Make a connection to a host +# +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + + select( $$conn ); $| = 1; + while (1) { + readResponse ( $$conn ); + if ( $response =~ /^\* OK/i ) { + last; + } + else { + Log ("Bad response from host on port $port: $response"); + return 0; + } + } + Log ("connected to $host") if $debug; + + select( $$conn ); $| = 1; + return 1; +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the IMAP host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token") if $debug; + login_xoauth2( $user, $token, $conn ); + return 1; + } + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + exit; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $prefix = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes",2) if $debugMode; + + if ( $mbxList ) { + foreach $mbx ( split(/,/, $mbxList) ) { + $mbx = $prefix . $mbx if $prefix; + if ( $opt_r ) { + # Get all submailboxes under the ones specified + $mbx .= '*'; + @mailboxes = listMailboxes( $mbx, $conn); + push( @mbxs, @mailboxes ); + } else { + push( @mbxs, $mbx ); + } + } + } else { + # Get all mailboxes + @mbxs = listMailboxes( '*', $conn); + } + + return @mbxs; +} + +# listMailboxes +# +sub listMailboxes { + +my $mbx = shift; +my $conn = shift; + + sendCommand ($conn, "1 LIST \"\" \"$mbx\""); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + %nosel_mbxs = (); + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + next if $response[$i] =~ /NOSELECT/i; + + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; +my $from; + + trim( *mailbox ); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + select($conn); + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + return if $empty; + + Log("Fetch the header info") if $debug; + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + } + + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /^From:\s*(.+)/i ) { + $from = $1 if !$from; + } + + if ( $response[$i] =~ /^Date: (.+)/ ) { + # Firstly assume that the date is formatted correctly and split accordingly. + $origdate = $1; + $date = $origdate; + $date =~ s/,//g; + ($date) = split(/-/, $date); + ($wkday,$mday,$mon,$yr,$time) = split(/\s+/, $date); + $mday = '0' . $mday if length($mday) == 1; + $date = "$wkday $mon $mday $time $yr"; + + # Now actually parse the date to check that it is formatted correctly. + # Assume GMT if timezone is omitted. + my @parseddate = strptime ($origdate, "GMT"); + # If the number of seconds were omitted then assume 0. + if ( !defined $parseddate[0] ) { + $parseddate[0] = 0; + } + # If the year was given as 2 digits, assume it can't be less than the UNIX epoch of 1970. + if ( $parseddate[5] < 70 ) { + $parseddate[5] += 100; + } + # strptime returns the timezone as an offset in seconds. Convert back to +/-HHMM format. + if ( $parseddate[6] < 0 ) { + $parseddate[6] = sprintf ("-%02d%02d", int (-$parseddate[6] / 3600), int ((-$parseddate[6] % 3600) / 60)); + } else { + $parseddate[6] = sprintf ("+%02d%02d", int ($parseddate[6] / 3600), int (($parseddate[6] % 3600) / 60)); + } + eval ' + $dt = DateTime->new (second => $parseddate[0], + minute => $parseddate[1], + hour => $parseddate[2], + day => $parseddate[3], + month => $parseddate[4] + 1, # needs to be 1-12 and not 0-11. + year => $parseddate[5] + 1900, # needs to be an absolute year. + time_zone => $parseddate[6]); + '; + + if ( length( $@ ) != 0 ) { + # The date is too badly formatted to fix. Use today's date instead. + Log("The date $date is badly formatted, using today's date instead"); + $date = strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())); + } else { + $newdate = $dt->strftime ("%a %b %d %H:%M:%S %Y"); + + # Compare the parsed date with that formed by assuming the date was correctly formatted. + # Let the user know if they differ so they can judge if the calculated date is correct. + if ( $date ne $newdate ) { + Log ("badly formatted date in message: " . $origdate); + Log (" calculated replacement date as: " . $newdate); + $date = $newdate; + } + } + } + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + push (@$msgs,"$msgnum|$from|$date"); + $msgnum = $date = ''; + } + } + + +} + +# +## Fetch a message from the IMAP server +# + +sub fetchMsg { + +my $msg = shift; +my $mbx = shift; +my $conn = shift; +my $message = shift; +my $msgid = shift; + + my ($msgnum,$from,$date) = split(/\|/, $msg); + Log(" Fetching msg $msgnum...") if $debug; + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /^1 OK/i ); + } + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ( $response =~ /^1 NO|^1 BAD/ ) { + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + + $$message =~ s/\r//g; + if ( $$message !~ /^From / ) { + $$message = "From $from $date\n$$message"; + } + + # Some servers don't like single-digit days in the timestamp + # in the "From " line + for $i (0 .. 9 ) { + $$message =~ s/ $i / 0$i /; + } + + $$message =~ /Message-ID:\s*\<(.+)\>/i; + $$msgid = $1 if $1; + +} + +# +## Display the usage message +# + +sub usage { + + print STDOUT "\nusage:"; + print STDOUT "IMAPtoMbox.pl -i Host/User/Password -m [-M] [-d] [-I] [-o ] \n"; + print STDOUT "\n Optional arguments:\n"; + print STDOUT " -M IMAP mailbox list (eg \"Inbox, Drafts, Notes\". Default all mailboxes)\n"; + print STDOUT " -o sets ownership of mailfile\n"; + print STDOUT " -A \n"; + print STDOUT " -L logfile\n"; + print STDOUT " -d debug\n"; + print STDOUT " -I show IMAP protocal exchanges\n"; + print STDOUT " -n don't copy if message already exists in mbox file\n"; + print STDOUT " -r include submailboxes when used with -M\n\n"; + exit; + +} + +# +## Get command-line arguments +# +sub processArgs { + + if ( !getopts( "di:L:m:hM:Io:nrF:A:" ) ) { + usage(); + } + + ($sourceHost,$sourceUser,$sourcePwd) = split(/\//, $opt_i); + $mbxList = $opt_M; + $logfile = $opt_L; + $dir = $opt_m; + $owner = $opt_o; + $no_duplicates = 1 if $opt_n; + $submbxs = 1 if $opt_r; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $msgs_per_folder = $opt_F; + $admin_user = $opt_A; + + if ( !$dir ) { + print "You must specify the file directory where messages will\n"; + print "be written using the -m argument.\n\n"; + usage(); + exit; + } + + if ( !-d $dir ) { + print "Fatal Error: $dir does not exist\n"; + exit; + } + + usage() if $opt_h; + + return $dir; + +} + +sub existingMboxMsgs { + +my $mbx = shift; +my $msgs = shift; + + + # Build an index of messages in an mbox by messageID. + + %$msgs = (); + unless ( open(F, "<$mbx") ) { + Log("Error opening mbox file $mbox: $!"); + return; + } + + while ( ) { + if ( /^Message-ID:\s*\<(.+)\>/i ) { + $$msgs{"$1"} = 1; + } + } + close F; + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /NO|BAD/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^NO|^BAD/; + } + + if ( $debug ) { + Log("prefix $$prefix"); + Log("delim $$delimiter"); + } + +} + +sub mailboxName { + +my $mbx = shift; +my $prefix = shift; +my $delim = shift; + + # Adjust the mailbox name if necessary using the mailbox hierarchy + # prefix and delimiter. + + $mbx =~ s#^$srcPrefix##; + $mbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + exit; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + diff --git a/S/imap_tools.V1.333/MboxtoIMAP.pl b/S/imap_tools.V1.333/MboxtoIMAP.pl new file mode 100755 index 0000000..4bbdec0 --- /dev/null +++ b/S/imap_tools.V1.333/MboxtoIMAP.pl @@ -0,0 +1,1189 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/MboxtoIMAP.pl,v 1.21 2014/10/15 15:46:28 rick Exp $ + +###################################################################### +# Program name MboxtoIMAP.pl # +# Written by Rick Sanders # +# Date 9 March 2008 # +# # +# Description # +# # +# MboxtoIMAP.pl is used to copy the contents of Unix # +# mailfiles to IMAP mailboxes. It parses the mailfiles # +# into separate messages which are inserted into the # +# corresponging IMAP mailbox. # +# # +# See the Usage() for available options. # +# # +###################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use File::Find; +use MIME::Base64 qw(encode_base64 decode_base64); + + init(); + @mailfiles = getMailfiles(); + + connectToHost($imapHost, \$dst); + login($imapUser,$imapPwd, $dst); + namespace( $dst, \$dstPrefix, \$dstDelim ); + + if ( $range ) { + ($lower,$upper) = split(/-/, $range); + Log("Migrating Mbox message numbers between $lower and $upper"); + } + + $msgs=$errors=0; + foreach $mailfile ( @mailfiles ) { + $owner = getOwner( "$mfdir/$mailfile" ); + if ( $mbxname and $mfile ) { + $mbx = $mbxname; + } else { + # @terms = split(/\//, $mailfile); + # $mbx = $terms[$#terms]; + $mbx = $mailfile; + $mbx =~ s/$mfdir\///; + } + $mbx =~ s/\.mbox$//; + $mbx = mailboxName( $mbx,$dstPrefix,$dstDelim ); + + $mbxs++; + Log("Copying to mbx $mbx"); + + if ( !isAscii( $mbx ) ) { + # mbx name contains non-ASCII characters + if ( $utf7 ) { + $mbx = Unicode::IMAPUtf7::imap_utf7_encode( $mbx ); + } else { + Log("The name $mbx contains non-ASCII characters. To have it properly"); + Log("named in IMAP you must install the Unicode::IMAPUtf7 Perl module"); + } + } + + createMbx( $mbx, $dst ) unless mbxExists( $mbx, $dst ); + + if ( $update ) { + Log("Get msgids on the destination") if $debug; + getMsgIdList( $mbx, \%DST_MSGS, $dst ); + } + + foreach $_ ( keys %DST_MSGS ) { + Log(print STDERR "$_") if $debug; + } + + if ( $removeCopiedMsgs ) { + unless( open(NEW, ">$mfdir/$mailfile.new") ) { + Log("Can't open $mfdir/$mailfile.new: $!"); + exit; + } + } + + $msgnum=0; + @msgs = readMbox( $mailfile ); + $msgcount = $#msgs+1; + Log("There are $msgcount messages in the $mailfile mbox"); + $copied = 0; + foreach $msg ( @msgs ) { + alarm $timeout; + $msgnum++; + @msgid = grep( /^Message-ID:/i, @$msg ); + ($label,$msgid) = split(/:/, $msgid[0]); + chomp $msgid; + trim( *msgid ); + @subject = grep( /^Subject:/i, @$msg ); + ($label,$subject) = split(/:/, $subject[0], 2); + chomp $subject; + trim( *subject ); + @orig_date = grep( /^Date:/i, @$msg ); + ($label,$orig_date) = split(/:/, $orig_date[0],2); + chomp $orig_date; + trim( *orig_date ); + + Log("msgid $msgid") if $debug; + if ( $update ) { + # Don't insert the message if it already exists + next if $DST_MSGS{"$msgid"}; + Log("$msgid does not exist on the destination") if $debug; + } + Log("Copying message number $msgnum $msgid"); + + # if ( $getdate ) { + # $date = get_date( $msg ); + # } + + $date = get_date( $msg ); + + my $message; + foreach $_ ( @$msg ) { + chomp; + $message .= "$_\r\n"; + } + + if ( $range ) { + if ( ($msgnum < $lower) or ($msgnum > $upper) ) { + # We aren't going to copy this msg so save it to + # the temp copy of the mailfile that we are building + print NEW "$message\n" unless $removeCopiedMessages; + next; + } + } + + if ( insertMsg($mbx, \$message, $flags, $date, $dst) ) { + $added++; + $copied++; + print STDOUT " Added $msgid\n" if $debug; + print NEW "$message\n" unless $removeCopiedMsgs; + } else { + Log("Copy failed"); + } + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $copied == $msgs_per_folder; + } + + alarm 0; + if ( $conn_timed_out ) { + Log("$imapHost timed out"); + print STDERR "reconnect to $imapHost on conn = $dst\n"; + reconnect( $checkpoint, $dst ); + $conn_timed_out = 0; + next; + } + } + + if ( $removeCopiedMsgs ) { + # Put the temp mailfile less the copied messages in place. + close NEW; + $stat = rename( "$mfdir/$mailfile.new", "$mfdir/$mailfile" ); + unless ( $stat ) { + Log("Rename $mfdir/$mailfile.new to $mfdir/$mailfile failed: $stat"); + } else { + $stat = `chown $owner $mfdir/$mailfile`; + Log("Installed new version of mailfile $mfdir/$mailfile"); + } + } + } + + logout( $dst ); + + Log("\n\nSummary:\n"); + Log(" Mailboxes $mbxs"); + Log(" Total Msgs $added"); + + if ( $opt_W ) { + Log("Wrote failed appends to MboxtoIMAP.failed_appends"); + } + + exit; + + +sub init { + + if ( !getopts('m:L:i:dIr:RDf:n:p:UM:t:WA:F:') ) { + usage(); + exit; + } + + $mfdir = $opt_m; + $mfile = $opt_f; + $mbxname = $opt_n; + $admin_user = $opt_A; + $logfile = $opt_L; + $range = $opt_r; + $root_mbx = $opt_p; + $max_size = $opt_M; + $showIMAP = 1 if $opt_I; + $debug = 1 if $opt_d; + $update = 1 if $opt_U; + $getdate = 1 if $opt_D; + $removeCopiedMsgs = 1 if $opt_R; + $timeout = $opt_t; + $timeout = 300 unless $timeout; + $msgs_per_folder = $opt_F; + + ($imapHost,$imapUser,$imapPwd) = split(/\//, $opt_i); + + if ( $logfile ) { + if ( ! open (LOG, ">> $logfile") ) { + print "Can't open logfile $logfile: $!\n"; + $logfile = ''; + } + } + Log("Starting"); + Log("Running in update mode, msgs already on the destination will not be copied again") if $update; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + # Determine if the IMAP Utf7 module is installed. + + eval 'use Unicode::IMAPUtf7'; + if ( $@ ) { + # Module not installed + $utf7 = 0; + } else { + $utf7 = 1; + } + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + + if ( $opt_W ) { + # The user wants a file of failed APPENDS + open(W, ">MboxtoIMAP.failed_appends"); + } + +} + + +sub getMailfiles { + + # Get a list of the mailfiles to be processed. The + # user can either supply a directory name where one or + # more mailfiles reside or he can give a complete filepath + # and name of a single mailfile. + # + # The list of mailfiles is returned in @mailfiles + + if ( $mfdir ) { + get_mboxes( $mfdir ); # Returns @mailfiles + } elsif ( $mfile ) { + if ( !-e $mfile ) { + Log("$mfile does not exist."); + print STDOUT "mfile $mfile does not exist\n"; + exit; + } + push( @mailfiles, $mfile ); + } + + Log("No mailfiles were found in $dir") if $#mailfiles == -1; + + @mailfiles = sort { lc($a) cmp lc($b) } @mailfiles; + + return @mailfiles; +} + + + +sub usage { + + print "Usage: MboxtoIMAP.pl\n"; + print " -m \n"; + print " -f \n"; + print " -n Used with -f \n"; + print " -i \n"; + print " (if the password is an OAUTH2 token prefix it with 'oauth2:'\n"; + print " [-A ]\n"; + print " [-r ] eg 1-10 or 450-475\n"; + print " [-R remove copied messages from the mailfile]\n"; + print " [-p put all mailboxes under the root mbx\n"; + print " [-L ]\n"; + print " [-d debug]\n"; + print " [-I log IMAP protocol exchanges]\n"; + +} + +sub readMbox { + +my $file = shift; +my @mail = (); +my $mail = []; +my $blank = 1; +local *FH; +local $_; + + open(FH,"< $file") or die "Can't open $file"; + + # s/$//; + while() { + s/\r$//; + s/; + $//; + if($blank && /\AFrom .*\d{4}/) { + push(@mail, $mail) if scalar(@{$mail}); + $mail = [ $_ ]; + $blank = 0; + } + else { + $blank = m#\A\Z#o ? 1 : 0; + push(@{$mail}, $_); + } + } + + push(@mail, $mail) if scalar(@{$mail}); + close(FH); + + return wantarray ? @mail : \@mail; +} + +sub Log { + +my $line = shift; +my $msg; + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time); + $msg = sprintf ("%.2d-%.2d-%.4d.%.2d:%.2d:%.2d %s", + $mon + 1, $mday, $year + 1900, $hour, $min, $sec, $line); + + if ( $logfile ) { + print LOG "$msg\n"; + } + print STDERR "$line\n"; + +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token") if $debug; + login_xoauth2( $user, $token, $conn ); + return 1; + } + + Log("Logging in as $user") if $debug; + $rsn = 1; + sendCommand ($conn, "$rsn LOGIN \"$user\" \"$pwd\""); + while (1) { + readResponse ( $conn ); + if ($response =~ /^$rsn OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + exit; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< $response") if $showIMAP; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + Log (">> $cmd") if $showIMAP; +} + +sub insertMsg { + +my $mbx = shift; +my $message = shift; +my $flags = shift; +my $date = shift; +my $conn = shift; +my ($lsn,$lenx); + + Log(" Inserting message") if $debug; + $lenx = length($$message); + + if ( $debug ) { + Log("$$message"); + } + + ++$lsn; + $flags =~ s/\\Recent//i; + + fixup_date( \$date ); + + sendCommand ($conn, "$lsn APPEND \"$mbx\" () \"$date\" \{$lenx\}"); + readResponse ($conn); + if ( $response =~ /^1 BAD/ ) { + print W "$response: $subject $orig_date\n" if $opt_W; + return 0; + } + if ( $response !~ /^\+/ ) { + # next; + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$$message\r\n"; + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + # next; + return 0; + } + } + + return 1; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the IMAP host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + Log("Getting list of msgs in $mailbox") if $debug; + trim( *mailbox ); + sendCommand ($conn, "$rsn EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^$rsn OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + sendCommand ( $conn, "$rsn FETCH 1:* (uid flags internaldate body[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^$rsn OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $XDXDXD ) { + Log ("unexpected response: $response"); + Log ("Unable to get list of messages in this mailbox"); + push(@errors,"Error getting list of $user's msgs"); + return 0; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID / ) { + $response[$i] =~ /\* ([^FETCH \(UID]*)/; + $msgnum = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//i; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + ### $response[$i] =~ /INTERNALDATE (.+) ([^BODY]*)/i; + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Message-Id:/i ) { + ($label,$msgid) = split(/: /, $response[$i]); + push (@$msgs,$msgid); + } + } +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /NO|BAD/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^NO|^BAD/; + } + + if ( $debug ) { + Log("prefix $$prefix"); + Log("delim $$delimiter"); + } + +} + +sub mailboxName { + +my $mbx = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; + + # Insert the IMAP server's prefix (if defined) and replace the Unix + # file delimiter with the server's delimiter (again if defined). + + $dstmbx = "$dstPrefix$mbx"; + $dstmbx =~ s#/#$dstDelim#g; + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub getOwner { + +my $fn = shift; +my $owner; + + # Get the numeric UID of the file's owner + @info = stat( $fn ); + $owner = $info[4]; + + return $owner; +} + +sub get_date { + +my $msg = shift; + + # Extract the date from the message and format it + + my @date = grep( /^Date:/i, @$msg ); + my ($label,$date) = split(/:/, $date[0],2); + + $date =~ s/^\s+|\s+$//g; + $date =~ s/\s+/ /g; + + if ( $date =~ /^(.+) (.+),/ ) { + # Format is DOW MDAY, MMM YYYY 0000. Fix it up. + $dow = $1; + $date =~ s/^$dow\s+//; + $date =~ s/,//; + $date = "$dow, " . $date; + + } + + if ( $date =~ /^(.+),\s+(.+) (.+)\s+(.+)\s+(.+)/ ) { + $yr = $3; + if ( $yr < 2000 and length($yr) == 2 ) { + # Y2K problem, date has only 2 digits + $date =~ s/$yr/19$yr/; + } + } + + if ( $date =~ /,/ ) { + ($dow,$date) = split(/,\s*/, $date); + } + if ( $date =~ /\((.+)\)/ ) { + $date =~ s/\($1\)//g; + } + $date =~ s/ /-/; + $date =~ s/ /-/; + chomp $date; + $date =~ s/^\s+|\s+$//g; + + if ( $date =~ / 0000$/ ) { + $date =~ s/ 0000$/\ +0000/; + } + + return $date; +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if necessary + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + Log ("Error creating $mbx: $response"); + last; + } + + } + + # Subcribe to it. + + sendCommand( $conn, "1 SUBSCRIBE \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + Log("Mailbox $mbx has been subscribed") if $debug; + last; + } elsif ( $response =~ /^1 NO|^1 BAD|\^* BYE/i ) { + Log("Unexpected response to subscribe $mbx command: $response"); + last; + } + } + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +# getMsgIdList +# +# Get a list of the user's messages in a mailbox +# +sub getMsgIdList { + +my $mailbox = shift; +my $msgids = shift; +my $conn = shift; +my $empty; +my $msgnum; +my $from; +my $msgid; + + %$msgids = (); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + if ( $empty ) { + return; + } + + Log("Fetch the header info") if $debug; + + sendCommand ( $conn, "1 FETCH 1:* (body[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ($response[$i] =~ /Message-ID:/i) { + $response[$i] =~ /Message-Id: (.+)/i; + $msgid = $1; + trim(*msgid); + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = $response[$i+1]; + trim(*msgid); + } + $$msgids{"$msgid"} = 1; + } + } + +} + +sub encode_ampersand { + +my $mbx = shift; + + # The IMAP RFC requires mailbox names with '&' be + # encoded as '&-' + + # The problem with this routine is a mailbox name may be + # encoded in Mod UTF7 which uses the '&' character for its + # own purposes, eg r&AOk-pertoire_XXX. We have to leave it + # alone. Anyway, this code was inserted because of an IMAP + # server which did not do its job so the usefulness of this + # conversion is limited. + + if ( $$mbx =~ /\&/ ) { + if ( $$mbx !~ /\&-/ ) { + # Need to encode the '&' as '&-' + $$mbx =~ s/\&/\&-/g; + Log("Encoded $$mbx"); + } + } + +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } + Log("Resuming"); +} + +sub reconnect { + +my $checkpoint = shift; +my $conn = shift; + + $timed_out = 1; +print STDERR "logout conn =$conn\n"; + logout( $conn ); + Log("Timed out, closing the IMAP connection"); + close $conn; + + Log("Reconnect to $imapHost on $conn"); + connectToHost($imapHost,\$conn); +print STDERR "new conn $conn\n"; +$showIMAP = 1; + Log("Logging back in as $imapUser"); + login($imapUser,$imapPwd,$conn); + + createMbx( $mbx, $dst ) unless mbxExists( $mbx, $dst ); + +} + +sub get_mboxes { + +my $dir = shift; + + @$files = (); + push( @dirs, $dir ); + find( \&find_files, @dirs ); # Creates @mboxes +} + +sub find_files { + + my $fn = $File::Find::name; + next if -d $fn; # Skip directories + + # Make sure this is a Mbox file + next unless mbox( $fn ); + push( @mailfiles, $fn ); +} + +sub mbox { + +my $fn = shift; +my $is_mbox = 0; + + # Look at the file and return 1 if it + # appears to be an mbox. + + open(T, "<$fn"); + my $line = ; + $is_mbox = 1 if $line =~ /^From/; + close T; + + return $is_mbox; +} + +sub fixup_date { + +my $date = shift; +my ($hrs,$dom); + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. Same for the DOM. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + $hrs = $2; + ($dom) = split(/-/, $$date, 2); + + if ( length( $hrs ) == 1 ) { + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + $hrs = $2; + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + } + if ( length( $dom ) == 1 ) { + $$date =~ s/^\s+//; + my $newdom = '0' . $dom if length( $dom ) == 1; + $$date =~ s/^$dom/$newdom/; + } + +} + diff --git a/S/imap_tools.V1.333/delIMAPdups.pl b/S/imap_tools.V1.333/delIMAPdups.pl new file mode 100755 index 0000000..e62053e --- /dev/null +++ b/S/imap_tools.V1.333/delIMAPdups.pl @@ -0,0 +1,1238 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/delIMAPdups.pl,v 1.30 2015/03/07 06:46:44 rick Exp $ + +####################################################################### +# Description # +# # +# delIMAPdups looks for duplicate messages in an IMAP account, # +# looking for messages in each mailbox that have the same Message # +# ID. When a duplicate message is found the DELETED flag is set. # +# If the -p argument has been supplied then an EXPUNGE operation # +# is executed against the mailbox in which the message resides, # +# causing the messages which are marked for DELETE to be removed. # +# # +# Note that delIMAPdups does not check for duplicate copies of # +# messages across multiple mailboxes since it is often useful to # +# cross-file messages in multiple mailboxes. # +# # +# Usage: ./deldups -S host/user/password # +# [-i list of users and passwords] # +# [-m mailbox list (comma-delimited)] # +# [-L logfile] # +# [-p] purge messages # +# [-d] debug mode # +# See usage() for additional arguments. # +####################################################################### + +############################################################################ +# Copyright (c) 2008 Rick Sanders # +# # +# Permission to use, copy, modify, and distribute this software for any # +# purpose with or without fee is hereby granted, provided that the above # +# copyright notice and this permission notice appear in all copies. # +# # +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # +############################################################################ + +# use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use MIME::Base64 qw(encode_base64 decode_base64); + +################################################################# +# Main program. # +################################################################# + +init(); +sigprc(); + +foreach $_ ( @users ) { + s/^\s+|\s+$//g; + ($user,$pwd) = split(/[\s+:]/, $_, 2); + trim( *user ); + trim( *pwd ); + Log("Checking $user"); + + # Get list of all messages on the host by Message-ID + # + connectToHost($host, \$conn); + next unless login($user,$pwd, $conn); + @mbxs = getMailboxList($user, '', $conn); + + if ( $recursive and $mbxList ) { + # The user wants all submbxs under the ones he asked for + $mbxList = ''; + my @mailboxes; + foreach $mbx ( @mbxs ) { + @submbxs = getMailboxList($user, $mbx, $conn); + push( @mailboxes, @submbxs ); + } + @mbxs = @mailboxes; + } + + if ( $md5_hash ) { + Log("Looking for duplicate messages using an MD5-digest hash of the body"); + } else { + Log("Looking for duplicate messages using the $keyfield"); + } + + foreach $mbx ( @mbxs ) { + Log(" Checking mailbox $mbx"); + %msgList = (); + @msgs = (); + getMsgList( $keyfield, $mbx, \@msgs, $conn ); + selectMbx( $mbx, $conn); + foreach $msg ( @msgs ) { + # ($msgnum,$msgid,$subject,$date) = split(/\|/, $msg); + ($msgnum,$key,$date) = split(/\|\|\|/, $msg); + + if ( $md5_hash ) { + Log("Using md5 hash of msg body as the key") if $debug; + fetch_msg_body( $msgnum, $conn, \$message ); + $key = hash( \$message ); + Log("msgnum:$msgnum hash $key") if $debug; + } else { + if ( $use_date ) { + Log("Using $keyfield + date as the key") if $debug; + $key = "$key $date"; + Log("key $key") if $debug; + } else { + Log("Using $keyfield") if $debug; + } + } + + Log("key $key") if $debug; + if ( $msgList{"$key"} eq '' ) { + $msgList{"$key"} = $msgnum; + } else { + # Duplicate message + $dup = $msgList{"$key"}; + Log(" Msgnum $msgnum is a duplicate of msgnum $dup") if $debug; + if ( !$purge and !$move2mbx ) { + Log("Would have purged msgnum $msgnum"); + next; + } + if ( $move2mbx ) { + $moved++ if moveMsg( $mbx, $msgnum, $move2mbx, $conn ); + } + deleteMsg( $mbx, $msgnum, $conn ); + $expungeMbxs{"$mbx"} = 1; + } + } + } + + if ( $purge or $move2mbx ) { + @mbxs = keys %expungeMbxs; + foreach $mbx ( @mbxs ) { + expungeMbx( $mbx, $conn ); + } + } + + logout( $conn ); + + if ( $move2mbx ) { + Log("Total messages moved $moved"); + } else { + Log("Total messages purged $total"); + } + +} +exit; + + +sub init { + + $version = 'V1.2'; + $os = $ENV{'OS'}; + + processArgs(); + + $timeout = 60 unless $timeout; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + if ( $md5_hash ) { + use Digest::MD5 qw(md5_hex); + } + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("\n$0 starting"); + $total=$moved=0; + +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $str =~ /^\>\> 1 LOGIN (.+) "(.+)"/ ) { + # Obscure the password for security's sake + $str =~ s/$2/XXXX/; + } + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } + print STDOUT "$str\n"; + +} + + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + $status = login_xoauth2( $user, $token, $conn ); + return $status; + } + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /^1 NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + + +# getMailboxList +# +# get a list of the user's mailboxes from the host +# +sub getMailboxList { + +my $user = shift; +my $mbx = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes. + @mbxs = split(/,/, $mbxList); + return @mbxs; + } + + namespace( $conn, \$srcPrefix, \$srcDelim, $opt_x ); + + if ($debugMode) { Log("Get list of user's mailboxes",2); } + + my $target = $mbx . '*'; + + sendCommand ($conn, "1 LIST \"\" $target"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + undef @mbxs; + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + ### ($dmy,$mbx) = split(/"\/" /,$response[$i]); + ($dmy,$mbx) = split(/"$srcDelim" /,$response[$i]); + # $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + $mbx =~ s/"//g; + + if ($response[$i] =~ /NOSELECT/i) { + next; + } + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the host +# +sub getMsgList { + +my $field = shift; +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + trim( *mailbox ); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + elsif ( $response =~ /^* 0 EXISTS/i ) { + $empty = 1; + } + } + + return if $empty; + + $range = '1:*' unless $range; + + sendCommand ( $conn, "1 FETCH $range (uid flags internaldate body[header.fields ($field)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response =~ /Broken pipe|Connection reset by peer/i ) { + print STDOUT "Fetch from $mailbox: $response\n"; + exit; + } + elsif ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Unexpected response $response"); + return 0; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID / ) { + $response[$i] =~ /\* ([^FETCH \(UID]*)/; + $msgnum = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags =~ s/\\Recent//; + $flags = $1; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Subject:/ ) { + $response[$i] =~ /Subject: (.+)/; + $subject = $1; + } + if ( $response[$i] =~ /^$field:/i ) { + ($label,$value) = split(/:\s*/, $response[$i],2); + trim(*value); + if ( $value eq '' ) { + # Line-wrap, get it from the next line + $value = $response[$i+1]; + trim(*value); + } + if ( $debug ) { + Log("$msgnum $value $date $subject"); + } + $value = lc( $value ); + push (@$msgs,"$msgnum|||$value|||$date"); + } + + } +} + + +sub fetch_msg_body { + +my $msgnum = shift; +my $conn = shift; +my $message = shift; + + # Fetch the body of the message less the headers + + Log(" Fetching msg $msgnum...") if $debug; + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + +} + + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " deldups -S host/user/password\n"; + print STDOUT " Optional arguments:\n"; + print STDOUT " -p purge duplicate messages\n"; + print STDOUT " -M \n"; + print STDOUT " -d debug\n"; + print STDOUT " -L logfile\n"; + print STDOUT " -m mailbox list (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n"; + print STDOUT " -R recursive (used with -m argument\n"; + print STDOUT " -u include the date in the key field to determine uniqueness\n"; + print STDOUT " -H use an MD5 hash of the message body to determine uniqueness\n"; + print STDOUT " -F Use to determine duplicate messages\n"; + print STDOUT " -A \n"; + print STDOUT " -r Range of messages to examine, eg 1:1000\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dS:L:Im:hpuM:HF:i:RA:F:r:" ) ) { + usage(); + } + + ($host,$user,$pwd) = split(/\//, $opt_S); + $userList = $opt_i; + $mbxList = $opt_m; + $logfile = $opt_L; + $move2mbx = $opt_M; + $purge = 1 if $opt_p; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $use_date = 1 if $opt_u; + $md5_hash = 1 if $opt_H; + $keyfield = $opt_F; + $recursive = 1 if $opt_R; + $admin_user = $opt_A; + $msgs_per_folder = $opt_F; + $range = $opt_r; + + $keyfield = 'Message-ID' if !$keyfield; + + if ( $userList ) { + if ( !open(F, "<$userList") ) { + print STDERR "Error opening userlist $userList: $!\n"; + exit; + } + while( ) { + chomp; + s/^\s+//; + next if /^#/; + push( @users, $_ ); + } + close F; + } else { + push( @users, "$user $pwd" ); + } + + usage() if $opt_h; + +} + +sub findMsg { + +my $conn = shift; +my $msgid = shift; +my $mbx = shift; +my $msgnum; + + Log("SELECT $mbx") if $debug; + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + } + + Log("Search for $msgid") if $debug; + sendCommand ( $conn, "1 SEARCH header Message-ID \"$msgid\""); + while (1) { + readResponse ($conn); + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msgnum) = split(/\* SEARCH /i, $response); + ($msgnum) = split(/ /, $msgnum); + } + + last if $response =~ /^1 OK/; + last if $response =~ /complete/i; + } + + return $msgnum; +} + +sub deleteMsg { + +my $mbx = shift; +my $msgnum = shift; +my $conn = shift; +my $rc; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msg number $msgnum for delete"); + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; + + print STDOUT "Purging mailbox $mbx..."; + + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /^1 OK/i ); + } + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + print "Error purging messages: $response\n"; + last; + } + } + + $total += $expunged; + + print STDOUT "$expunged messages purged\n"; + +} + +sub updateFlags { + +my $conn = shift; +my $msgid = shift; +my $mbx = shift; +my $flags = shift; +my $rc; + + if ( $debug ) { + Log("Find $msgid"); + Log("flags $flags"); + } + + $msgnum = findMsg( $conn, $msgid, $mbx ); + Log("msgnum is $msgnum") if $debug; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS ($flags)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + Log(" Updated flags for $msgid"); + $rc = 1; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting flags for $msgid: $response"); + $rc = 0; + last; + } + } + return $rc; +} + +sub dieright { + local($sig) = @_; + print STDOUT "caught signal $sig\n"; + logout( $conn ); + exit(-1); +} + +sub sigprc { + + $SIG{'HUP'} = 'dieright'; + $SIG{'INT'} = 'dieright'; + $SIG{'QUIT'} = 'dieright'; + $SIG{'ILL'} = 'dieright'; + $SIG{'TRAP'} = 'dieright'; + $SIG{'IOT'} = 'dieright'; + $SIG{'EMT'} = 'dieright'; + $SIG{'FPE'} = 'dieright'; + $SIG{'BUS'} = 'dieright'; + $SIG{'SEGV'} = 'dieright'; + $SIG{'SYS'} = 'dieright'; + $SIG{'PIPE'} = 'dieright'; + $SIG{'ALRM'} = 'dieright'; + $SIG{'TERM'} = 'dieright'; + $SIG{'URG'} = 'dieright'; +} + +sub moveMsg { + +my $mbx = shift; +my $msgnum = shift; +my $dstmbx = shift; +my $conn = shift; +my $moved=0; + + # Move a message from one mailbox to another. + + return 0 unless $msgnum; + + Log(" Moving msgnum $msgnum to $dstmbx"); + + # Create the mailbox if it doesn't already exist + sendCommand ($conn, "1 CREATE \"$dstmbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|file exists|can\'t create/i)) { + ## print STDOUT "WARNING: $response\n"; + } + last; + } + } + + sendCommand ($conn, "1 COPY $msgnum \"$dstmbx\""); + while (1) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + $moved=1; + last; + } + if ($response =~ /^1 NO|^1 BAD/) { + Log("unexpected COPY response: $response"); + Log("Please verify that mailbox $dstmbx exists"); + exit; + } + } + + return $moved; +} + +sub hash { + +my $msg = shift; +my $body; +my $boundary; + + # Generate an MD5 hash of the message body + + # Strip the header and the MIME boundary markers + my $header = 1; + foreach $_ ( split(/\n/, $$msg ) ) { + if ( $header ) { + if (/boundary="(.+)"/i ) { + $boundary = $1; + } + $header = 0 if length( $_ ) == 1; + } + + eval 'next if /$boundary/ ); '; + $body .= "$_\n" unless $header; + } + + my $md5 = md5_hex($body); + Log("md5 hash $md5") if $debug; + + return $md5; +} + +sub fetchMsg { + +my $msgnum = shift; +my $conn = shift; +my $message = shift; + + Log(" Fetching msg $msgnum...") if $debug; + + sendCommand( $conn, "1 FETCH $msgnum body[text]"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; + + # Select the mailbox + + sendCommand( $conn, "1 SELECT \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to SELECT $mbx command: $response"); + last; + } + } + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + +$$delimiter = ''; + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub NEW_getMailboxList { + +my $prefix = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes",2) if $debugMode; + + if ( $mbxList ) { + foreach $mbx ( split(/,/, $mbxList) ) { + $mbx = $prefix . $mbx if $prefix; + if ( $opt_R ) { + # Get all submailboxes under the ones specified + $mbx .= '*'; + @mailboxes = listMailboxes( $mbx, $conn); + push( @mbxs, @mailboxes ); + } else { + push( @mbxs, $mbx ); + } + } + } else { + # Get all mailboxes + @mbxs = listMailboxes( '*', $conn); + } + + return @mbxs; +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + diff --git a/S/imap_tools.V1.333/delIMAPdups.pl.files b/S/imap_tools.V1.333/delIMAPdups.pl.files new file mode 100644 index 0000000..59ea5ff --- /dev/null +++ b/S/imap_tools.V1.333/delIMAPdups.pl.files @@ -0,0 +1,1251 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/delIMAPdups.pl.files,v 1.3 2015/02/04 23:32:22 rick Exp $ + +####################################################################### +# Description # +# # +# delIMAPdups looks for duplicate messages in an IMAP account, # +# looking for messages in each mailbox that have the same Message # +# ID. When a duplicate message is found the DELETED flag is set. # +# If the -p argument has been supplied then an EXPUNGE operation # +# is executed against the mailbox in which the message resides, # +# causing the messages which are marked for DELETE to be removed. # +# # +# Note that delIMAPdups does not check for duplicate copies of # +# messages across multiple mailboxes since it is often useful to # +# cross-file messages in multiple mailboxes. # +# # +# Usage: ./deldups -S host/user/password # +# [-i list of users and passwords] # +# [-m mailbox list (comma-delimited)] # +# [-L logfile] # +# [-p] purge messages # +# [-d] debug mode # +# See usage() for additional arguments. # +####################################################################### + +############################################################################ +# Copyright (c) 2008 Rick Sanders # +# # +# Permission to use, copy, modify, and distribute this software for any # +# purpose with or without fee is hereby granted, provided that the above # +# copyright notice and this permission notice appear in all copies. # +# # +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # +############################################################################ + +# use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use MIME::Base64 qw(encode_base64 decode_base64); + +################################################################# +# Main program. # +################################################################# + +init(); +sigprc(); + +$grand_total = 0; +foreach $_ ( @users ) { + $total = 0; + s/^\s+|\s+$//g; + next if /^#/; + ($user,$pwd) = split(/[\s+:]/, $_, 2); + trim( *user ); + trim( *pwd ); + Log("Checking $user"); + + # Get list of messages + # + connectToHost($host, \$conn); + login($user,$pwd, $conn); + @mbxs = getMailboxList($user, '', $conn); + + if ( $recursive and $mbxList ) { + # The user wants all submbxs under the ones he asked for + $mbxList = ''; + my @mailboxes; + foreach $mbx ( @mbxs ) { + @submbxs = getMailboxList($user, $mbx, $conn); + push( @mailboxes, @submbxs ); + } + @mbxs = @mailboxes; + } + + if ( $md5_hash ) { + Log("Looking for duplicate messages using an MD5-digest hash of the body"); + } else { + Log("Looking for duplicate messages using the $keyfield"); + } + + $output_file = "/tmp/delIMAPdups.tmp.$$"; + $sorted_file = "/tmp/delIMAPdups.tmp.sorted.$$"; + + unlink $output_file if -e $output_file; + foreach $mbx ( @mbxs ) { + Log(" Checking mailbox $mbx") if $debug; + if ( $global ) { + if ( !open(FILE, ">>$output_file")) { + Log("Fatal error: Can't open $output_file: $!"); + exit; + } + } else { + if ( !open(FILE, ">$output_file")) { + Log("Fatal error: Can't open $output_file: $!"); + exit; + } + } + + $msgcount = selectMbx( $mbx, $conn); + Log(" There are $msgcount messages in $mbx"); + + @msgs = (); + + $i = 1; + $j = 1000; + while( 1 ) { + $range = "$i:$j"; + Log(" range $range") if $debug; + getMsgList( $keyfield, $mbx, $range, \@msgs, $conn ); + $i += 1000; + $j += 1000; + $j = $msgcount if $j > $msgcount; + + foreach $msg ( @msgs ) { + ($uid,$key,$date) = split(/\|\|\|/, $msg); + + if ( $md5_hash ) { + Log("Using md5 hash of msg body as the key") if $debug; + fetch_msg_body( $msgnum, $conn, \$message ); + $key = hash( \$message ); + Log("msgnum:$msgnum hash $key") if $debug; + } else { + if ( $use_date ) { + Log("Using $keyfield + date as the key") if $debug; + $key = "$key $date"; + Log("key $key") if $debug; + } else { + Log("Using $keyfield") if $debug; + } + } + + print FILE "$key|||$uid $mbx\n"; + + } + + last if $i >= $msgcount; + } + + close FILE; + + # Go through the output file, identify duplicates, and delete them. + delete_duplicate_msgs( $output_file, \%deletes, $conn ) unless $global; + + } + + if ( $global ) { + Log("Deleting duplicates across all mailboxes"); + delete_duplicate_msgs( $output_file, \%deletes, $conn ); + } + + logout( $conn ); + + Log(" Total messages purged $total"); + $grand_total += $total; + +} +Log(""); +Log("Grand total messages purged $grand_total"); +exit; + + +sub init { + + $version = 'V1.2'; + $os = $ENV{'OS'}; + + processArgs(); + + $timeout = 60 unless $timeout; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + eval 'use Text::Wrap'; + if ( $@ ) { + $text_wrap_install = 0; + } + + if ( $md5_hash ) { + use Digest::MD5 qw(md5_hex); + } + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("\n$0 starting"); + $total=$moved=0; + + Log("Messages will be checked for duplicates across all folders") if $global; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $str =~ /^\>\> 1 LOGIN (.+) "(.+)"/ ) { + # Obscure the password for security's sake + $str =~ s/$2/XXXX/; + } + + unless ( $text_wrap_installed == 0 ) { + $Text::Wrap::columns = $width; + $str = wrap('', '', $str); + } + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } + print STDOUT "$str\n"; + +} + + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port") if $debug; + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + $status = login_xoauth2( $user, $token, $conn ); + return $status; + } + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + + +# getMailboxList +# +# get a list of the user's mailboxes from the host +# +sub getMailboxList { + +my $user = shift; +my $mbx = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes. + @mbxs = split(/,/, $mbxList); + return @mbxs; + } + + namespace( $conn, \$srcPrefix, \$srcDelim, $opt_x ); + + if ($debugMode) { Log("Get list of user's mailboxes",2); } + + my $target = $mbx . '*'; + + sendCommand ($conn, "1 LIST \"\" $target"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + undef @mbxs; + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + ### ($dmy,$mbx) = split(/"\/" /,$response[$i]); + ($dmy,$mbx) = split(/"$srcDelim" /,$response[$i]); + # $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + $mbx =~ s/"//g; + + if ($response[$i] =~ /NOSELECT/i) { + next; + } + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the host +# +sub getMsgList { + +my $field = shift; +my $mailbox = shift; +my $range = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + @$msgs = (); + sendCommand ( $conn, "1 FETCH $range (uid flags internaldate body[header.fields ($field)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response =~ /Broken pipe|Connection reset by peer/i ) { + print STDOUT "Fetch from $mailbox: $response\n"; + exit; + } + elsif ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Unexpected response $response"); + return 0; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID (.*?) / ) { + $uid = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags =~ s/\\Recent//; + $flags = $1; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Subject:/ ) { + $response[$i] =~ /Subject: (.+)/; + $subject = $1; + } + if ( $response[$i] =~ /^$field:/i ) { + ($label,$value) = split(/:\s*/, $response[$i],2); + trim(*value); + if ( $value eq '' ) { + # Line-wrap, get it from the next line + $value = $response[$i+1]; + trim(*value); + } + if ( $debug ) { + Log("$uid $value $date $subject"); + } + $value = lc( $value ); + push (@$msgs,"$uid|||$value|||$date"); + } + + } +} + + +sub fetch_msg_body { + +my $msgnum = shift; +my $conn = shift; +my $message = shift; + + # Fetch the body of the message less the headers + + Log(" Fetching msg $msgnum...") if $debug; + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + +} + + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " deldups -S host/user/password\n"; + print STDOUT " Optional arguments:\n"; + print STDOUT " -p purge duplicate messages\n"; + print STDOUT " -M \n"; + print STDOUT " -d debug\n"; + print STDOUT " -L logfile\n"; + print STDOUT " -m mailbox list (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n"; + print STDOUT " -R recursive (used with -m argument\n"; + print STDOUT " -u include the date in the key field to determine uniqueness\n"; + print STDOUT " -H use an MD5 hash of the message body to determine uniqueness\n"; + print STDOUT " -F Use to determine duplicate messages\n"; + print STDOUT " -A \n"; + print STDOUT " -r Range of messages to examine, eg 1:1000\n"; + print STDOUT " -g check across all folders for uniqueness\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dS:L:Im:hpuM:HF:i:RA:F:r:g" ) ) { + usage(); + } + + ($host,$user,$pwd) = split(/\//, $opt_S); + $userList = $opt_i; + $mbxList = $opt_m; + $logfile = $opt_L; + $move2mbx = $opt_M; + $purge = 1 if $opt_p; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $use_date = 1 if $opt_u; + $md5_hash = 1 if $opt_H; + $recursive = 1 if $opt_R; + $global = 1 if $opt_g; + $keyfield = $opt_F; + $admin_user = $opt_A; + $msgs_per_folder = $opt_F; + $range = $opt_r; + + $keyfield = 'Message-ID' if !$keyfield; + + if ( $userList ) { + if ( !open(F, "<$userList") ) { + print STDERR "Error opening userlist $userList: $!\n"; + exit; + } + while( ) { + chomp; + push( @users, $_ ); + } + close F; + } else { + push( @users, "$user $pwd" ); + } + + usage() if $opt_h; + +} + +sub findMsg { + +my $conn = shift; +my $msgid = shift; +my $mbx = shift; +my $msgnum; + + Log("SELECT $mbx") if $debug; + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + } + + Log("Search for $msgid") if $debug; + sendCommand ( $conn, "1 SEARCH header Message-ID \"$msgid\""); + while (1) { + readResponse ($conn); + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msgnum) = split(/\* SEARCH /i, $response); + ($msgnum) = split(/ /, $msgnum); + } + + last if $response =~ /^1 OK/; + last if $response =~ /complete/i; + } + + return $msgnum; +} + +sub delete_duplicates { + +my $msglist = shift; +my $mbx = shift; +my $conn = shift; +my $rc; + + Log(" Deleting message list $msglist") if $debug; + + sendCommand ( $conn, "1 UID STORE $msglist +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msgs for delete") if $debug; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for the msglist: $response"); + $rc = 0; + last; + } + } + + expunge_mbx( $mbx, $conn ); + + return $rc; + +} + +sub expunge_mbx { + +my $mbx = shift; +my $conn = shift; + + Log("Expunging mailbox $mbx") if $debug; + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + print "Error purging messages: $response\n"; + last; + } + } + + Log(" $expunged messages expunged") if $debug; + +} + +sub updateFlags { + +my $conn = shift; +my $msgid = shift; +my $mbx = shift; +my $flags = shift; +my $rc; + + if ( $debug ) { + Log("Find $msgid"); + Log("flags $flags"); + } + + $msgnum = findMsg( $conn, $msgid, $mbx ); + Log("msgnum is $msgnum") if $debug; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS ($flags)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + Log(" Updated flags for $msgid"); + $rc = 1; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting flags for $msgid: $response"); + $rc = 0; + last; + } + } + return $rc; +} + +sub dieright { + local($sig) = @_; + print STDOUT "caught signal $sig\n"; + logout( $conn ); + exit(-1); +} + +sub sigprc { + + $SIG{'HUP'} = 'dieright'; + $SIG{'INT'} = 'dieright'; + $SIG{'QUIT'} = 'dieright'; + $SIG{'ILL'} = 'dieright'; + $SIG{'TRAP'} = 'dieright'; + $SIG{'IOT'} = 'dieright'; + $SIG{'EMT'} = 'dieright'; + $SIG{'FPE'} = 'dieright'; + $SIG{'BUS'} = 'dieright'; + $SIG{'SEGV'} = 'dieright'; + $SIG{'SYS'} = 'dieright'; + $SIG{'PIPE'} = 'dieright'; + $SIG{'ALRM'} = 'dieright'; + $SIG{'TERM'} = 'dieright'; + $SIG{'URG'} = 'dieright'; +} + +sub moveMsg { + +my $mbx = shift; +my $msgnum = shift; +my $dstmbx = shift; +my $conn = shift; +my $moved=0; + + # Move a message from one mailbox to another. + + return 0 unless $msgnum; + + Log(" Moving msgnum $msgnum to $dstmbx"); + + # Create the mailbox if it doesn't already exist + sendCommand ($conn, "1 CREATE \"$dstmbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|file exists|can\'t create/i)) { + ## print STDOUT "WARNING: $response\n"; + } + last; + } + } + + sendCommand ($conn, "1 COPY $msgnum \"$dstmbx\""); + while (1) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + $moved=1; + last; + } + if ($response =~ /^1 NO|^1 BAD/) { + Log("unexpected COPY response: $response"); + Log("Please verify that mailbox $dstmbx exists"); + exit; + } + } + + return $moved; +} + +sub hash { + +my $msg = shift; +my $body; +my $boundary; + + # Generate an MD5 hash of the message body + + # Strip the header and the MIME boundary markers + my $header = 1; + foreach $_ ( split(/\n/, $$msg ) ) { + if ( $header ) { + if (/boundary="(.+)"/i ) { + $boundary = $1; + } + $header = 0 if length( $_ ) == 1; + } + + eval 'next if /$boundary/ ); '; + $body .= "$_\n" unless $header; + } + + my $md5 = md5_hex($body); + Log("md5 hash $md5") if $debug; + + return $md5; +} + +sub fetchMsg { + +my $msgnum = shift; +my $conn = shift; +my $message = shift; + + Log(" Fetching msg $msgnum...") if $debug; + + sendCommand( $conn, "1 FETCH $msgnum body[text]"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; +my $msgcount; + + # Select the mailbox + + sendCommand( $conn, "1 SELECT \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /\* (.+) EXISTS/ ) { + $msgcount = $1; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to SELECT $mbx command: $response"); + last; + } + } + return $msgcount; + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub delete_duplicate_msgs { + +my $output_file = shift; +my $deletes = shift; +my $conn = shift; +my $uid; + + `sort $output_file > $sorted_file`; + if ( !open(S, "<$sorted_file")) { + Log("Fatal error: can't open $sorted_file: $!"); + exit; + } + + my $previous; + %$deletes = () unless $global; + + while( ) { + chomp; + ($key,$uid) = split(/\|\|\|/, $_); + if ( $debug ) { + Log(" key = $key uid = $uid"); + Log(" prev = $previous uid = $uid"); + } + + if ( $key eq $previous ) { + Log(" Found a duplicate, delete uid $uid") if $debug; + ($uid,$mbx) = split(/ /, $uid, 2); + $$deletes{"$mbx"} .= "$uid,"; + } + $previous = $key; + + } + + close S; + unlink $output_file if -e $output_file; + unlink $sorted_file if -e $sorted_file; + + if ( !$purge ) { + $n = keys %$deletes; + Log(" Would have deleted $n duplicates") if $n != 0; + return; + } + + my $mbxlist; + while(($mbx,$msglist) = each( %$deletes ) ) { + $msglist =~ s/,$//; + Log(" Duplicate messages $msglist"); + selectMbx( $mbx, $conn); + my @deletes = split(/,/, $msglist); + my $n = scalar @deletes; + Log(" Deleting $n duplicates"); + Log(" Deleting in batches of 500") if $n > 499; + + $i=0; + my $msglist; + foreach $_ ( @deletes ) { + $i++; + $total++; + $msglist .= "$_,"; + if ( $i == 500 or $i == scalar @deletes ) { + chop $msglist; + Log(" Expunging $i messages") if $debug; + delete_duplicates( $msglist, $mbx, $conn ); + + $msglist = ''; + $i=0; + } + } + } +} diff --git a/S/imap_tools.V1.333/delete_imap_mailboxes.pl b/S/imap_tools.V1.333/delete_imap_mailboxes.pl new file mode 100755 index 0000000..9ab3427 --- /dev/null +++ b/S/imap_tools.V1.333/delete_imap_mailboxes.pl @@ -0,0 +1,1304 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/delete_imap_mailboxes.pl,v 1.7 2014/10/17 15:23:46 rick Exp $ + +####################################################################### +####################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use MIME::Base64 qw(decode_base64 encode_base64); + + # Delete one or more mailboxes based on a regular expression supplied + # by the user. For example: + # + # -m "^thunder|^real|AA|^MOVED$|XXXX|zas" + # + # It is advisable to do a test-run first to make sure that the regex + # will select the desired mailbox before actually deleting them. Use + # the -t argument to select "show what would be deleted but don't delete + # it" mode. + + init(); + + # Get list of the user's mailboxes + # + connectToHost($sourceHost, \$src) or exit; + login($sourceUser,$sourcePwd, $src, $srcMethod) or exit; + namespace( $src, \$prefix, \$delim, $opt_x ); + + $filter = "$prefix" . $filter if $prefix; + + @mbxs = getMailboxList( $srcPrefix, $src ); + + # Sort the mailboxes to make sure we delete submailboxes first + + foreach $mbx ( reverse sort @mbxs ) { + Log("$mbx") if $debug; + if ( $mbx =~ /$filter/ ) { + # Log("$mbx matches $filter"); + } + # next if $nosel_mbxs{"$mbx"}; # We can delete NOSELECT mbxs + push( @deletes, $mbx ) if $mbx =~ /$filter/; + } + + foreach $mbx ( @deletes ) { + if ( $testmode ) { + Log("Would have deleted $mbx"); + } elsif ( uc( $mbx ) eq 'INBOX' ) { + # The INBOX cannot be deleted per IMAP standard so + # we will purge it of messages instead + Log("INBOX cannot be deleted, purging it instead"); + purge_mbx( 'INBOX', $src ); + } else { + delete_mailbox( $mbx, $src ); + } + } + + + logout( $src ); + + exit; + + +sub init { + + processArgs(); + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + exit; + } + select(LOG); $| = 1; + } + Log("$0 starting"); + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + + Log (">> $cmd") if $showIMAP; +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< $response") if $showIMAP;1 +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logfile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$str); + print LOG "$line"; + } + print STDOUT "$str\n" unless $quiet_mode; + +} + + +sub delete_mailbox { + +my $mbx = shift; +my $conn = shift; +my $error; + + # Create the mailbox if necessary + + return if uc( $mbx ) eq 'INBOX'; + + sendCommand ($conn, "1 DELETE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $error=1; + Log ("Error creating $mbx: $response"); + last; + } + + } + + unless ( $error ) { + Log("Successfully deleted $mbx"); + } + +} + +# Make a connection to a IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; +my $method = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + if ( uc( $method ) eq 'CRAM-MD5' ) { + # A CRAM-MD5 login is requested + Log("login method $method"); + my $rc = login_cram_md5( $user, $pwd, $conn ); + return $rc; + } + + # Otherwise do an ordinary login + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +sub login_cram_md5 { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + + Log("challenge $challenge") if $debug; + $response = cram_md5( $challenge, $user, $pwd ); + Log("response $response") if $debug; + + sendCommand ($conn, $response); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $prefix = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes",2) if $debugMode; + + if ( $mbxList ) { + foreach $mbx ( split(/,/, $mbxList) ) { + $mbx = $prefix . $mbx if $prefix; + if ( $opt_R ) { + # Get all submailboxes under the ones specified + $mbx .= '*'; + @mailboxes = listMailboxes( $mbx, $conn); + push( @mbxs, @mailboxes ); + } else { + push( @mbxs, $mbx ); + } + } + } else { + # Get all mailboxes + @mbxs = listMailboxes( '*', $conn); + } + + return @mbxs; +} + +# exclude_mbxs +# +# Exclude certain mailboxes from the list if the user +# has provided an exclude list with the -e argument + +sub exclude_mbxs { + +my $mbxs = shift; +my @new_list; +my %exclude; + + foreach my $exclude ( split(/,/, $excludeMbxs ) ) { + $exclude{"$exclude"} = 1; + } + foreach my $mbx ( @$mbxs ) { + next if $exclude{"$mbx"}; + push( @new_list, $mbx ); + } + + @$mbxs = @new_list; + +} + +# listMailboxes +# +# Get a list of the user's mailboxes +# +sub listMailboxes { + +my $mbx = shift; +my $conn = shift; + + sendCommand ($conn, "1 LIST \"\" \"$mbx\""); + undef @response; + while ( 1 ) { + &readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + &Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $mode = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; + + $mode = 'EXAMINE' unless $mode; + sendCommand ($conn, "1 $mode \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])"); + + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + @msgs = (); + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + # $response[$i] =~ /INTERNALDATE "(.+)" BODY/; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + # if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) { + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $msgnum && $date ) { + push (@$msgs,"$msgnum|$date|$flags"); + $msgnum = $date = ''; + } + } + + return 1; + +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub fetchMsg { + +my $msgnum = shift; +my $mbx = shift; +my $conn = shift; +my $message; + + Log(" Fetching msg $msgnum...") if $debug; + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + +sub usage { + + print STDOUT "usage: delete_imap_mailboxes.pl\n"; + print STDOUT " -S imapHost/user/password\n"; + print STDOUT " -m \n"; + print STDOUT " -t test mode, show what would have been deleted\n"; + print STDOUT " -d debug\n"; + print STDOUT " -I show IMAP protocol exchanges\n"; + print STDOUT " -L logfile\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dS:D:L:m:hIp:M:rqtx:y:e:Rt:TsA:" ) ) { + usage(); + } + + ($sourceHost,$sourceUser,$sourcePwd,$srcMethod) = split(/\//, $opt_S); + $filter = $opt_m; + $logfile = $opt_L; + $root_mbx = $opt_p; + $tags = $opt_T; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $timeout = 45; + $testmode = 1 if $opt_t; + $admin_user = $opt_A; + + usage() if $opt_h; + +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; + + # Some IMAP clients such as Outlook and Netscape) do not automatically list + # all mailboxes. The user must manually subscribe to them. This routine + # does that for the user by marking the mailbox as 'subscribed'. + + sendCommand( $conn, "1 SUBSCRIBE \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + Log("Mailbox $mbx has been subscribed") if $debug; + last; + } elsif ( $response =~ /^1 NO|^1 BAD|\^* BYE/i ) { + Log("Unexpected response to subscribe $mbx command: $response"); + last; + } + } + + # Now select the mailbox + sendCommand( $conn, "1 SELECT \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to SELECT $mbx command: $response"); + last; + } + } + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; +my $substChar = '_'; + + # Change the mailbox name if the user has supplied mapping rules. + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + $srcmbx =~ s/^$srcPrefix//; + $srcmbx =~ s/\\$srcDelim/\//g; + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + $dstmbx = $srcmbx; + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub flags { + +my $flags = shift; +my @newflags; +my $newflags; + + # Make sure the flags list contains standard + # IMAP flags and optionally custom tags + + return unless $flags; + + $flags =~ s/\\Recent//i; + foreach $_ ( split(/\s+/, $flags) ) { + push( @newflags, $_ ) if substr($_,0,1) eq '\\'; + if ( $opt_T ) { + # Include user-defined flags + push( @newflags, $_ ) if substr($_,0,1) eq '$'; + } + } + + $newflags = join( ' ', @newflags ); + + $newflags =~ s/\\Deleted//ig if $opt_r; + $newflags =~ s/^\s+|\s+$//g; + + return $newflags; +} + +sub map_mbx_names { + +my $mbx_map = shift; +my $srcDelim = shift; +my $dstDelim = shift; + + # The -M argument causes imapcopy to read the + # contents of a file with mappings between source and + # destination mailbox names. This permits the user to + # to change the name of a mailbox when copying messages. + # + # The lines in the file should be formatted as: + # : + # For example: + # Drafts/2008/Save: Draft_Messages/2008/Save + # Action Items: Inbox + # + # Note that if the names contain non-ASCII characters such + # as accents or diacritical marks then the Perl module + # Unicode::IMAPUtf7 module must be installed. + + return unless $mbx_map_fn; + + unless ( open(MAP, "<$mbx_map_fn") ) { + Log("Error opening mbx map file $mbx_map_fn: $!"); + exit; + } + $use_utf7 = 0; + while( ) { + chomp; + s/[\r\n]$//; # In case we're on Windows + s/^\s+//; + next if /^#/; + next unless $_; + ($srcmbx,$dstmbx) = split(/\s*:\s*/, $_); + + # Unless the mailbox name is entirely ASCII we'll have to use + # the Modified UTF-7 character set. + $use_utf7 = 1 unless isAscii( $srcmbx ); + $use_utf7 = 1 unless isAscii( $dstmbx ); + + $srcmbx =~ s/\//$srcDelim/g; + $dstmbx =~ s/\//$dstDelim/g; + + $$mbx_map{"$srcmbx"} = $dstmbx; + + } + close MAP; + + if ( $use_utf7 ) { + eval 'use Unicode::IMAPUtf7'; + if ( $@ ) { + Log("At least one mailbox map contains non-ASCII characters. This means you"); + Log("have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox "); + Log("names between the source and destination servers."); + print "At least one mailbox map contains non-ASCII characters. This means you\n"; + print "have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox\n"; + print "names between the source and destination servers.\n"; + exit; + } + } + + my %temp; + foreach $srcmbx ( keys %$mbx_map ) { + $dstmbx = $$mbx_map{"$srcmbx"}; + Log("Mapping src:$srcmbx to dst:$dstmbx"); + if ( $use_utf7 ){ + # Encode the name in Modified UTF-7 charset + $srcmbx = Unicode::IMAPUtf7::imap_utf7_encode( $srcmbx ); + $dstmbx = Unicode::IMAPUtf7::imap_utf7_encode( $dstmbx ); + } + $temp{"$srcmbx"} = $dstmbx; + } + %$mbx_map = %temp; + %temp = (); + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + +# Reconnect to the servers after a timeout error. +# +sub reconnect { + +my $checkpoint = shift; +my $conn = shift; + + Log("Attempting to reconnect"); + + my ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint); + + close $src; + close $dst; + + connectToHost($shost,\$src); + login($suser,$spwd,$src); + + connectToHost($dhost,\$dst); + login($duser,$dpwd,$dst); + + selectMbx( $mbx, $src ); + createMbx( $mbx, $dst ); # Just in case + +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } + Log("Resuming"); +} + +sub fixup_date { + +my $date = shift; + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + my $hrs = $2; + + return if length( $hrs ) == 2; + + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + +} + +sub purge_mbx { + +my $mbx = shift; +my $conn = shift; +my @msgs; + + # Remove all messages from a mailbox + + Log("Purging mailbox $mbx"); + getMsgList( $mbx, \@msgs, $conn, 'SELECT' ); + my $msgcount = $#msgs + 1; + Log("$mbx has $msgcount messages") if $debug; + + return if $msgcount == 0; # No messages to delete + + $range = "1:$msgcount"; + + deleteMsgs( $range, $conn ); + + expungeMbx( $mbx, $conn ); + +} + +sub deleteMsgs { + +my $range = shift; +my $conn = shift; +my $rc; + + sendCommand ( $conn, "1 STORE $range +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msgs $range for delete") if $debug; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msgs $range: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; + + Log("Expunging mailbox $mbx"); + + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /1 OK/i ); + } + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error purging messages: $response"); + last; + } + } + + $totalExpunged += $expunged; + + Log("$expunged messages expunged") if $debug; + +} + +sub cram_md5 { + +my $challenge = shift; +my $user = shift; +my $password = shift; + +eval 'use Digest::HMAC_MD5 qw(hmac_md5_hex)'; +use MIME::Base64 qw(decode_base64 encode_base64); + + # Adapated from script by Paul Makepeace , 2002-10-12 + # Takes user, key, and base-64 encoded challenge and returns base-64 + # encoded CRAM. See, + # IMAP/POP AUTHorize Extension for Simple Challenge/Response: + # RFC 2195 http://www.faqs.org/rfcs/rfc2195.html + # SMTP Service Extension for Authentication: + # RFC 2554 http://www.faqs.org/rfcs/rfc2554.html + # Args: tim tanstaaftanstaaf PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+ + # should yield: dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw + + my $challenge_data = decode_base64($challenge); + my $hmac_digest = hmac_md5_hex($challenge_data, $password); + my $response = encode_base64("$user $hmac_digest"); + chomp $response; + + if ( $debug ) { + Log("Challenge: $challenge_data"); + Log("HMAC digest: $hmac_digest"); + Log("CRAM Base64: $response"); + } + + return $response; +} + diff --git a/S/imap_tools.V1.333/dumptoIMAP.pl b/S/imap_tools.V1.333/dumptoIMAP.pl new file mode 100755 index 0000000..069b65f --- /dev/null +++ b/S/imap_tools.V1.333/dumptoIMAP.pl @@ -0,0 +1,924 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/dumptoIMAP.pl,v 1.14 2014/11/10 12:55:43 rick Exp $ + +####################################################################### +# dumptoIMAP.pl is used to load the mailboxes and messages exported # +# from an IMAP server by the imapdump.pl script. See usage() notes # +# for a list of the arguments used to run it. # +# # +# If you ran imapdump.pl -S host/user/pwd -f /tmp/BACKUP # +# then you could restore all of the mailboxes & messages with the # +# following command: # +# # +# ./dumptoIMAP.pl -i host/user/pwd -D /tmp/BACKUP # +# # +# If you wanted to restore just the INBOX and the Sent mailboxes you # +# would add -m "INBOX,Sent" # +####################################################################### + +use Socket; +use IO::Socket; +use FileHandle; +use File::Find; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw(decode_base64 encode_base64); + +init(); + +connectToHost($imapHost, \$conn); + +if ( $imapUser =~ /(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + $imapUser = $1; + $authuser = $2; + login_plain( $imapUser, $authuser, $imapPwd, $conn ) or exit; +} else { + if ( !login($imapUser,$imapPwd, $conn) ) { + Log("Check your username and password"); + print STDOUT "Login failed: Check your username and password\n"; + exit; + } +} + +if ( $opt_y ) { + # User-supplied mbx delimiter and prefix + ($mbx_delim,$prefix) = split(/\s+/, $opt_y ); +} else { + namespace( $conn, \$prefix, \$mbx_delim ); +} + +get_mbx_list( $dir, \@mbxs ); + +foreach $mbx ( @mbxs ) { + $copied=0; + Log("mbx = >$mbx<") if $debug; + Log("Full path to $mbx is >$dir/$mbx<") if $debug; + + Log("Copying messages from $dir/$mbx to $mbx folder on the IMAP server"); + get_messages( "$dir/$mbx", \@msgs ); + $n = scalar @msgs; + Log("$mbx has $n messages"); + + $mbx =~ s/\//$mbx_delim/g unless $mbx_delim eq '/'; + if ( $prefix ) { + $mbx = $prefix . $mbx unless $mbx =~ /^INBOX/i; + } + + foreach $_ ( @msgs ) { + next unless $_; + my $msg; my $date; my $seen; + + $flags = ''; + if ( /,S$/ ) { + $flags = '\\SEEN'; + } + + Log("Opening $_") if $debug; + unless ( open(F, "<$_") ) { + Log("Error opening $_: $!"); + next; + } + Log("Opened $_ successfully") if $debug; + while( ) { + # Log("Reading line $_") if $debug; + if ( /^Date: (.+)/ ) { + $date = $1 unless $date; + $date =~ s/\r|\m//g; + chomp $date; + } + s/\r+$//g; + $msg .= $_; + chomp $msg; + $msg .= "\r\n"; + + } + close F; + + $size = length( $msg ); + Log("The message is $size bytes") if $debug; + # Log("$msg") if $debug; + + if ( $size == 0 ) { + Log("The message file is empty") if $debug; + next; + } + + $copied++ if insertMsg($mbx, \$msg, $flags, $date, $conn); + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $copied == $msgs_per_folder; + } + + if ( $copied/100 == int($copied/100)) { Log("$copied messages copied "); } + } + $total += $copied; + +} + +logout( $conn ); + +Log("Done. $total messages were copied."); +exit; + + +sub init { + + if ( !getopts('m:L:i:dD:Ix:XRA:F:y:') ) { + usage(); + } + + $mbx_list = $opt_m; + $dir = $opt_D; + $logfile = $opt_L; + $extension = $opt_x; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $admin_user = $opt_A; + $msgs_per_folder = $opt_F; + ($imapHost,$imapUser,$imapPwd) = split(/\//, $opt_i); + + if ( $logfile ) { + if ( ! open (LOG, ">> $logfile") ) { + print "Can't open logfile $logfile: $!\n"; + $logfile = ''; + } + } + Log("Starting"); + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } +} + + + +sub usage { + + print "Usage: dumptoIMAP.pl\n"; + print " -D \n"; + print " -i \n"; + print " (if the password is an OAUTH2 token then prefix it with 'oauth2:'\n"; + print " [-A \n"; + print " [-m copy only the listed mailboxes]\n"; + print " [-x Import only files with this extension\n"; + print " [-L ]\n"; + print " [-d debug]\n"; + print " [-I log IMAP protocol exchanges]\n"; + +} + +sub get_messages { + +my $dir = shift; +my $msgs = shift; + + # Get a list of the message files + + if ( $debug ) { + Log("Get list of messages in $dir"); + } + + opendir D, $dir; + my @files = readdir( D ); + closedir D; + foreach $_ ( @files ) { + next if /^\./; + if ( $extension ) { + next unless /$extension$/; + } + Log(" $dir/$_") if $debug; + push( @$msgs, "$dir/$_"); + } +} + +# Print a message to STDOUT and to the logfile if +# the opt_L option is present. +# + +sub Log { + +my $line = shift; +my $msg; + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time); + $msg = sprintf ("%.2d-%.2d-%.4d.%.2d:%.2d:%.2d %s", + $mon + 1, $mday, $year + 1900, $hour, $min, $sec, $line); + + if ( $logfile ) { + print LOG "$msg\n"; + } + print STDOUT "$line\n"; + +} + +# connectToHost +# +# Make an IMAP connection to a host +# +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + $sockaddr = 'S n a4 x8'; + ($name, $aliases, $proto) = getprotobyname('tcp'); + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + if ($host eq "") { + Log ("no remote host defined"); + close LOG; + exit (1); + } + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + + select( $$conn ); $| = 1; + return 1; +} + +# +# login in at the IMAP host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + Log("Logging in as $user") if $debug; + $rsn = 1; + sendCommand ($conn, "$rsn LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + if ($response =~ /^$rsn OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + exit; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log(">>$response") if $showIMAP; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + Log(">>$cmd") if $showIMAP; +} + +# +# insertMsg +# +# Append a message to an IMAP mailbox +# + +sub insertMsg { + +my $mbx = shift; +my $message = shift; +my $flags = shift; +my $date = shift; +my $conn = shift; +my ($lsn,$lenx); + + Log(" Inserting message") if $debug; + $lenx = length($$message); + + # Log("$$message"); + + ($date) = split(/\s*\(/, $date); + if ( $date =~ /,/ ) { + $date =~ /(.+),\s+(.+)\s+(.+)\s+(.+)\s+(.+)\s+(.+)/; + $date = "$2-$3-$4 $5 $6"; + } else { + $date =~ s/\s/-/; + $date =~ s/\s/-/; + } + + # Create the mailbox unless we have already done so + ++$lsn; + if ($destMbxs{"$mbx"} eq '') { + sendCommand ($conn, "$lsn CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$rsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|reserved mailbox name/i)) { + Log ("WARNING: $response"); + } + last; + } + } + } + $destMbxs{"$mbx"} = '1'; + + $flags =~ s/\\Recent//i; + + if ( $date ) { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + } else { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \{$lenx\}"); + } + readResponse ($conn); + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response to $cmd"); + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + if ( $opt_X ) { + print $conn "$$message\n"; + } else { + print $conn "$$message\r\n"; + } + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + return 0; + } + } + + return 1; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the IMAP host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + Log("Getting list of msgs in $mailbox") if $debug; + trim( *mailbox ); + sendCommand ($conn, "$rsn EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^$rsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + sendCommand ( $conn, "$rsn FETCH 1:* (uid flags internaldate body[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^$rsn OK/i ) { + last; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID / ) { + $response[$i] =~ /\* ([^FETCH \(UID]*)/; + $msgnum = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//i; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + ### $response[$i] =~ /INTERNALDATE (.+) ([^BODY]*)/i; + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Message-Id:/i ) { + ($label,$msgid) = split(/: /, $response[$i]); + push (@$msgs,$msgid); + } + } +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +sub get_mbx_list { + +my $dir = shift; +my $mbxs = shift; +my %MBXS; + + if ( $mbx_list ) { + # The user has supplied a list of mailboxes. + @$mbxs = split(/,/, $mbx_list ); + return; + } + + @dirs = (); + push( @dirs, $dir ); + @messages = (); + find( \&findMsgs, @dirs ); # Returns @messages + foreach $fn ( @messages ) { + Log("fn = $fn") if $debug; + $fn =~ s/$dir//; + Log("fn = $fn") if $debug; + $i = rindex($fn,'/'); + Log("find rightmost slash, i = $i") if $debug; + if ( $fn =~ /^\// ) { + $mbx = substr($fn,1,$i); + } else { + $mbx = substr($fn,0,$i); + } + Log("mbx = $mbx") if $debug; + $mbx =~ s/\/$//; + Log("mbx = >$mbx<") if $debug; + push( @$mbxs, $mbx ) if !$MBXS{"$mbx"}; + Log("Add >$mbx< to the list of mailboxes") if $debug; + $MBXS{"$mbx"} = 1; + } +} + +sub findMsgs { + + return if not -f; + + my $fn = $File::Find::name; + push( @messages, $fn ); + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + Log("Cannot determine the mailbox delimiter and prefix. Use -y '' to supply it"); + exit; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; +my $substChar = '_'; + + if ( $public_mbxs ) { + my ($public_src,$public_dst) = split(/:/, $public_mbxs ); + # If the mailbox starts with the public mailbox prefix then + # map it to the public mailbox destination prefix + + if ( $srcmbx =~ /^$public_src/ ) { + Log("src: $srcmbx is a public mailbox") if $debug; + $dstmbx = $srcmbx; + $dstmbx =~ s/$public_src/$public_dst/; + Log("dst: $dstmbx") if $debug; + return $dstmbx; + } + } + + # Change the mailbox name if the user has supplied mapping rules. + + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + $srcmbx =~ s/^$srcPrefix//; + $srcmbx =~ s/\\$srcDelim/\//g; + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + # $dstmbx = $srcmbx; + if ( lc( $srcmbx ) eq 'inbox' ) { + $dstmbx = $srcmbx; + } else { + $dstmbx = $srcPrefix . $srcmbx; + } + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + diff --git a/S/imap_tools.V1.333/flag_de.gif b/S/imap_tools.V1.333/flag_de.gif new file mode 100644 index 0000000..1142554 Binary files /dev/null and b/S/imap_tools.V1.333/flag_de.gif differ diff --git a/S/imap_tools.V1.333/flag_en.gif b/S/imap_tools.V1.333/flag_en.gif new file mode 100644 index 0000000..29cbe9c Binary files /dev/null and b/S/imap_tools.V1.333/flag_en.gif differ diff --git a/S/imap_tools.V1.333/imapCapability.pl b/S/imap_tools.V1.333/imapCapability.pl new file mode 100755 index 0000000..a303805 --- /dev/null +++ b/S/imap_tools.V1.333/imapCapability.pl @@ -0,0 +1,502 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imapCapability.pl,v 1.9 2014/10/15 21:42:58 rick Exp $ + +########################################################################### +# Program name imapCapability.pl # +# Written by Rick Sanders # +# Date 23 December 2007 # +# # +# Description # +# # +# imapCapability.pl is a simple program for querying an IMAP # +# server for a list of the IMAP features it supports. # +# # +# Description # +# # +# imapCapability is used to discover what services an IMAP # +# server supports. # +# # +# Usage: imapCapability.pl -h -u -p # +# Optional arguments: -d (debug) -m (list folders) # +# # +# Sample output: # +# The server supports the following IMAP capabilities: # +# # +# IMAP4 IMAP4REV1 ACL NAMESPACE UIDPLUS IDLE LITERAL+ QUOTA # +# ID MULTIAPPEND LISTEXT CHILDREN BINARY LOGIN-REFERRALS # +# UNSELECT STARTTLS AUTH=LOGIN AUTH=PLAIN AUTH=CRAM-MD5 # +# AUTH=DIGEST-MD5 AUTH=GSSAPI AUTH=MSN AUTH=NTLM # +########################################################################### + +############################################################################ +# Copyright (c) 2012 Rick Sanders # +# # +# Permission to use, copy, modify, and distribute this software for any # +# purpose with or without fee is hereby granted, provided that the above # +# copyright notice and this permission notice appear in all copies. # +# # +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # +############################################################################ + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +eval 'use Encode qw/encode decode/'; +eval 'use Encode::IMAPUTF7 qw/encode decode/'; +use MIME::Base64 qw(encode_base64 decode_base64); + +################################################################# +# Main program. # +################################################################# + + ($host,$user,$pwd) = getArgs(); + + unless ( $host and $user and $pwd ) { + print "Host:Port > "; + chomp($host = <>); + print "Username > "; + chomp($user = <>); + print "Password > "; + chomp($pwd = <>); + } + + unless ( $host and $user and $pwd ) { + print "Please supply host, username, and password\n"; + exit; + } + + init(); + + connectToHost($host, \$conn) or exit; + login($user,$pwd, $conn) or exit; + capability( $conn ); + + if ( $list_mbxs ) { + print STDOUT "\nList of mailboxes for $user:\n\n"; + @mbxs = listMailboxes( $conn ); + + foreach $mbx ( @mbxs ) { + $mbx1 = decode( 'IMAP-UTF-7', $mbx ); + if ( $mbx eq $mbx1 ) { + print STDOUT " $mbx\n"; + } elsif( $utf7_installed ) { + print STDOUT " $mbx ($mbx1)\n"; + } else { + print STDOUT " $mbx\n"; + } + } + } + logout( $conn ); + +sub init { + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + $utf7_installed = 1; + eval 'use Encode::IMAPUTF7 qw/decode/'; + if ( $@ ) { + $utf7_installed = 0; + } +} + +sub getArgs { + + getopts( "h:u:p:dmA:I" ); + $host = $opt_h; + $user = $opt_u; + $pwd = $opt_p; + $debug = $opt_d; + $admin_user = $opt_A; + $list_mbxs = 1 if $opt_m; + $showIMAP = 1 if $opt_I; + + if ( $admin_user ) { + # Don't need user password + $pwd = 'XXXX'; + } + + if ( $opt_H ) { + usage(); + } + + if ( !$host or !$user or !$pwd ) { + usage(); + } + + return ($host,$user,$pwd); + +} + +sub usage { + + print STDOUT "usage: imapCapability.pl -h -u -p \n"; + print STDOUT " Option argument: -m (list mailboxes)\n"; + exit; + +} + + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + print "Attempting an SSL connection\n" if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + print "Error connecting to $host: $error\n"; + exit; + } + } else { + # Non-SSL connection + print "Attempting a non-SSL connection\n" if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + print "Error connecting to $host:$port: $@\n"; + warn "Error connecting to $host:$port: $@"; + exit; + } + } + print "Connected to $host on port $port\n"; + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + + +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + sendCommand ($conn, "1 LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD/i) { + print "Unexpected LOGIN response: $response\n"; + return 0; + } + } + print "Logged in as $user\n" if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +sub capability { + +my $conn = shift; +my @response; +my $capability; + + sendCommand ($conn, "1 CAPABILITY"); + while (1) { + readResponse ( $conn ); + $capability = $response if $response =~ /\* CAPABILITY/i; + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD/i) { + print "Unexpected response: $response\n"; + return 0; + } + } + + print STDOUT "\nThe server supports the following IMAP capabilities:\n\n"; + $capability =~ s/^\* CAPABILITY //; + print "$capability\n"; + +} + +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + print "Unexpected LOGOUT response: $response\n"; + last; + } + } + close $conn; + return; +} + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + print STDOUT "$cmd\n" if $showIMAP; +} + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + print STDOUT "$response\n" if $showIMAP; +} + + +# listMailboxes +# +# Get a list of the user's mailboxes +# +sub listMailboxes { + +my $conn = shift; + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + &readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + &Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub Log { + +my $str = shift; + + print STDERR "$str\n"; + +} diff --git a/S/imap_tools.V1.333/imapPing.pl b/S/imap_tools.V1.333/imapPing.pl new file mode 100755 index 0000000..d021a00 --- /dev/null +++ b/S/imap_tools.V1.333/imapPing.pl @@ -0,0 +1,488 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imapPing.pl,v 1.3 2013/09/30 14:27:38 rick Exp $ + +############################################################################ +# Program imapPing.pl # +# Date 20 January 2008 # +# # +# Description # +# # +# This script performs some basic IMAP operations on a user's # +# account and displays the time as each one is executed. The # +# operations are: # +# 1. Connect to the IMAP server # +# 2. Log in with the user's name and password # +# 3. Get a list of mailboxes in the user's account # +# 4. Select the INBOX # +# 5. Get a list of messages in the INBOX # +# 6. Log off the server # +# # +# Usage: imapPing.pl -h -u -p # +# # +############################################################################ +# Copyright (c) 2008 Rick Sanders # +# # +# Permission to use, copy, modify, and distribute this software for any # +# purpose with or without fee is hereby granted, provided that the above # +# copyright notice and this permission notice appear in all copies. # +# # +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # +############################################################################ + +use Getopt::Std; +use Socket; +use FileHandle; +use Fcntl; +use IO::Socket; +use MIME::Base64 qw(encode_base64); + + init(); + ($host,$user,$pwd) = getArgs(); + + print STDOUT pack( "A35 A10", "Connecting to $host", getTime() ); + connectToHost( $host, \$conn ); + + print STDOUT pack( "A35 A10","Logging in as $user", getTime() ); + login( $user,$pwd, $conn ); + + print STDOUT pack( "A35 A10","Get list of mailboxes", getTime() ); + getMailboxList( $conn ); + + print STDOUT pack( "A35 A10","Selecting the INBOX", getTime() ); + selectMbx( 'INBOX', $conn ) if $rc; + + print STDOUT pack( "A35 A10","Get list of msgs in INBOX", getTime() ); + getMsgList( 'INBOX', $conn ); + + print STDOUT pack( "A35 A10","Logging out", getTime() ); + logout( $conn ); + + print STDOUT pack( "A35 A10","Done", getTime() ); + + exit; + + exit 1; + + +sub init { + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + getTime(); + $debug = 1; +} + +sub getTime { + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $date = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d \n", + $mon+1,$mday,$year+$yr,$hour,$min,$sec); + $time = sprintf ("%.2d:%.2d:%.2d \n",$hour,$min,$sec); + + return $time; +} + +sub getArgs { + + getopts( "h:u:p:A:" ); + $host = $opt_h; + $user = $opt_u; + $pwd = $opt_p; + $admin_user = $opt_A; + $showIMAP = 1 if $opt_I; + + if ( $opt_H ) { + usage(); + } + + if ( $admin_user ) { + $pwd = 'XXX'; # Don't need the user's password + } + + unless ( $host and $user and $pwd ) { + usage(); + exit; + } + + + return ($host,$user,$pwd); + +} + +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + print STDOUT ">> $cmd\n" if $showIMAP; +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + print STDOUT "<< $response\n" if $showIMAP; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + warn "Error connecting to $host:$port: $@"; + exit; + } + } + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + sendCommand ($conn, "1 LOGIN $user $pwd"); + while (1) { + readResponse ($conn); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response !~ /^\*/) { + print STDOUT "Unexpected login response $response\n"; + return 0; + } + } + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + + +# logout +# +# log out from the source host +# +sub logout { + +my $conn = shift; + + # print STDOUT "Logging out\n" if $debug; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + print STDOUT "unexpected LOGOUT response: $response\n"; + last; + } + } + close $conn; + + return; + +} + + +sub usage { + + print STDOUT "\nUsage: imapPing.pl \n\n"; + print STDOUT " -h \n"; + print STDOUT " -u \n"; + print STDOUT " -p \n"; + + exit; + +} + + +sub selectInbox { + +my $mbx = shift; +my $conn = shift; + + # Select a mailbox + + sendCommand ($conn, "1 SELECT $mbx"); + while (1) { + readResponse ($conn); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response !~ /^\*/) { + print STDOUT "Unexpected SELECT INBOX response: $response\n"; + return 0; + } + } + +} + +sub getMailboxList { + +my $conn = shift; + + # Get a list of the user's mailboxes + + sendCommand ($conn, "1 LIST \"\" *"); + @response = (); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + + if ( $response !~ /^\*/ ) { + print STDOUT "unexpected response: $response\n"; + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + # print STDERR "$response[$i]\n"; + $response[$i] =~ s/\s+/ /; + ($dmy,$mbx) = split(/"\/"/,$response[$i]); + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + $mbx =~ s/"//g; + + if ($mbx =~ /^\#/) { + # Skip public mbxs + next; + } + + if ($mbx ne '') { + push(@mbxs,$mbx); + } + } + + return 1; +} + +sub getMsgList { + +my $mailbox = shift; +my $conn = shift; + + # Select the mailbox in read-only mode + + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ($conn); + + last if $response =~ /^1 OK/i; + + if ( $response !~ /^\*/ ) { + print STDOUT "Error: $response\n"; + return 0; + } + } + + sendCommand ($conn, "1 FETCH 1:* (UID FLAGS)"); + undef @response; + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response !~ /^\*/ ) { + print STDOUT "Unexpected response: $response\n"; + return 0; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + for $i (0 .. $#response) { + $_ = $response[$i]; + $_ =~ /\* ([^FETCH]*)/; + $uid = $1; + $uid =~ s/\s+$//; + if ($response[$i] =~ /\\Seen/) { $seen = 1; } + if (($uid ne 'OK') && ($uid ne '')) { + push (@msgs,"$uid $seen"); + } + } + return 1; +} diff --git a/S/imap_tools.V1.333/imap_audit.pl b/S/imap_tools.V1.333/imap_audit.pl new file mode 100755 index 0000000..bb9e29b --- /dev/null +++ b/S/imap_tools.V1.333/imap_audit.pl @@ -0,0 +1,1913 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imap_audit.pl,v 1.21 2015/06/15 15:34:50 rick Exp $ + +####################################################################### +# imap_audit is used to compare the contents of a user's account on # +# one IMAP server with an account on another IMAP server. It is # +# often useful after migrating a user to another server to ensure # +# that all messages were successfully copied. # +# # +# See usage() for the command-line arguments # +####################################################################### + +use Socket; +use IO::Socket; +use IO::Socket::INET; +use FileHandle; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw( encode_base64 decode_base64 ); + +init(); + +foreach $user ( @users ) { + $user =~ s/oauth2:/oauth2---/g; + ($sourceUser,$sourcePwd,$destUser,$destPwd) = split(/:/, $user); + Log("Auditing $sourceUser"); + + # Get list of all messages on the source host by Message-Id + # + connectToHost($sourceHost, \$src) or exit; + if ( $kerio_src_master_pwd ) { + next unless kerio_master_login( $kerio_src_master_pwd, $sourceUser, $src ); + } elsif ( $src_admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + next unless login_plain( $sourceUser, $src_admin_user, $src ); + } else { + # Otherwise do an ordinary login + next unless login($sourceUser,$sourcePwd, $src); + } + + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + + connectToHost( $destHost, \$dst ) or exit; + if ( $kerio_dst_master_pwd ) { + next unless kerio_master_login( $kerio_dst_master_pwd, $destUser, $dst ); + } elsif ( $dst_admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + next unless login_plain( $destUser, $dst_admin_user, $dst ); + } else { + # Otherwise do an ordinary login + next unless login($destUser,$destPwd, $dst); + } + namespace( $dst, \$dstPrefix, \$dstDelim, $opt_x ); + + my @source_mbxs = getMailboxList( $src ); + + # Exclude certain ones if that's what the user wants + exclude_mbxs( \@source_mbxs ) if $excludeMbxs; + + map_mbx_names( \%mbx_map, $srcDelim, $dstDelim ); + + # Check for missing messages + check( \@source_mbxs, \%REVERSE, $src, $dst ); + + if ( $msg_counts ) { + Log("$missing"); + } + + logout( $src ); + logout( $dst ); + +} + +exit; + +sub init { + + $os = $ENV{'OS'}; + + processArgs(); + + if ( $users_file ) { + ($sourceHost) = split(/\//, $opt_S); + ($destHost) = split(/\//, $opt_D); + if ( !open(U, "<$users_file") ) { + print STDERR "Error opening users file $users_file: $!\n"; + exit; + } + my $n; + while( ) { + $n++; + s/^\s+//g; + next if /^#/; + chomp; + next unless $_; +if ( 0 ) { + if ( !/(.+):(.+):(.+):(.+)/ ) { + print STDERR "Error at line $n in users file\n"; + print STDERR "Not in srcuser:srcpwd:dstuser:dstpwd format\n"; + exit; + } +} + push( @users, $_ ); + } + close U; + + } else { + ($sourceHost,$sourceUser,$sourcePwd) = split(/\//, $opt_S); + ($destHost, $destUser, $destPwd) = split(/\//, $opt_D); + push( @users, "$sourceUser:$sourcePwd:$destUser:$destPwd" ); + } + + $timeout = 60 unless $timeout; + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">>$logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + # select(LOG); $| = 1; + } + Log("$0 starting\n"); + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + validate_date( $before_date ) if $before_date; + validate_date( $after_date ) if $after_date; + + Log("Generating dummy message-ids for each message") if $generate_msgids; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } + + if ( $response =~ /^\* BYE/ ) { + # Log("The server closed the connection: $response "); + # exit; + } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logfile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } + print STDOUT "$str\n"; + + # print STDOUT "$str\n" if $opt_Q; + +} + +# insertMsg +# +# This routine inserts an RFC822 messages into a user's folder +# + +sub insertMsg { + +local ($conn, $mbx, *message, $flags, $date, $msgid) = @_; +local ($lenx); + + Log("Inserting message $msgid") if $debug; + $lenx = length($message); + $totalBytes = $totalBytes + $lenx; + $totalMsgs++; + + $flags = flags( $flags ); + fixup_date( \$date ); + + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + readResponse ($conn); + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: $response"); + # next; + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$message\r\n"; + + undef @response; + my $i; + while ( 1 ) { + readResponse ($conn); + last if $i++ > 9999999; + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + # next; + return 0; + } + } + + return 1; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $verbose; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $verbose; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + exit; + } + } + Log("Connected to $host on port $port") if $verbose; + + return 1; +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$pwd) = split(/:/, $admin_user); + ($user) = split(/:/, $user); + my $status = login_plain( $user, $authuser, $pwd, $conn ); + return $status; + } + + if ( $pwd =~ /^oauth2---(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + # Otherwise do a normal login + + unless ( $user and $pwd ) { + Log("You must supply both user and password in the users file (user:pwd)"); + return 0; + } + + sendCommand ($conn, "1 LOGIN \"$user\" \"$pwd\""); + my $i; + while (1) { + readResponse ( $conn ); + last if $i++ > 9999; + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /NO|BYE|BAD/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + my ($admin_user,$pwd) = split(/:/, $admin, 2); + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin_user,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + return 1; + +} + + + +sub kerio_master_login { + +my $pwd = shift; +my $user = shift; +my $conn = shift; + + sendCommand ($conn, "1 X-MASTERAUTH"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + my $string = $challenge . $pwd; + my $challenge_response = md5_hex( $string ); + + if ( $debug ) { + Log("challenge $challenge"); + Log("pwd $pwd"); + Log("sending $challenge_response"); + } + + sendCommand ($conn, $challenge_response); + my $loops; + while (1) { + last if $loops++ > 9; + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("Failed to login as Kerio Master: unexpected LOGIN response: $response"); + exit; + } + } + + # Select the user + + Log("Selecting user $user") if $debug; + sendCommand ($conn, "1 X-SETUSER \"$user\"" ); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + Log("$user has been selected") if $debug; + + return 1; +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + my $i; + while ( 1 ) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $conn = shift; +my $delim = shift; +my @mbxs; +my @mailboxes; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + foreach $mbx ( @mbxs ) { + # trim( *mbx ); + push( @mailboxes, $mbx ); + } + return @mailboxes; + } + + Log("Get list of mailboxes") if $verbose; + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + my $i; + while ( 1 ) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + if ($mbx =~ /^\#|^Public Folders/i) { + # Skip public mbxs + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# exclude_mbxs +# +# Exclude certain mailboxes from the list if the user +# has provided an exclude list with the -e argument + +sub exclude_mbxs { + +my $mbxs = shift; +my @new_list; +my %exclude; + + foreach my $exclude ( split(/,/, $excludeMbxs ) ) { + $exclude{"$exclude"} = 1; + } + foreach my $mbx ( @$mbxs ) { + next if $exclude{"$mbx"}; + push( @new_list, $mbx ); + } + + @$mbxs = @new_list; + +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# + +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $msgid; +my $count; + + # Get a list of the msgs in this mailbox + + @$msgs = (); + trim( *mailbox ); + return if $mailbox eq ""; + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + my $i; + while ( 1 ) { + readResponse ( $conn ); + last if $i++ > 9999; + if ( $response =~ / (.+) EXISTS/i ) { + $count = $1; + $empty=1 if $count == 0; + } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + return $count if $msg_counts; + return if $empty; + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date Message-ID Subject)])"); + undef @response; + my $nulls; + my $i; + while ( 1 ) { + readResponse ( $conn ); + last if $i++ > 99999; + if ( $response eq '' ) { + $nulls++; + last if $nulls > 9999; + } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + last if $response =~ /^1 NO|^1 BAD/; + } + + @$msgs = (); + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent|\\Forwarded//ig; + } + + # Consider the < and > to be part of the message-id. + # if ( $response[$i] =~ /^Message-ID:\s*(.+)/i ) { + + if ( $response[$i] =~ /^Message-ID:\s*(.*)/i ) { + $msgid = $1; + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + $msgid =~ s/^\s+|\s+$;//g; + if ( $msgid =~ /imapsync$/ ) { + # The msgid was inserted by Gilles Lamiral's imapsync tool + # while being copied to the destination. That interferes + # with imap_audit's checking. Blank it out so a dummy msgid + # will be generated. + $msgid = ''; + } + } + + if ( $response[$i] =~ /^Subject:\s*(.+)/i ) { + $subject = $1; + } + + if ( $response[$i] =~ /^From:\s*(.+)/i ) { + $from = $1; + } + + if ( $response[$i] =~ /^Date:\s*(.+)/i ) { + $header_date = $1; + check_date( \$header_date ); + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + if ( $msgid eq '' or $generate_msgids ) { + # The msg lacks a msgid + $msgid = build_dummy_msgid( $header_date, $subject, $from ); + } + push (@$msgs,"$msgid\t$subject"); + $msgnum=$msgid=$date=$flags=$subject=$from=$header_date=''; + } + } +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; +my $created; + + # Create the mailbox if necessary + + sendCommand ($conn, "1 CREATE \"$mbx\""); + my $i; + while ( 1 ) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /^1 OK/i ) { + $created = 1; + last; + } + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD/ ) { + Log ("Error creating $mbx: $response"); + last; + } + + } + Log("Created mailbox $mbx") if $created; +} + +sub fetchMsg { + +my $msgnum = shift; +my $conn = shift; +my $message; + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Unexpected FETCH response: $response"); + return ''; + } + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$dstMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$dstMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + +sub fetchMsgFlags { + +my $msgnum = shift; +my $conn = shift; +my $flags; + + # Read the IMAP flags for a message + + sendCommand( $conn, "1 FETCH $msgnum (flags)"); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /^1 OK|^1 BAD|^1 NO/i ) { + last; + } + if ( $response =~ /\* $msgnum FETCH \(FLAGS \((.+)\)\)/i ) { + $flags = $1; + Log(" $msgnum - flags $flags") if $verbose; + } + } + + return $flags; +} + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " imap_audit.pl -S sourceHost/sourceUser/sourcePassword\n"; + print STDOUT " -D destHost/destUser/destPassword\n"; + print STDOUT " -d debug\n"; + print STDOUT " -I show IMAP commands/responses\n"; + print STDOUT " -E \n"; + print STDOUT " -F \n"; + print STDOUT " -a \n"; + print STDOUT " -c \n"; + print STDOUT " -L logfile\n"; + print STDOUT " -u format srcuser:srcpwd:dstuser:dstpwd\n"; + print STDOUT " -B \n"; + print STDOUT " -A \n"; + print STDOUT " [-m comma-separated list of mbxs to check]\n"; + print STDOUT " [-n compare only mailbox msg counts]\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dvE:F:S:D:L:m:e:hIx:y:FM:s:nNQu:A:B:gnRa:c:" ) ) { + usage(); + } + + $mbxList = $opt_m; + $excludeMbxs = $opt_e; + $logfile = $opt_L; + $mbx_map_fn = $opt_M; + $sync_since = $opt_s; + $users_file = $opt_u; + $before_date = $opt_B; + $after_date = $opt_A; + $src_admin_user = $opt_E; + $dst_admin_user = $opt_F; + $kerio_src_master_pwd = $opt_a; + $kerio_dst_master_pwd = $opt_c; + $debug = 1 if $opt_d; + $verbose = 1 if $opt_v; + $showIMAP = 1 if $opt_I; + $generate_msgids = 1 if $opt_g; + # opt_N is deprecated + $include_nosel_mbxs = 1 if $opt_N; + $include_msgid =1 if $opt_R; + $msg_counts = 1 if $opt_n; + + usage() if $opt_h; + if ( $kerio_src_master_pwd or $kerio_dst_master_pwd ) { + use Digest::MD5 qw(md5_hex); + } + +} + +sub findMsg { + +my $msgid = shift; +my $conn = shift; +my $msgnum; + + # Search a mailbox on the server for a message by its msgid. + + Log(" Search for $msgid") if $verbose; + sendCommand ( $conn, "1 SEARCH header Message-Id \"$msgid\""); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msgnum) = split(/\* SEARCH /i, $response); + ($msgnum) = split(/ /, $msgnum); + } + + last if $response =~ /^1 OK|^1 NO|^1 BAD/; + last if $response =~ /complete/i; + } + + if ( $verbose ) { + Log("$msgid was not found") unless $msgnum; + } + + return $msgnum; +} + +sub deleteMsg { + +my $conn = shift; +my $msgnum = shift; +my $rc; + + # Mark a message for deletion by setting \Deleted flag + + Log(" msgnum is $msgnum") if $verbose; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked $msgid for delete") if $verbose; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $conn = shift; +my $mbx = shift; +my $status; +my $loops; + + # Remove the messages from a mailbox + + Log("Expunging $mbx mailbox") if $verbose; + sendCommand ( $conn, "1 EXAMINE \"$mbx\""); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /^1 OK/ ) { + $status = 1; + last; + } + + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Error selecting mailbox $mbx: $response"); + last; + } + if ( $loops++ > 1000 ) { + Log("No response to EXAMINE command, skipping this mailbox"); + last; + } + } + + return unless $status; + + sendCommand ( $conn, "1 EXPUNGE"); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + print "Error expunging messages: $response\n"; + last; + } + } + +} + +sub check { + +my $source_mbxs = shift; +my $REVERSE = shift; +my $src = shift; +my $dst = shift; +my @sourceMsgs; + + # Compare the contents of the user's mailboxes on the source + # with those on the destination. + + my $total_msgs=$total_missing=0; + foreach my $src_mbx ( @$source_mbxs ) { + next if $src_mbx eq ""; + next if $nosel_mbxs{"$src_mbx"}; + # Log("Mailbox $src_mbx"); + if ( $include_nosel_mbxs ) { + # If a mailbox was 'Noselect' on the src but the user wants + # it created as a regular folder on the dst then do so. They + # don't hold any messages so after creating them we don't need + # to do anything else. + next if $nosel_mbxs{"$src_mbx"}; + } + + $dst_mbx = mailboxName( $src_mbx,$srcPrefix,$srcDelim,$dstPrefix,$dstDelim ); + + # Record the association between source and dest mailboxes + $$REVERSE{"$dst_mbx"} = $src_mbx; + next if $src_mbx eq ""; + + selectMbx( $src_mbx, $src, 'EXAMINE' ); + + @sourceMsgs=(); + + # Get list of messages on the source + + if ( $msg_counts ) { + # Just get a count of messages in the mailbox + $src_count = getMsgList( $src_mbx, \@sourceMsgs, $src ); + $dst_count = getMsgList( $dst_mbx, \@destMsgs, $dst ); + if ( $src_count > $dst_count ) { + $missing .= "$src_mbx\n Number of source msgs = $src_count\n"; + $missing .= " Number of dest msgs = $dst_count\n"; + } + next; + } elsif ( $before_date or $after_date ) { + Log("Get list of messages on the source") if $debug; + getDatedMsgList( $src_mbx, $before_date, $after_date, \@sourceMsgs, $src ); + } else { + Log("Get list of messages on the source") if $debug; + getMsgList( $src_mbx, \@sourceMsgs, $src ); + } + + my $src_count = scalar @sourceMsgs; + Log(" There are $src_count messages in $src_mbx on the source"); + + # Get list of messages on the destination + + Log("Get list of messages on the destination") if $debug; + getMsgList( $dst_mbx, \@dstMsgs, $dst ); + + my %dstMsgs; + foreach $_ ( @dstMsgs ) { + ($msgid) = split(/\s+/, $_, 2); + $dstMsgs{"$msgid"} = 1; + } + + # See if any are missing from the destination + + my @missing; + my $missing; + foreach $srcMsg ( @sourceMsgs ) { + $total_msgs++; + Log(" source $srcMsg") if $debug; + ($msgid,$subject) = split(/\s+/, $srcMsg, 2); + + if ( !$dstMsgs{"$msgid"} ) { + $line = " $subject"; + $line .= " *** $msgid " if $include_msgid; + push( @missing, $line); + $missing++; + $total_missing++; + } + } + + if ( $missing ) { + Log(" There are $missing messages missing from $src_mbx on the destination"); + foreach $_ ( @missing ) { + Log(" $_"); + } + } else { + Log(" There are no missing messages on the destination") unless $missing; + } + } + + if ( $count_msgs ) { + Log("Total messages $total_msgs"); + Log("Missing messages $total_missing"); + } +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; +my $namespace; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + my $i; + while ( 1 ) { + readResponse( $conn ); + last if $i++ > 9999; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /NO|BAD/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + $namespace = 0; + last; + } + } + +# if ( !$namespace and !$opt_x ) { +# # Not implemented yet. Needs more testing +# # NAMESPACE is not supported by the server so try to +# # figure out the mbx delimiter and prefix +# $$delimiter = get_mbx_delimiter( $conn ); +# $$prefix = get_mbx_prefix( $delimiter, $conn ); +# +# return; +# } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^1 NO|^1 BAD/; + } + + if ( $verbose ) { + Log("prefix $$prefix"); + Log("delim $$delimiter"); + } + +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $direction = shift; +my $dstmbx; + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + # Change the mailbox name if the user has supplied mapping rules. + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = '\.' if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + return $dstmbx; +} + +sub flags { + +my $flags = shift; +my @newflags; +my $newflags; + + # Make sure the flags list contains only standard + # IMAP flags. + + return unless $flags; + + $flags =~ s/\\Recent|\\Forwarded//ig; + + foreach $_ ( split(/\s+/, $flags) ) { + next unless substr($_,0,1) eq '\\'; + push( @newflags, $_ ); + } + + $newflags = join( ' ', @newflags ); + + $newflags =~ s/\\Deleted//ig if $opt_r; + $newflags =~ s/^\s+|\s+$//g; + + return $newflags; +} + +sub createDstMbxs { + +my $mbxs = shift; +my $dst = shift; + + # Create a corresponding mailbox on the dst for each one + # on the src. + + foreach my $mbx ( @$mbxs ) { + $dstmbx = mailboxName( $mbx,$srcPrefix,$srcDelim,$dstPrefix,$dstDelim ); + createMbx( $dstmbx, $dst ) unless mbxExists( $dstmbx, $dst ); + } +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; +my $loops; + + # Determine whether a mailbox exists + + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD/ ) { + $status = 0; + last; + } + if ( $loops++ > 1000 ) { + Log("No response to EXAMINE command, skipping this mailbox"); + last; + } + } + + return $status; +} + +sub sort_flags { + +my $flags = shift; +my @newflags; +my $newflags; + + # Make sure the flags list contains only standard + # IMAP flags. Sort the list to make comparision + # easier. + + return unless $$flags; + + $$flags =~ s/\\Recent|\\Forwarded//ig; + foreach $_ ( split(/\s+/, $$flags) ) { + next unless substr($_,0,1) eq '\\'; + push( @newflags, $_ ); + } + + @newflags = sort @newflags; + $newflags = join( ' ', @newflags ); + $newflags =~ s/^\s+|\s+$//g; + + $$flags = $newflags; +} + +sub setFlags { + +my $msgnum = shift; +my $new_flags = shift; +my $old_flags = shift; +my $conn = shift; +my $rc; + + # Set the message flags as indicated. + + if ( $verbose ) { + Log("old flags $old_flags"); + Log("new flags $new_flags"); + } + + # Clear the old flags + + sendCommand ( $conn, "1 STORE $msgnum -FLAGS ($old_flags)"); + my $i; + while (1) { + readResponse ($conn); + last if $i > 9999; + if ( $response =~ /^1 OK/i ) { + $rc = 1; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting flags for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + # Set the new flags + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS ($new_flags)"); + my $i; + while (1) { + readResponse ($conn); + last if $i > 9999; + if ( $response =~ /^1 OK/i ) { + $rc = 1; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting flags for msg $msgnum: $response"); + $rc = 0; + last; + } + } +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; +my $type = shift; +my $status; +my $loops; + + # Select the mailbox. Type is either SELECT (R/W) or EXAMINE (R). + + sendCommand( $conn, "1 $type \"$mbx\""); + my $i; + while ( 1 ) { + readResponse( $conn ); + last if $i++ > 9999; + if ( $response =~ /^1 OK/i ) { + $status = 1; + last; + } elsif ( $response =~ /does not exist/i ) { + $status = 0; + last; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Unexpected response to SELECT/EXAMINE $mbx command: $response"); + last; + } + + if ( $loops++ > 1000 ) { + Log("No response to $type command, skipping this mailbox"); + last; + } + } + + return $status; + +} + +sub map_mbx_names { + +my $mbx_map = shift; +my $srcDelim = shift; +my $dstDelim = shift; + + # The -M argument causes imapcopy to read the + # contents of a file with mappings between source and + # destination mailbox names. This permits the user to + # to change the name of a mailbox when copying messages. + # + # The lines in the file should be formatted as: + # : + # For example: + # Drafts/2008/Save: Draft_Messages/2008/Save + # Action Items: Inbox + # + # Note that if the names contain non-ASCII characters such + # as accents or diacritical marks then the Perl module + # Unicode::IMAPUtf7 module must be installed. + + return unless $mbx_map_fn; + + unless ( open(MAP, "<$mbx_map_fn") ) { + Log("Error opening mbx map file $mbx_map_fn: $!"); + exit; + } + $use_utf7 = 0; + while( ) { + chomp; + s/[\r\n]$//; # In case we're on Windows + s/^\s+//; + next if /^#/; + next unless $_; + ($srcmbx,$dstmbx) = split(/\s*:\s*/, $_); + + # Unless the mailbox name is entirely ASCII we'll have to use + # the Modified UTF-7 character set. + $use_utf7 = 1 unless isAscii( $srcmbx ); + $use_utf7 = 1 unless isAscii( $dstmbx ); + + $srcmbx =~ s/\//$srcDelim/g; + $dstmbx =~ s/\//$dstDelim/g; + + $$mbx_map{"$srcmbx"} = $dstmbx; + + } + close MAP; + + if ( $use_utf7 ) { + eval 'use Unicode::IMAPUtf7'; + if ( $@ ) { + Log("At least one mailbox map contains non-ASCII characters. This means you"); + Log("have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox "); + Log("names between the source and destination servers."); + print "At least one mailbox map contains non-ASCII characters. This means you\n"; + print "have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox\n"; + print "names between the source and destination servers.\n"; + exit; + } + } + + my %temp; + foreach $srcmbx ( keys %$mbx_map ) { + $dstmbx = $$mbx_map{"$srcmbx"}; + Log("Mapping src:$srcmbx to dst:$dstmbx"); + if ( $use_utf7 ){ + # Encode the name in Modified UTF-7 charset + $srcmbx = Unicode::IMAPUtf7::imap_utf7_encode( $srcmbx ); + $dstmbx = Unicode::IMAPUtf7::imap_utf7_encode( $dstmbx ); + } + $temp{"$srcmbx"} = $dstmbx; + } + %$mbx_map = %temp; + %temp = (); + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub get_date { + +my $days = shift; +my $time = time(); +my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); + + # Generate a date in DD-MMM-YYYY format. The 'days' parameter + # indicates how many days to go back from the present date. + + my ($sec,$min,$hr,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime( $time - $days*86400 ); + + $mday = '0' . $mday if length( $mday ) == 1; + my $month = $months[$mon]; + my $date = $mday . '-' . $month . '-' . ($year+1900); + + return $date; +} + +sub fixup_date { + +my $date = shift; + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + my $hrs = $2; + + return if length( $hrs ) == 2; + + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + +} + +sub get_mbx_prefix { + +my $delim = shift; +my $conn = shift; +my %prefixes; +my @prefixes; + + # Not implemented yet. + # Try to figure out whether the server has a mailbox prefix + # and if so what it is. + + $$delim = "\\." if $$delim eq '.'; + + my @mbxs = getMailboxList( $conn ); + my $num_mbxs = $#mbxs + 1; + foreach $mbx ( @mbxs ) { + next if uc( $mbx ) eq 'INBOX'; + ($prefix,$rest) = split(/$$delim/, $mbx); + $prefixes{"$prefix"}++; + } + + my $num_prefixes = keys %prefixes; + if ( $num_prefixes == 1 ) { + while(($$prefix,$count) = each(%prefixes)) { + push( @prefixes, "$$prefix|$count"); + } + ($$prefix,$count) = split(/\|/, pop @prefixes); + $num_mbxs--; # Because we skipped the INBOX + if ( $num_mbxs != $count ) { + # Did not find a prefix + $$prefix = ''; + } + + } + + $$delim =~ s/\\//; + $$prefix .= $$delim if $$prefix; + + Log("Determined prefix to be $$prefix") if $debug; + + return $$prefix; + +} + +sub get_mbx_delimiter { + +my $conn = shift; +my $delimiter; + + # Not implemented yet. + # Determine the mailbox hierarchy delimiter + + sendCommand ($conn, "1 LIST \"\" INBOX"); + undef @response; + my $i; + while ( 1 ) { + readResponse ($conn); + last if $i++ > 9999; + if ( $response =~ /INBOX/i ) { + my @terms = split(/\s+/, $response ); + $delimiter = $terms[3]; + $delimiter =~ s/"//g; + } + last if $response =~ /^1 OK|^1 BAD|^1 NO/; + last if $response !~ /^\*/; + } + + Log("Determined delimiter to be $delimiter") if $debug; + return $delimiter; +} + +sub validate_date { + +my $date = shift; +my $status = 1; + + # Make sure the date is in YYYY-MM-DD format + + my ($sec,$min,$hour,$mday,$mon,$this_year,$wday,$yday,$isdst) = localtime (time); + $this_year += 1900; + + $date =~ s/\//-/g; + $date =~ /(.+)-(.+)-(.+)/; + + my $day = $1; + my $mon = $2; + my $yr = $3; + + $status = 0 unless ( $day >= 1 and $day <= 31 ); + $status = 0 unless ( $mon =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i ); + $status = 0 unless ( $yr > 1950 and $yr <= $this_year ); + + if ( $status == 0 ) { + Log("$date is not a valid date in the required DD-MMM-YYYY format."); + exit; + } + +} + + +sub getDatedMsgList { + +my $mbx = shift; +my $before = shift; +my $after = shift; +my $msgs = shift; +my $conn = shift; +my $msgnums; +my $msgid; +my $stat = 1; +my $search; + + # Get a list of the messages in the date range requested + + my @msglist; + + # Construct the search filter + + if ( $after and $before ) { + $search = "(SINCE $after) (BEFORE $before)"; + } elsif ( $before ) { + $search = "BEFORE $before"; + } elsif ( $after ) { + $search = "SINCE $after"; + } + + Log("Executing search $search on $mbx") if $debug; + + Log("EXAMINE $mbx") if $debug; + sendCommand ( $conn, "1 EXAMINE \"$mbx\""); + my $i; + while (1) { + readResponse ($conn); + last if $i++ > 9999; + last if $response =~ /^1 OK/; + if ( $response =~ /^1 NO|^1 BAD/ ) { + return; + } + } + + sendCommand ( $conn, "1 SEARCH $search"); + my $loops; + while (1) { + readResponse ($conn); + if ( $response =~ /BAD command syntax error/i ) { + Log(" $response: $search"); + return -1; + } + + last if $loops++ > 99; + + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msgnum) = split(/\* SEARCH /i, $response); + @msglist = split(/ /, $msgnum); + } + last if $response =~ /^1 OK/; + last if $response =~ /^1 NO/; + last if $response =~ /complete/i; + } + + # Get the info we need on each message + foreach my $msgnum ( @msglist ) { + + sendCommand ( $conn, "1 FETCH $msgnum (uid flags internaldate body[header.fields (From Date Message-ID Subject)])"); + undef @response; + my $loops; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD/; + last if $loops++ > 99; + } + + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent|\\Forwarded//ig; + } + + # Consider the < and > to be part of the message-id. + # if ( $response[$i] =~ /^Message-ID:\s*(.+)/i ) { + if ( $response[$i] =~ /^Message-ID:\s*(.*)/i ) { + $msgid = $1; + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = $response[$i+1]; + } + $msgid =~ s/^\s+|\s+$;//g; + } + + if ( $response[$i] =~ /^Subject:\s*(.+)/i ) { + $subject = $1; + } + + if ( $response[$i] =~ /^From:\s*(.+)/i ) { + $from = $1; + } + + if ( $response[$i] =~ /^Date:\s*(.+)/i ) { + $header_date = $1; + check_date( \$header_date ); + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^\)/ ) { + if ( $msgid eq '' or $generate_msgids ) { + # The msg lacks a msgid + $msgid = build_dummy_msgid( $header_date, $subject, $from ); + } + + push (@$msgs,"$msgid\t$subject"); + $msgnum=$msgid=$date=$flags=$subject=$from=$header_date=''; + } + } + } + +} + +sub build_dummy_msgid { + +my $header_date = shift; +my $subject = shift; +my $from = shift; +my $msgid; + + # Build a dummy msgid from the header_date, subject, and from address + + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)//g; + if ( $generate_msgids ) { + Log("Building dummy msgid = $msgid") if $debug; + } else { + Log("Message has no msgid, built one as $msgid") if $debug; + } + + return $msgid; +} + +sub check_date { + +my $date = shift; + + # Some servers mess with the Date in the header, such as trimming leading + # '0' from dates. Ugh. Try to 'normalize' such dates. + + my @terms = split(/\s+/, $$date ); + my $old_dom = $new_dom = $terms[1]; + + if ( length( $old_dom ) == 1 ) { + # Pad the day to two digits + $new_dom = '0' . $old_dom; + $$date =~ s/$old_dom/$new_dom/; + } + + # Strip off the timezone offset if present + + my $temp; + foreach $_ ( split(/\s+/, $$date ) ) { + $temp .= "$_ "; + last if /(.+):(.+):(.+)/; + } + $temp =~ s/\s+$//g; + $$date = $temp; + +} + +sub get_wrapped_msgid { + +my $response = shift; +my $i = shift; +my $msgid; + + # The Message-ID is not on the same line as the Message-ID: keyword + # Get it from the next line or lines (if it continues onto succeeding lines) + + $$response[$i+1] =~ s/^\s+//; + $msgid = $$response[$i+1]; + $msgid =~ s/\s+$//g; + + my $j = 1; + while ( 1 ) { + if ( $msgid =~ /\>$/ ) { + # We've got all of it + last; + } + $j++; + # The msgid continues onto the next line + $$response[$i+$j] =~ s/^\s+//; + $msgid .= $$response[$i+$j]; + if ( $msgid =~ /Message-ID:/i ) { + ($start,$msgid) = split(/Message-ID:/, $msgid ); + } + + last if $j > 99; + } + + return $msgid; + +} + diff --git a/S/imap_tools.V1.333/imap_search.pl b/S/imap_tools.V1.333/imap_search.pl new file mode 100755 index 0000000..c85c5aa --- /dev/null +++ b/S/imap_tools.V1.333/imap_search.pl @@ -0,0 +1,1940 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imap_search.pl,v 1.4 2015/02/02 16:15:01 rick Exp $ + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use MIME::Base64 qw(decode_base64 encode_base64); + + # Build the search filter which can have multiple criteria like + # "from joe@abc.com" "subject test message" + # + # ./imapsearch.pl "kw=value" "kw=value" etc. The search AND's the + # filters together giving the results which match all the criteria. + # + # IMAP SEARCH syntax. 'AND' is implied. + # + # AND search1 search2 etc + # OR search1 search2 etc + # NOT search1 search2 etc + + init(); + + $args = scalar @ARGV; + $i = 1; + for $i ( 1 .. $#ARGV ) { + ($kw,$val) = split(/\s*=\s*/, $ARGV[$i]); + $kw = "header $kw" if $kw =~ /message-id|date/i; + $search_filter .= "$kw \"$val\" "; + last if $ARGV[$i] eq ''; + } + $search_filter =~ s/\s+$//; + $search_filter =~ s/\s*""//g; + + connectToHost($sourceHost, \$src) or exit; + login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) or exit; + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + + if ( !@mbxs ) { + @mbxs = getMailboxList( $srcPrefix, $src ); + } + + $search_filter =~ s/""//g; + $search_filter =~ s/AND//g; + $search_filter =~ s/\s+$//; + $where = "in all folders\n"; + $where = "in $mbx folder" if $mbx; + print "\nSearching for $search_filter $where\n"; + + foreach $srcmbx ( @mbxs ) { + $match = 0; + examineMbx( $srcmbx, $src ); + + # Get messages matching the field=value input + + $nums = search( $srcmbx, $search_filter, $src ); + foreach $msgnum ( split(/\s+/, $nums) ) { + $match = 1; + ($date,$subj) = get_msg_header( $msgnum, $src ); + format_date( \$date ); + push( @output, "$srcmbx|$date|$subj"); + } + if ( $match ) { + $longest_mbx = length( $srcmbx ) if length( $srcmbx ) > $longest_mbx; + } + } + logout( $src ); + + if ( !@output ) { + print "\nNo matches were found\n"; + exit; + } + + $longest_mbx += 2; + + $line = pack("A$longest_mbx A34, A25", 'Folder', ' Date', 'Subject' ); + print "\n$line\n"; + print "===================================================================================\n"; + foreach $_ ( @output ) { + ($mbx,$date,$subj) = split(/\|/, $_); + $line = pack("A$longest_mbx A26", $mbx, $date ); + $line .= " $subj"; + print "$line\n"; + } + + exit; + + +sub init { + + $os = $ENV{'OS'}; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + read_config(); + + if ( $ARGV[0] =~ /(.+)\/(.+)\/oauth2:(.+)/ ) { + $sourceHost = $1; + $sourceUser = $2; + $sourcePwd = "oauth2:$3"; + } elsif ( $ARGV[0] =~ /(.+):(.+)\/(.+)\/(.+):(.+)/ ) { + # host:port/user/pwd:mbx + $sourceHost = $1 . ":$2"; + $sourceUser = $3; + $sourcePwd = $4; + $mbx = $5; + } elsif ( $ARGV[0] =~ /(.+):(.+)\/(.+)\/(.+)/ ) { + # host:port/user/pwd + $sourceHost = $1 . ":$2"; + $sourceUser = $3; + $sourcePwd = $4; + } elsif ( $ARGV[0] =~ /(.+):(.+)/ ) { + # user:mbx + $sourceUser = $1; + $mbx = $2; + $sourceUser = "$sourceUser/$admin_user"; + $sourcePwd = $admin_pwd; + } elsif ( $ARGV[0] and $ARGV[1] ) { + # user filter + $sourceUser = "$ARGV[0]/$admin_user"; + $sourcePwd = $admin_pwd; + } elsif ( $ARGV[0] =~ /:/ ) { + # user:mbx filter + ($ARGV[0],$mbx) = split(/:/, $ARGV[0] ); + $sourceUser = "$ARGV[0]/$admin_user"; + # Just the username specified so we will use the admin credentials + unless( $admin_user and $admin_pwd ) { + usage(); + exit; + } + } else { + print "\nUsage: $0 <\"field1=value1\"> ... <\"fieldn=valuen\">\n\n"; + exit; + } + + push( @mbxs, $mbx ) if $mbx; + + if ( $opt_h or $opt_H ) { + usage(); + } + unless( $sourceUser and $sourcePwd and $sourceHost ) { + usage(); + } + + # Set up signal handling + + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + +} + +sub read_config { + + # If there is a config file grab the host and admin credentials so + # the operator doesn't have to specify them in the command line + + my @dirs = qw( . /etc /var/tmp /usr/bin ); + foreach $dir ( @dirs ) { + $cf = "$dir/imap_search.cf"; + if ( -e $cf ) { + open( CF, "<$cf"); + while( ) { + chomp; + s/^\s+//; + if ( /:/ ) { + ($kw,$val) = split(/:/, $_, 2); + $kw =~ s/\s+//g; + $val =~ s/^\s+|\s+$//g; + $KW{"$kw"} = $val; + } + } + close CF; + $sourceHost = $KW{server}; + $admin_user = $KW{admin_user}; + $admin_pwd = $KW{admin_pwd}; + last; + } + + } + +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + + Log (">> $cmd") if $showIMAP; +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< $response") if $showIMAP; + + if ( $response =~ /server unavailable|connection closed/i ) { + resume(); + } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logfile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$str); + print LOG "$line"; + } + print STDOUT "$str\n" unless $quiet_mode; + +} + +sub today { + + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + my $today = sprintf ("%.2d-%.2d-%d", $mon + 1, $mday, $year + $yr); + return $today; +} + + + + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if necessary + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + Log ("Error creating $mbx: $response"); + last; + } + if ( $response eq '' or $response =~ /^1 NO/ ) { + Log ("unexpected CREATE response: >$response<"); + Log("response is NULL"); + resume(); + last; + } + + } + +} + +# insertMsg +# +# This routine inserts a message into a user's mailbox +# +sub insertMsg { + +local ($conn, $mbx, *message, $flags, $date) = @_; +local ($lenx); + + $lenx = length($message); + + Log(" Inserting message") if $debug; + my $mb = $lenx/1000000; + + if ( $max_size and $mb > $max_size ) { + commafy( \$lenx ); + Log(" Skipping message because its size ($lenx) exceeds the $max_size MB limit"); + return; + } + + $totalBytes = $totalBytes + $lenx; + $totalMsgs++; + + $flags = flags( $flags ); + + fixup_date( \$date ); + + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + readResponse ($conn); + + if ( $response !~ /^\+/ ) { + Log ("1 unexpected APPEND response: >$response<"); + # if ( $response eq '' or $response =~ /^1 NO/ ) { + if ( $response eq '' ) { + Log("response is NULL"); + resume(); + next; + } + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$message\r\n"; + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + # next; + return 0; + } + } + + return 1; +} + +# Make a connection to a IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $host = shift; +my $conn = shift; +my $method = shift; + + Log("method $method") if $debug; + + if ( uc( $method ) eq 'CRAM-MD5' ) { + # A CRAM-MD5 login is requested + Log("login method $method"); + my $rc = login_cram_md5( $user, $pwd, $conn ); + return $rc; + } + + if ( $admin_user and $admin_pwd ) { + # An AUTHENTICATE = PLAIN login has been requested + ($sourceUser,$authuser) = split(/\//, $user ); + ($sourceUser,$authuser) = split(/[:\/]/, $user ); + login_plain( $sourceUser, $authuser, $sourcePwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + login_xoauth2( $user, $token, $conn ); + return 1; + } + + # Otherwise do an ordinary login + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + + +sub login_cram_md5 { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + + Log("challenge $challenge") if $debug; + $response = cram_md5( $challenge, $user, $pwd ); + Log("response $response") if $debug; + + sendCommand ($conn, $response); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# + +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + +# print "user $user\n"; +# print "admin $admin\n"; +# print "pwd $pwd\n"; + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Cyrus/i and $conn eq $dst ) { + Log("Destination is a Cyrus server"); + $cyrus = 1; + } + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $prefix = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes",2) if $debugMode; + + if ( $mbxList ) { + foreach $mbx ( split(/,/, $mbxList) ) { + $mbx = encode( 'IMAP-UTF-7', $mbx ); + $mbx = $prefix . $mbx if $prefix; + if ( $opt_R ) { + # Get all submailboxes under the ones specified + $mbx .= '*'; + @mailboxes = listMailboxes( $mbx, $conn); + push( @mbxs, @mailboxes ); + } else { + push( @mbxs, $mbx ); + } + } + } else { + # Get all mailboxes + @mbxs = listMailboxes( '*', $conn); + } + + return @mbxs; +} + +# exclude_mbxs +# +# Exclude certain mailboxes from the list if the user has provided an +# exclude list of complete mailbox names with the -e argument. He may +# also supply a list of regular expressions with the -g argument +# which we will process separately. + +sub exclude_mbxs { + +my $mbxs = shift; +my @new_list; +my %exclude; +my (@regex_excludes,@final_list); + + # Do the exact matches first + if ( $excludeMbxs ) { + foreach my $exclude ( split(/,/, $excludeMbxs ) ) { + $exclude{"$exclude"} = 1; + } + foreach my $mbx ( @$mbxs ) { + next if $exclude{"$mbx"}; + push( @new_list, $mbx ); + } + @$mbxs = @new_list; + } + + # Next do the regular expressions if any + my %excludes; + @new_list = (); + if ( $excludeMbxs_regex ) { + my @regex_excludes; + foreach $_ ( split(/,/, $excludeMbxs_regex ) ) { + push( @regex_excludes, $_ ); + } + foreach my $mbx ( @$mbxs ) { + foreach $_ ( @regex_excludes ) { + if ( $mbx =~ /$_/ ) { + $excludes{"$mbx"} = 1; + } + } + } + foreach my $mbx ( @$mbxs ) { + push( @new_list, $mbx ) unless $excludes{"$mbx"}; + } + @$mbxs = @new_list; + } + + @new_list = (); + +} + +# listMailboxes +# +# Get a list of the user's mailboxes +# +sub listMailboxes { + +my $mbx = shift; +my $conn = shift; + + sendCommand ($conn, "1 LIST \"\" \"$mbx\""); + undef @response; + while ( 1 ) { + &readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + &Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + if ( $include_nosel_mbxs ) { + $nosel_mbxs{"$mbx"} = 1; + } else { + Log("$mbx is set NOSELECT, skipping it") if $debug; + next; + } + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +sub get_msg_header { + +my $msgnum = shift; +my $conn = shift; + + sendCommand( $conn, "1 FETCH $msgnum (body[header.fields (date from subject)])" ); + @response = (); + while ( 1 ) { + readResponse ( $conn ); + + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response"); + exit; + } + } + + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ( $response[$i] =~ /Subject: (.+)/ ) { + $subj = $1; + if ( substr($response[$i+1],0,1) eq ' ' ) { + # Line wrap + $subj .= $response[$i+1]; + } + } + if ( $response[$i] =~ /Date: (.+)/ ) { + $date = $1; + } + + + } + + return ($date,$subj); + +} + + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $mode = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $msgid; + + @$msgs = (); + $mode = 'EXAMINE' unless $mode; + sendCommand ($conn, "1 $mode \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + print "Error: $response\n"; + exit; + return 0; + } + } + + return 1 if $empty; + + my $start = 1; + my $end = '*'; + $start = $start_fetch if $start_fetch; + $end = $end_fetch if $end_fetch; + + sendCommand ( $conn, "1 FETCH $start:$end (uid body[header.fields (From Date Subject])"); + + @response = (); + while ( 1 ) { + readResponse ( $conn ); + + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response"); + exit; + } + } + + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response[$i]"); + Log("msgnum $msgnum"); + exit; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE (.+) RFC822\.SIZE/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } elsif ( $response[$i] =~ /INTERNALDATE "(.+)" BODY/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } elsif ( $response[$i] =~ /INTERNALDATE "(.+)" FLAGS/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /Subject/i) { + $response[$i] =~ /Subject: (.+)/i; + $subject = $1; + } + if ( $response[$i] =~ /RFC822\.SIZE/i) { + $response[$i] =~ /RFC822\.SIZE ([0-9]+) BODY/i; + $size = $1; + } + + if ( $response[$i] =~ /^Message-Id:/i ) { + $response[$i] =~ /^Message-Id: (.+)/i; + $msgid = $1; + trim(*msgid); + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = $response[$i+1]; + trim(*msgid); + } + } + + # if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) { + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + push (@$msgs,"$msgnum|$date|$flags|$msgid|$subject"); + $msgnum = $date = $msgid = ''; + } + } + + return 1; + +} + +sub search { + +my $mailbox = shift; +my $filter = shift; +my $conn = shift; +my $loops; + + @list = (); + @$msgs = (); + + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ / EXISTS/i) { + $response =~ /\* ([^EXISTS]*)/; + # Log(" There are $1 messages in $mailbox"); + } elsif ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO/i ) { + Log ("unexpected response: $response"); + return 0; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + last if $loops++ > 999; + } + + $nums = ""; + + $filter =~ s/\s+$//; + + $loops=0; + sendCommand ($conn, "1 SEARCH $filter"); + while ( 1 ) { + last if $loops++ > 25; + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response =~ /^\*\s+SEARCH/i ) { + ($nums) = ($response =~ /^\*\s+SEARCH\s+(.*)/i); + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected SEARCH response: $response: $filter"); + exit; + } + } + Log("$nums") if $debug; + if ( $nums eq "" ) { + Log (" $mailbox has no messages sent before $date") if $debug; + return; + } + my @number = split(/\s+/, $nums); + $n = $#number + 1; + + $nums =~ s/\s+/ /g; + @msgList = (); + @msgList = split(/ /, $nums); + + return $nums; +} + +sub date_in_range { + +my $list1 = shift; +my $list2 = shift; +my $newlist = shift; +my %MSGNUMS; + + # Return a list of msgnums common to both lists passed + # to us. + + @$newlist = (); + + foreach $_ ( @$list1 ) { + my ($msgnum) = split(/\|/, $_); + $MSGNUMS{$msgnum} = $_; + } + + foreach $_ ( @$list2 ) { + my ($msgnum) = split(/\|/, $_); + push( @$newlist, $_ ) if $MSGNUMS{$msgnum}; + } + +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub fetchMsg { + +my $msgnum = shift; +my $size = shift; +my $message = shift; +my $mbx = shift; +my $conn = shift; + + Log(" Fetching msg $msgnum ($size bytes)...") if $debug; + + if ( $header_only ) { + $item = 'RFC822.HEADER'; + } else { + $item = 'RFC822'; + # Some servers don't do 'RFC822' correctly + $item = 'BODY[]'; + } + + $$message = ''; + sendCommand( $conn, "1 FETCH $msgnum ($item)"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + +if ( $response eq '' ) { + Log("RESP2 >$response<"); + resume(); + return 0; +} + if ( $response =~ /^1 OK/i ) { + $size = length($$message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{[0-9]+\}/i) { + $item =~ s/BODY\[\]/BODY\\[\\]/ if $response =~ /BODY/; + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + resume(); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + + return 1; +} + + +sub examineMbx { + +my $mbx = shift; +my $conn = shift; + + # Now select the mailbox + sendCommand( $conn, "1 EXAMINE \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + print "Error examining $mbx: $response\n"; + exit; + } + } + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; +my $substChar = '_'; + + if ( $public_mbxs ) { + my ($public_src,$public_dst) = split(/:/, $public_mbxs ); + # If the mailbox starts with the public mailbox prefix then + # map it to the public mailbox destination prefix + + if ( $srcmbx =~ /^$public_src/ ) { + Log("src: $srcmbx is a public mailbox") if $debug; + $dstmbx = $srcmbx; + $dstmbx =~ s/$public_src/$public_dst/; + Log("dst: $dstmbx") if $debug; + return $dstmbx; + } + } + + # Change the mailbox name if the user has supplied mapping rules. + + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + $srcmbx =~ s/^$srcPrefix//; + $srcmbx =~ s/\\$srcDelim/\//g; + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + # $dstmbx = $srcmbx; + if ( lc( $srcmbx ) eq 'inbox' ) { + $dstmbx = $srcmbx; + } else { + $dstmbx = $srcPrefix . $srcmbx; + } + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub flags { + +my $flags = shift; +my @newflags; +my $newflags; +my %standard_flags = ( '\\Seen', 1, '\\Deleted', 1, '\\Draft', 1, + '\\Answered', 1, '\\Flagged', 1, '\\Recent', 1 ); + + # Make sure the flags list contains standard + # IMAP flags and optionally custom tags + + return unless $flags; + + $flags =~ s/\\Recent//i; + foreach $_ ( split(/\s+/, $flags) ) { + # push( @newflags, $_ ) if substr($_,0,1) eq '\\'; + if ( substr($_,0,1) eq '\\' ) { + # Should be a standard flag. Make sure it is. + push( @newflags, $_ ) if $standard_flags{$_}; + } + if ( $opt_T ) { + # Include user-defined flags + push( @newflags, $_ ) if substr($_,0,1) eq '$'; + } + } + + $newflags = join( ' ', @newflags ); + + $newflags =~ s/\\Deleted//ig if $opt_r; + $newflags =~ s/^\s+|\s+$//g; + + return $newflags; +} + +sub map_mbx_names { + +my $mbx_map = shift; +my $srcDelim = shift; +my $dstDelim = shift; + + # The -M argument causes imapcopy to read the + # contents of a file with mappings between source and + # destination mailbox names. This permits the user to + # to change the name of a mailbox when copying messages. + # + # The lines in the file should be formatted as: + # : + # For example: + # Drafts/2008/Save: Draft_Messages/2008/Save + # Action Items: Inbox + # + # Note that if the names contain non-ASCII characters such + # as accents or diacritical marks then the Perl module + # Encode::IMAPUTF7 module must be installed. + + return unless $mbx_map_fn; + + unless ( open(MAP, "<$mbx_map_fn") ) { + Log("Error opening mbx map file $mbx_map_fn: $!"); + exit; + } + while( ) { + chomp; + s/[\r\n]$//; # In case we're on Windows + s/^\s+//; + next if /^#/; + next unless $_; + ($srcmbx,$dstmbx) = split(/\s*:\s*/, $_); + + # Unless the mailbox name is entirely ASCII we'll have to use + # the Modified UTF-7 character set. + $srcmbx = encode( 'IMAP-UTF-7', $srcmbx ) unless isAscii( $srcmbx ); + $dstmbx = encode( 'IMAP-UTF-7', $dstmbx ) unless isAscii( $dstmbx ); + + $srcmbx =~ s/\//$srcDelim/g; + $dstmbx =~ s/\//$dstDelim/g; + + $$mbx_map{"$srcmbx"} = $dstmbx; + + } + close MAP; + +# if ( $use_utf7 ) { +# if ( $@ ) { +# Log("At least one mailbox map contains non-ASCII characters. This means you"); +# Log("have to install the Perl Encode::IMAPUTF7 module in order to map mailbox "); +# Log("names between the source and destination servers."); +# print "At least one mailbox map contains non-ASCII characters. This means you\n"; +# print "have to install the Perl Encode::IMAPUTF7 module in order to map mailbox\n"; +# print "names between the source and destination servers.\n"; +# exit; +# } +# } + + my %temp; + foreach $srcmbx ( keys %$mbx_map ) { + $dstmbx = $$mbx_map{"$srcmbx"}; + Log("Mapping src:$srcmbx to dst:$dstmbx"); + $srcmbx = encode( 'IMAP-UTF-7', $srcmbx ) unless isAscii( $srcmbx ); + $dstmbx = encode( 'IMAP-UTF-7', $dstmbx ) unless isAscii( $dstmbx ); + $temp{"$srcmbx"} = $dstmbx; + } + %$mbx_map = %temp; + %temp = (); + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + +# Reconnect to the servers after a timeout error. +# +sub reconnect { + +my $checkpoint = shift; +my $conn = shift; + + Log("Attempting to reconnect"); +exit; + + my ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint); + + close $src; + close $dst; + + connectToHost($shost,\$src); + login($suser,$spwd,$shost,$src); + + connectToHost($dhost,\$dst); + login($duser,$dpwd,$dhost,$dst); + + selectMbx( $mbx, $src ); + createMbx( $mbx, $dst ); # Just in case + +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } + Log("Resuming"); +} + +sub fixup_date { + +my $date = shift; +my ($hrs,$dom); + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. Same for the DOM. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + $hrs = $2; + ($dom) = split(/-/, $$date, 2); + + if ( length( $hrs ) == 1 ) { + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + $hrs = $2; + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + } + if ( length( $dom ) == 1 ) { + $$date =~ s/^\s+//; + my $newdom = '0' . $dom if length( $dom ) == 1; + $$date =~ s/^$dom/$newdom/; + } + +} + +sub init_mbx { + +my $mbx = shift; +my $conn = shift; +my @msgs; + + # Remove all messages from a mailbox + + Log("Initializing mailbox $mbx"); + getMsgList( $mbx, \@msgs, $conn, 'SELECT' ); + my $msgcount = $#msgs + 1; + Log("$mbx has $msgcount messages"); + + return if $msgcount == 0; # No messages to delete + + foreach my $msgnum ( @msgs ) { + ($msgnum) = split(/\|/, $msgnum); + delete_msg( $msgnum, $conn ); + } + expungeMbx( $mbx, $conn ); + +} + +sub delete_msg_list { + +my $msgnums = shift; +my $mbx = shift; +my $conn = shift; +my $rc; + + # Mark a set of messages for deletion + + selectMbx( $mbx, $conn ); + + foreach my $msgnum ( split(/\s+/, $msgnums ) ) { + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msg number $msgnum for delete") if $debug; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + } + + return $rc; + +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; + + Log("Expunging mailbox $mbx"); + + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /1 OK/i ); + } + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error purging messages: $response"); + last; + } + } + + $totalExpunged += $expunged; + + Log("$expunged messages expunged"); + +} + +sub cram_md5 { + +my $challenge = shift; +my $user = shift; +my $password = shift; + +eval 'use Digest::HMAC_MD5 qw(hmac_md5_hex)'; +use MIME::Base64 qw(decode_base64 encode_base64); + + # Adapated from script by Paul Makepeace , 2002-10-12 + # Takes user, key, and base-64 encoded challenge and returns base-64 + # encoded CRAM. See, + # IMAP/POP AUTHorize Extension for Simple Challenge/Response: + # RFC 2195 http://www.faqs.org/rfcs/rfc2195.html + # SMTP Service Extension for Authentication: + # RFC 2554 http://www.faqs.org/rfcs/rfc2554.html + # Args: tim tanstaaftanstaaf PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+ + # should yield: dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw + + my $challenge_data = decode_base64($challenge); + my $hmac_digest = hmac_md5_hex($challenge_data, $password); + my $response = encode_base64("$user $hmac_digest"); + chomp $response; + + if ( $debug ) { + Log("Challenge: $challenge_data"); + Log("HMAC digest: $hmac_digest"); + Log("CRAM Base64: $response"); + } + + return $response; +} + +sub validate_date { + +my $date = shift; +my $invalid; + + # Make sure the "after" date is in DD-MMM-YYYY format + + my ($day,$month,$year) = split(/-/, $date); + $invalid = 1 unless ( $day > 0 and $day < 32 ); + $invalid = 1 unless $month =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i; + $invalid = 1 unless $year > 1900 and $year < 2999; + if ( $invalid ) { + Log("The 'Sent after' date $date must be in DD-MMM-YYYY format"); + exit; + } +} + +sub commafy { + +my $number = shift; + + $_ = $$number; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + + $$number = $_; + +} + +sub delete_msg { + +my $msgnum = shift; +my $conn = shift; +my $rc; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msg number $msgnum for delete") if $debug; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + + + +} + + +sub resume { + + # Disconnect, re-connect, and log back in. + + Log("Fatal error, lost connection to either the source or destination"); + # Log("checkpoint $checkpoint"); + Log("LAST $LAST"); + my ($mbx,$msgnum) = split(/\|/, $LAST); + $srcmbx = $mbx; + Log("mbx $mbx"); + Log("Disconnect from the source and destination servers"); + + close $src; + close $dst; + + Log("Sleeping 15 seconds before reconnecting"); + sleep 15; + + Log("Reconnect to source server and log back in"); + connectToHost($sourceHost, \$src) or exit; + login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) or exit; + selectMbx( $mbx, $src ); + + Log("Reconnect to destination server and log back in"); + connectToHost( $destHost, \$dst ) or exit; + login( $destUser,$destPwd, $destHost, $dst, $dstMethod ) or exit; + Log("Resuming"); + + # Just in case we were creating a mailbox when the connection + # was lost check and recreate it if necessary + + map_mbx_names( \%mbx_map, $srcDelim, $dstDelim ); + if ( $mbx_map{"$mbx"} ) { + $dstmbx = $mbx_map{"$mbx"} + } + + createMbx( $dstmbx, $dst ) unless mbxExists( $dstmbx, $dst ); + + return; + +} + + +# getMsgIdList +# +# Get a list of the user's messages in a mailbox +# +sub getMsgIdList { + +my $mailbox = shift; +my $msgids = shift; +my $conn = shift; +my $empty; +my $msgnum; +my $from; +my $msgid; + + %$msgids = (); + sendCommand ($conn, "1 SELECT \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + if ( $empty ) { + return; + } + + Log("Fetch the header info") if $debug; + + # sendCommand ( $conn, "1 FETCH 1:* (body[header.fields (Message-Id)])"); + sendCommand ( $conn, "1 FETCH 1:* (body.peek[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ($response[$i] =~ /Message-ID:/i) { + $response[$i] =~ /Message-Id: (.+)/i; + $msgid = $1; + trim(*msgid); + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = $response[$i+1]; + trim(*msgid); + } + $$msgids{"$msgid"} = 1; + } + } + +} + +sub encode_ampersand { + +my $mbx = shift; + + # The IMAP RFC requires mailbox names with '&' be + # encoded as '&-' + + # The problem with this routine is a mailbox name may be + # encoded in Mod UTF7 which uses the '&' character for its + # own purposes, eg r&AOk-pertoire_XXX. We have to leave it + # alone. Anyway, this code was inserted because of an IMAP + # server which did not do its job so the usefulness of this + # conversion is limited. + + if ( $$mbx =~ /\&/ ) { + if ( $$mbx !~ /\&-/ ) { + # Need to encode the '&' as '&-' + $$mbx =~ s/\&/\&-/g; + Log("Encoded $$mbx"); + } + } + +} + +sub usage { + + print "\nUsage: $0 ... \n"; + exit; + +} + +sub format_date { + +my $date = shift; + + # Put the date into a more concise format + + # Tue, 20 Sep 2011 21:57:09 -0600 + + if ( $$date =~ /,/ ) { + ($dd,$$date) = split(/,/, $$date); + } + if ( $$date =~ /[-+]/ ) { + ($$date) = split(/[-+]/, $$date); + } + $$date =~ s/^\s+//; +} diff --git a/S/imap_tools.V1.333/imap_to_maildir.pl b/S/imap_tools.V1.333/imap_to_maildir.pl new file mode 100755 index 0000000..d7068e4 --- /dev/null +++ b/S/imap_tools.V1.333/imap_to_maildir.pl @@ -0,0 +1,1118 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imap_to_maildir.pl,v 1.6 2015/07/07 12:05:54 rick Exp $ + +################################################################################ +# imap_to_maildir is a utility for copying mailboxes and messages # +# from a user account on an IMAP server to a Maildir system. # +# # +# imap_to_maildir.pl is called like this: # +# ./imap_to_maildir.pl -S imaphost/user/password -u -M # +# # +# For example: ./imap_to_maildir.pl \ # +# -S imap.gmail.com:993/rsanders/mypass \ # +# -u rick \ # +# -M /users/rick/Maildir # +# Optional arguments: # +# -a copy only messages after this date # +# -d debug # +# -I log IMAP protocol commands # +# -L logfile # +# -m mailbox list (copies only the specified mailboxes, see usage() # +################################################################################ + +use Socket; +use IO::Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use File::Path qw(make_path); +use Time::HiRes; +use MIME::Base64 qw(encode_base64 decode_base64); + +################################################################# +# Main program. # +################################################################# + + init(); + + # Get list of all messages on the IMAP server + # + connectToHost($sourceHost, \$conn); + unless ( login($sourceUser,$sourcePwd, $conn) ) { + Log("Check your username and password"); + print STDOUT "Login failed: Check your username and password\n"; + exit; + } + @mbxs = getMailboxList($sourceUser, $conn); + namespace( $conn, \$prefix, \$delimiter, $opt_x ); + + foreach $mbx ( @mbxs ) { + if ( $exclude ) { + # Exclude the indicated mailboxes + if ( $mbx =~ /$exclude/i ) { + Log("Excluding $mbx"); + next; + } + } + + # The messages in '[Gmail]All Mail' are dups of the messages in the IMAP folders + # so skip it. + next if $mbx eq '[Gmail]All Mail'; + + $dstmbx = $mbx; + $dstmbx =~ s/^inbox/INBOX/i; + $dstmbx =~ s/$prefix// if $prefix; + + if ( $strip_gmail ) { + $dstmbx =~ s/^\[Gmail\]//; + $dstmbx =~ s/^\///; + } + + unless ( $delimiter eq '.' ) { + # Mailboxes may not contain dots, replace them with - + $dstmbx =~ s/\./-/g; + } + + Log("Copying messages in $mbx mailbox") if $dump_flags; + my @msgs; + + if ( $sent_after ) { + getDatedMsgList( $mbx, $sent_after, \@msgs, $conn, 'EXAMINE' ); + } else { + getMsgList( $mbx, \@msgs, $conn, 'EXAMINE' ); + } + + my $i = $#msgs + 1; + Log(" $mbx has $i messages"); + + $folder = get_folder_name( $maildir, $dstmbx, $delimiter, $prefix ); + + build_folder( $folder, $username ); + Log("folder $folder") if $debug; + my $i = $#msgs + 1; + my $msgnums; + foreach $msgnum ( @msgs ) { + ($msgnum,$date,$flags,$rfc822_size) = split(/\|/, $msgnum); + $message = fetchMsg( $msgnum, $mbx, $conn ); + my $size = length( $message ); + + $msgfile = generate_filename( $folder, $size, $rfc822_size, $flags ); + next if !$msgfile; # Failed to generate a unique filename + if ( !open (M, ">$msgfile") ) { + Log("Error opening $msgfile: $!"); + next; + } + Log(" Copying message $msgnum") if $debug; + print M $message; + close M; + $added++; + + $msgnums .= "$msgnum "; + } + } + + logout( $conn ); + Log("Copied $added total messages"); + + exit; + + +sub init { + + $version = 'V1.0'; + $os = $ENV{'OS'}; + + processArgs(); + + if ($timeout eq '') { $timeout = 60; } + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("\n$0 starting"); + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + if ( $dump_flags ) { + Log("Dumping only those messages with one of the following flags: $dump_flags"); + } + + chomp( $localhost = `uname -n` ); +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } else { + print STDOUT "$str\n"; + } +print STDOUT "$str\n"; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $user = shift; +my $conn = shift; +my @mbxs; +my @mailboxes; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + foreach $mbx ( @mbxs ) { + trim( *mbx ); + push( @mailboxes, $mbx ); + } + return @mailboxes; + } + + if ($debug) { Log("Get list of user's mailboxes",2); } + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + %nosel_mbxs = (); + undef @mbxs; + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx= $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # those + @mbxs = split(/,/, $mbxList); + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $mode = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; + + $mode = 'EXAMINE' unless $mode; + sendCommand ($conn, "1 $mode \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)] RFC822.SIZE)"); + + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + @msgs = (); + $flags = $rfc822_size = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + # $response[$i] =~ /INTERNALDATE "(.+)" BODY/; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /RFC822.SIZE/ ) { + $response[$i] =~ /RFC822.SIZE\s+(.+)(.*)/; + ($rfc822_size) = split(/\s+/, $1); + $rfc822_size =~ s/[^\d.]//g; + } + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $msgnum and $date and $rfc822_size ) { + push (@$msgs,"$msgnum|$date|$flags|$rfc822_size"); + $msgnum = $date = $rfc822_size = ''; + } + } + + return 1; + +} + +# getDatedMsgList +# +# Get a list of the user's messages in a mailbox on +# the host which were sent after the specified date +# +sub getDatedMsgList { + +my $mailbox = shift; +my $cutoff_date = shift; +my $msgs = shift; +my $conn = shift; +my $oper = shift; +my ($seen, $empty, @list,$msgid, $rfc822_size); + + # Get a list of messages sent after the specified date + + @list = (); + @$msgs = (); + + sendCommand ($conn, "1 $oper \"$mailbox\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ / EXISTS/i) { + $response =~ /\* ([^EXISTS]*)/; + # Log(" There are $1 messages in $mailbox"); + } elsif ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO/i ) { + Log ("unexpected SELECT response: $response"); + return 0; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected SELECT response: $response"); + return 0; + } + } + + my ($date,$ts) = split(/\s+/, $cutoff_date); + + # + # Get list of messages sent before the reference date + # + Log("Get messages sent after $date") if $debug; + $nums = ""; + sendCommand ($conn, "1 SEARCH SINCE \"$date\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response =~ /^\*\s+SEARCH/i ) { + ($nums) = ($response =~ /^\*\s+SEARCH\s+(.*)/i); + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected SEARCH response: $response"); + return; + } + } + Log("$nums") if $debug; + if ( $nums eq "" ) { + Log (" $mailbox has no messages sent before $date") if $debug; + return; + } + my @number = split(/\s+/, $nums); + $n = $#number + 1; + + $nums =~ s/\s+/ /g; + @msgList = (); + @msgList = split(/ /, $nums); + + if ($#msgList == -1) { + # No msgs in this mailbox + return 1; + } + + $n = $#msgList + 1; + Log(" $mailbox has $n messages after $sent_after"); + +@$msgs = (); +for $num (@msgList) { + + sendCommand ( $conn, "1 FETCH $num (uid flags internaldate body[header.fields (Message-Id Date)] RFC822.SIZE)"); + + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + $flags = $rfc822_size = ''; + my $msgid; + foreach $_ ( @response ) { + last if /^1 OK FETCH complete/i; + if ( /FLAGS/ ) { + # Get the list of flags + /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( /Message-Id:\s*(.+)/i ) { + $msgid = $1; + } + + if ( /INTERNALDATE/) { + /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + #### next if check_cutoff_date( $date, $cutoff_date ); + } + + if ( /RFC822.SIZE/ ) { + /RFC822.SIZE\s+(.+)(.*)/; + $rfc822_size = $1; + $rfc822_size =~ s/[^\d.]//g; + } + + if ( /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $msgnum and $date and $rfc822_size ) { + push (@$msgs,"$msgnum|$date|$flags|$msgid|$rfc822_size"); + $msgnum=$msgid=$date=$flags=$rfc822_size=''; + } + } + } + + foreach $_ ( @$msgs ) { + Log("getDated found $_") if $debug; + } + + return 1; +} + + +sub fetchMsg { + +my $msgnum = shift; +my $mbx = shift; +my $conn = shift; +my $message; + + Log(" Fetching msg $msgnum...") if $debug; + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ( $response =~ /^1 NO|^1 BAD/ ) { + Log("$response"); + return 0; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " imap_to_maildir.pl -S Host/User/Password -u -M \n"; + print STDOUT " is the file directory to write the message structure\n"; + print STDOUT " Optional arguments:\n"; + print STDOUT " -d debug\n"; + print STDOUT " -I log IMAP commands\n"; + print STDOUT " -L logfile\n"; + print STDOUT " -m mailbox list (eg \"Inbox,Drafts,Notes\". Default is all mailboxes)\n"; + print STDOUT " -a copy only messages after this date\n"; + print STDOUT " -e Regular expression, eg -e \"Sales|Drafts|^Notes\""; + print STDOUT " -A \n"; + print STDOUT " -G source is Gmail; strip [Gmail] from folder names\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dS:L:m:u:M::hf:F:Ia:x,e:A:F:G" ) ) { + usage(); + } + + if ( $opt_S =~ /\\/ ) { + ($sourceHost, $sourceUser, $sourcePwd) = split(/\\/, $opt_S); + } else { + ($sourceHost, $sourceUser, $sourcePwd) = split(/\//, $opt_S); + } + + $username = $opt_u; + $maildir = $opt_M; + $mbxList = $opt_m; + $exclude = $opt_e; + $logfile = $opt_L; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $strip_gmail = 1 if $opt_G; + $sent_after = $opt_a; + $admin_user = $opt_A; + $msgs_per_folder = $opt_F; + + if ( !$maildir or !$username ) { + print "You must specify the username and the directory where the user's Maildir is located\n"; + print "For example: -u rick -M /mhub4/rick/Maildir.\n"; + usage(); + exit; + } + + if ( !-d $maildir ) { + # Create the maildir directory + make_path( $maildir ); + } + + validate_date( $sent_after ) if $sent_after; + + if ( $dump_flags ) { + foreach my $flag ( split(/,/, $dump_flags) ) { + $flag = ucfirst( lc($flag) ); + $flag = 'Seen' if $flag eq 'Read'; + $flag = 'Unseen' if $flag eq 'Unread'; + $dump_flags{$flag} = 1; + } + } + + if ( $extension ) { + $extension = '.' . $extension unless $extension =~ /^\./; + } + + usage() if $opt_h; + +} + +sub flags_ok { + +my $flags = shift; +my $ok = 0; + + # If the user has specified that only messages with + # certain flags be dumped then honor his request. + + return 1 unless %dump_flags; + + $flags =~ s/\\//g; + Log("flags $flags") if $debug; + foreach $flag ( split(/\s+/, $flags) ) { + $flag = ucfirst( lc($flag) ); + $ok = 1 if $dump_flags{$flag}; + } + + # Special case for Unseen messages for which there isn't a + # standard flag. + if ( $dump_flags{Unseen} ) { + # Unseen messages should be dumped too. + $ok = 1 unless $flags =~ /Seen/; + } + + return $ok; + +} + +sub validate_date { + +my $date = shift; +my $invalid; + + # Make sure the "after" date is in DD-MMM-YYYY format + + my ($day,$month,$year) = split(/-/, $date); + $invalid = 1 unless ( $day > 0 and $day < 32 ); + $invalid = 1 unless $month =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i; + $invalid = 1 unless $year > 1900 and $year < 2999; + if ( $invalid ) { + Log("The 'Sent after' date $date must be in DD-MMM-YYYY format"); + exit; + } + Log("Searching for messages after $date"); +} + +sub generate_filename { + +my $folder = shift; +my $size = shift; +my $rfc822_size = shift; +my $flags = shift; +my $status; +my $tries; +my $msgfn; +my $seen; + + # Get a unique filename + + Log("Generate a filename") if $debug; + $seen = ',S' if $flags =~ /Seen/; + + while( 1 ) { + my $now = time(); + my ($sec, $msec) = Time::HiRes::gettimeofday(); + + $msgfn = $sec . '.M' . $msec . 'P' . $$ . '.' . "$localhost,S=$size,W=$rfc822_size:2$seen"; + $msgfn = $folder . '/cur/' . $msgfn; + last if $tries++ > 100; + next if -e $msgfn; + } + + return $msgfn; + +} + +sub get_folder_name { + +my $maildir = shift; +my $mbx = shift; +my $delimiter = shift; +my $prefix = shift; + + # Convert an IMAP mailbox name to a Maildir folder name. IMAP mbxs + # are hierarchal while Maildir folders are flat and must start with + # a '.' character. + + Log("Convert IMAP mbx $mbx name to Maildir folder name") if $debug; + + my $folder = $maildir . '/'; + if ( uc( $mbx ) eq 'INBOX' ) { + # Inbox is special case + return $maildir; + } + + $delimiter = "\\." if $delimiter eq '.'; + + foreach my $term ( split(/$delimiter/, $mbx ) ) { + $folder .= '.' . $term; + } + + return $folder; +} + +sub build_folder { + +my $folder = shift; +my $username = shift; +my @subdirs = qw( new cur tmp ); + + Log("Create the directories for the $folder folder"); + + make_path( $folder ); + if ( !-d "$folder" ) { + Log("Error creating $folder"); + exit; + } + + foreach my $subdir ( @subdirs ) { + my $dir = "$folder/$subdir"; + make_path( "$dir" ) if !-d "$dir"; + if ( !-d "$dir" ) { + Log("Error creating $dir"); + exit; + } + } + + if ( $os !~ /Windows/i ) { + my $stat = `chown -R $username "$folder" 2>&1`; + if ( $stat ) { + Log("Failed to chown $username for $folder: $stat"); + exit; + } + } + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + diff --git a/S/imap_tools.V1.333/imapcopy.cf b/S/imap_tools.V1.333/imapcopy.cf new file mode 100644 index 0000000..41dd035 --- /dev/null +++ b/S/imap_tools.V1.333/imapcopy.cf @@ -0,0 +1,5 @@ +LOGFILE: imapcopy.log +IMAPCOPY: imapcopy.pl +PROCESS_LIMIT: 8 +DEBUG: 0 +SHOWIMAP: 0 diff --git a/S/imap_tools.V1.333/imapcopy.cgi b/S/imap_tools.V1.333/imapcopy.cgi new file mode 100644 index 0000000..a51e069 --- /dev/null +++ b/S/imap_tools.V1.333/imapcopy.cgi @@ -0,0 +1,598 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imapcopy.cgi,v 1.9 2014/08/18 15:17:22 rick Exp $ + +####################################################################### +# Program name imapcopy.cgi # +# Written by Rick Sanders # +# # +# Description # +# # +# imapcopy.cgi is used to manage the imapcopy.pl script in CGI # +# mode. # +####################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use IO::Socket; +use POSIX 'setsid'; +use Cwd; + + init(); + get_html(); + + # Check the source and dest logins in case the user has provided + # invalid credentials or host names + + test_logins(); + + # To prevent someone from seeing the passwords in ps pass them + # as ENV variables. + + $ENV{SOURCEPWD} = $sourcePwd; + $ENV{DESTPWD} = $destPwd; + + my $cmd = "$imapcopy "; + $cmd .= "-S $sourceHost/$sourceUser/SOURCEPWD "; + $cmd .= "-D $destHost/$destUser/DESTPWD "; + $cmd .= "-I " if $DEFAULTS{'SHOWIMAP'} == 1; + $cmd .= "-d " if $DEFAULTS{'DEBUG'} == 1; + $cmd .= "-L $logfile " if $logfile; + $cmd .= "-m \"$mbxList\" " if $mbxList; + $cmd .= "-e \"$excludeMbxs\" " if $excludeMbxs; + $cmd .= "-a $sent_after " if $sent_after; + $cmd .= "-b $sent_before " if $sent_before; + $cmd .= "-U " if $update; + $cmd .= "$DEFAULTS{ARGUMENTS} " if $DEFAULTS{ARGUMENTS}; + + launch_daemon( $cmd ); + + print STDOUT "
    Your copy job has been started. You will be notified when it has completed
    "; + + exit; + + +sub init { + + $os = $ENV{'OS'}; + + print "Content-type: text/html\n\n\n"; + print ''; + print ''; + print 'IMAP Copy'; + print ''; + + if ( -e "imapcopy.cf" ) { + open(CF, " ) { + chomp; + ($kw,$value) = split(/\s*:\s*/, $_, 2); + $DEFAULTS{$kw} = $value; + } + close CF; + + if ( $DEFAULTS{'IMAPCOPY'} ) { + $imapcopy = $DEFAULTS{'IMAPCOPY'}; + } else { + my $here = getcwd; + $imapcopy = "$here/imapcopy.pl"; + } + + $logfile = $DEFAULTS{'LOGFILE'}; + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + exit; + } + select(LOG); $| = 1; + } + Log("$0 starting"); + + $count = count_imapcopy_processes(); + if ( $DEFAULTS{PROCESS_LIMIT} ) { + exit if $count > $DEFAULTS{PROCESS_LIMIT}; + } + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + +} + +sub launch_daemon { + +my $cmd = shift; +my $parent = $$; +use POSIX 'setsid'; + + # The purpose of this routine is to launch imapcopy as a grandkid which detaches + # it from the Apache process so that it will not die if the user closes his browser. + + print STDOUT "Your copy job has been started. You will be notified when it has completed."; + + if ( !defined (my $kid = fork) ) { + print STDOUT "Cannot fork a child process: $!
    "; + Log("Cannot fork: $!"); + exit; + } + if ( $kid ) { + exit(0); + } else { + close STDIN; + close STDOUT; + close STDERR; + if ( !setsid ) { + Log("Cannot execute 'setsid', exiting"); + exit; + } + + umask(0027); # create files with perms -rw-r----- + if ( !chdir '/' ) { + Log("Can't chdir to /: $!"); + exit; + } + + if ( !(open STDIN, '<', '/dev/null') ) { + Log("Cannot redirect STDIN: $!"); + exit; + } + + if ( !(open STDOUT, '>', '/dev/null') ) { + Log("Cannot redirect STDOUT: $!"); + exit; + } + + if ( !(open STDERR, '>>', $logfile) ) { + Log("Cannot redirect STDERR to $logfile: $!"); + Log("Check the path and permissions on $logfile"); + exit; + } + + if ( !defined (my $grandkid = fork) ) { + exit; + } else { + if ( $grandkid != 0 and $$ != $parent ) { + Log("Execute $cmd"); + $rc = `$cmd`; + Log("rc = $rc"); + } + exit(0); + } + } +} + +sub get_html { + +my $fields = shift; +my $formData=0; + + # Get the HTML form values + # + my $query = new CGI; + + $sourceHost = $query->param('sourceHost'); + $sourceUser = $query->param('sourceUser'); + $sourcePwd = $query->param('sourcePwd'); + + $destHost = $query->param('destHost'); + $destUser = $query->param('destUser'); + $destPwd = $query->param('destPwd'); + + $mbxList = $query->param('mbxList'); + $excludeMbxs = $query->param('excludeMbxList'); + $sent_after = $query->param('sent_after'); + $sent_before = $query->param('sent_before'); + $update = $query->param('update'); + + $update = 1 if $update eq 'on'; + +} + +sub Log { + +my $str = shift; + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$str); + print LOG "$line"; + } + +} + + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $host = shift; +my $conn = shift; +my $method = shift; + + Log("method $method") if $debug; + + return 1 if $method eq 'PREAUTH'; # Server pre-authenticates users + + Log("Authenticating to $host as $user"); + if ( uc( $method ) eq 'CRAM-MD5' ) { + # A CRAM-MD5 login is requested + Log("login method $method"); + my $rc = login_cram_md5( $user, $pwd, $conn ); + return $rc; + } + + if ( $user =~ /(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + $sourceUser = $1; + $authuser = $2; + login_plain( $sourceUser, $authuser, $pwd, $conn ) or exit; + return 1; + } + + # Otherwise do an ordinary login + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Cyrus/i and $conn eq $dst ) { + Log("Destination is a Cyrus server"); + $cyrus = 1; + } + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + unless ( $exchange_override ) { + $exchange = 1; + Log("The destination is an Exchange server"); + } + } + last if $response =~ /^1 OK/i; + + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + + +sub login_cram_md5 { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + + Log("challenge $challenge") if $debug; + $response = cram_md5( $challenge, $user, $pwd ); + Log("response $response") if $debug; + + sendCommand ($conn, $response); + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Cyrus/i and $conn eq $dst ) { + Log("Destination is a Cyrus server"); + $cyrus = 1; + } + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# Make a connection to a IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + Timeout => 10, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + print STDOUT "Error: Can't connect to $host.
    "; + print STDOUT "Hit the Back button on your browser, correct the info, and try again."; + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + Timeout => 10, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + print STDOUT "Error: Can't connect to $host.
    "; + print STDOUT "Hit the Back button on your browser, correct the info, and try again."; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +sub test_logins { + + # Verify that we can log in at the source and destination before launching + # the copy job. + + print "

    "; + if ( !connectToHost($sourceHost, \$src) ) { + print STDOUT " Error: Can't connect to $sourceHost. Check that $sourceHost is correct.
    "; + print STDOUT "Hit the Back button on your browser, correct the info, and try again."; + exit; + } + if ( !login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) ) { + print STDOUT "Error: Can't login as $sourceUser. Check your username and password
    "; + print STDOUT "Hit the Back button on your browser, correct the info, and try again."; + exit; + } + if ( !connectToHost($destHost, \$dst) ) { + print STDOUT "Error: Can't connect to $destHost. Check that $destHost is correct.\n"; + print STDOUT "Hit the Back button on your browser, correct the info, and try again."; + exit; + } + if ( !login($destUser,$destPwd, $destHost, $dst, $dstMethod) ) { + print STDOUT "Error: Can't login as $destUser. Check your username and password
    "; + print STDOUT "Hit the Back button on your browser, correct the info, and try again."; + exit; + } + +} + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + + Log (">> $cmd") if $showIMAP; +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< $response") if $showIMAP; +} + +sub count_imapcopy_processes { + +my $count; + + # Count how many imapcopy processes are currently running + # and exit if the max has been reached. + + foreach $_ ( `ps -ef | grep imapcopy.pl` ) { + next unless /imapcopy.pl/; + next if /grep/; + $count++; + } + + $process_limit = $DEFAULTS{PROCESS_LIMIT}; + if ( $process_limit > 0 and $count > $process_limit ) { + print STDOUT "

    The maximum number of IMAP copies is already running. Please try again later.
    "; + } + return $count; + +} + diff --git a/S/imap_tools.V1.333/imapcopy.html b/S/imap_tools.V1.333/imapcopy.html new file mode 100644 index 0000000..ae5c4e0 --- /dev/null +++ b/S/imap_tools.V1.333/imapcopy.html @@ -0,0 +1,86 @@ + + +IMAPCOPY + + +
    + + + + + + +

    IMAPCOPY

    + +
    + + + + + + +
    Source server + + +
    Destination server + +
    Source username +Source password + +
    Destination username +Destination password +
    + +

    + + + + + + +
    Copy only these folders + folder1,folder2,... + +
    Exclude these folders + folder1,folder2,... + +
    After date + DD-MMM-YYYY + +
    Before Date + DD-MMM-YYYY + +
    Update Mode +
    +
    + +

    + + + +

    +After clicking on Submit the copy process will start. +Depending on the size of your +account it will take a few minutes or more to copy everything over. +When it finishes you will receive an e-mail notifying of the results. + +
    + + diff --git a/S/imap_tools.V1.333/imapcopy.pl b/S/imap_tools.V1.333/imapcopy.pl new file mode 100755 index 0000000..d6bd7d7 --- /dev/null +++ b/S/imap_tools.V1.333/imapcopy.pl @@ -0,0 +1,3133 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imapcopy.pl,v 1.160 2015/07/03 12:43:41 rick Exp $ + +####################################################################### +# Program name imapcopy.pl # +# Written by Rick Sanders # +# # +# Description # +# # +# imapcopy is a utility for copying a user's messages from one # +# IMAP server to another. # +# # +# imapcopy is called like this: # +# ./imapcopy -S host1/user1/password1 -D host2/user2/password2 # +# # +# Optional arguments: # +# -d debug # +# -I show IMAP protocol exchanges # +# -L logfile # +# -m mailbox list (copy only certain mailboxes,see usage notes) # +# -r reset the \DELETE flag on copied messages # +# -p put copied mailboxes under a root mbx # +# -M mailbox mapping (eg, src:inbox -> dst:inbox_copied) # +# -i initialize mailbox (remove existing msgs first) # +# -U run in "update" mode +# Run imapcopy.pl -h to see complete set of arguments. # +####################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use Time::Local; +eval 'use Encode qw/encode decode/'; +eval 'use Encode::IMAPUTF7 qw/encode decode/'; +no warnings 'utf8'; + +################################################################# +# Main program. # +################################################################# + + init(); + + # Get list of all messages on the source host + # + + connectToHost($sourceHost, \$src) or exit; + login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) or exit; + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + + connectToHost( $destHost, \$dst ) or exit; + login( $destUser,$destPwd, $destHost, $dst, $dstMethod ) or exit; + namespace( $dst, \$dstPrefix, \$dstDelim, $opt_y ); + + @mbxs = getMailboxList( $srcPrefix, $src ); + + if ( $dovecot_mbox_format ) { + # Both the source and destination are dovecot servers with a mbox + # database. The mailboxes must be created in a special fashion). + create_dovecot_mbxs( \@mbxs, $dst ); + } + + get_dest_mailboxes( \%DST_MBXS, $dst ); + if ( $debug ) { + Log("LIST THE DST MAILBOXES"); + foreach $dstmbx ( keys %DST_MBXS ) { + Log(" dstmbx $dstmbx"); + } + } + + # Exclude certain mbxs if that's what the user wants + if ( $excludeMbxs or $excludeMbxs_regex ) { + exclude_mbxs( \@mbxs, $src ); + } + + map_mbx_names( \%mbx_map, $srcDelim, $dstDelim ); + + if ( $archive_dst_mbx ) { + # Create an archive mbx on the destination to receive copies of messsages + $stat = createMbx( $archive_dst_mbx, $dst ); + } + if ( $archive_src_mbx ) { + # Create an archive mbx on the source to receive copies of messsages + $stat = createMbx( $archive_src_mbx, $src ); + } + + if ( $msgid_dbm_dir ) { + # Open a DBM to record msgids we copy + openDBM( $sourceUser ); + } + + $total=$mbxs_processed = 0; + my $delete_msg_list; + $num_mbxs = $#mbxs + 1; + Log("Number of mailboxes to process: $num_mbxs"); + foreach $_ ( @mbxs ) { Log(" $_") if $debug; } + + if ( $root_mbx ) { + $rmbx = $dstPrefix . $root_mbx; + unless ( $DST_MBXS{"$rmbx"} ) { + $stat = createMbx( $rmbx, $dst ); + next if !$stat; + } + } + + if ( $num_children ) { + @summary = copy_folders_parallel( \@mbxs ); + } else { + foreach $srcmbx ( @mbxs ) { + $copied = copy_folder( $srcmbx, $src, $dst ); + push( @summary, "Copied $copied messages from $srcmbx"); + expungeMbx( $srcmbx, $src ) if $update_rm_src_msg; + } + } + + Log("Done."); + Log("Summary"); + Log("Copied $total total messages"); + foreach $_ ( @summary ) { + Log(" $_"); + } + + if ( $ENV{'HTTP_CONNECTION'} ) { + @too_large_1 = @too_large; + notify_user( $sourceUser, $src, \@too_large, \@mbx_errors ); + notify_user( $destUser, $dst, \@too_large_1, \@mbx_errors ); + } + + logout( $src ); + logout( $dst ); + + exit; + + +sub init { + + $os = $ENV{'OS'}; + + processArgs(); + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + exit; + } + select(LOG); $| = 1; + } + Log("$0 starting"); + + Log("Running in update mode") if $update; + Log("Messages on the dest which are not on the source will be purged") if $del_from_dest; + Log("Only Seen messages will be copied") if $skip_unread; + Log("Only message headers will be copied") if $header_only; + Log("Messages will be removed from the source after they have been copied") if $rem_src_msgs; + Log("Duplicate msgs on the source will not be copied") if $dont_copy_source_dups; + + if ( $special_search ) { + if ( $special_search !~ /SINCE|BEFORE/ ) { + Log("Error: Special search operators are SINCE and BEFORE."); + exit; + } + Log("Only those messages matching the date criteria $special_search will be copied"); + } + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + if ( $num_children ) { + if ( $OS =~ /Windows/i ) { + Log("The -Y option is not supported on Windows"); + exit; + } + eval 'use Parallel::ForkManager'; + if ( $@ ) { + Log("In order to run multiple copy processes you must install the Parallel::ForkManager Perl module."); + exit; + } + Log("Running in parallel mode, number of children = $num_children"); + } + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + + if ( -e "imapcopy.skip" ) { + $skip_msgids = 1; + # Read a file of message-ids we were to skip + open( F, " ) { + chomp; + Log("putting $_ in skip file"); + $SKIP{"$_"} = 1; + } + close F; + } +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + # If we've had to reconnect use the new connection + if ( $CONNECTIONS{"$fd"} ) { + $fd = $CONNECTIONS{"$fd"}; + Log("Using the new connection $fd"); + } + + print $fd "$cmd\r\n"; + + Log (">> $cmd") if $showIMAP; +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + # If we've had to reconnect use the new connection + if ( $CONNECTIONS{"$fd"} ) { + $fd = $CONNECTIONS{"$fd"}; + Log("Using the new connection $fd"); + } + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< $response") if $showIMAP; + + if ( $response =~ /\* BAD internal server error/i ) { + Log("Fatal IMAP server error: $response"); + exit; + } + + if ( $exchange and $response =~ /^1 NO|^1 BAD/ ) { + $errors++; + exchange_workaround() if $errors == 9; + } + + if ( $response =~ /connection closed/i ) { + ($src,$dst) = reconnect(); + } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logfile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $str =~ /^\>\> 1 LOGIN (.+) "(.+)"/ ) { + # Obscure the password for security's sake + $str = ">> 1 LOGIN $1 XXXXX"; + } + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$str); + print LOG "$line"; + } + + select(STDOUT); $| = 1; + print STDOUT "$str\n" unless $quiet_mode; + + $summary .= "$str\r\n"; + +} + +sub today { + + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + my $today = sprintf ("%.2d-%.2d-%d", $mon + 1, $mday, $year + $yr); + return $today; +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if necessary + + return 1 if uc( $mbx ) eq 'INBOX'; # Don't need to create an Inbox; it always exists + + my $status = 1; + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + Log ("Error creating $mbx: $response"); + push( @mbx_errors, "$mbx: $response"); + $status = 0; + last; + } + if ( $response eq '' or $response =~ /^1 NO/ ) { + Log ("unexpected CREATE response: >$response<"); + Log("response is NULL"); + ($src,$dst) = reconnect(); + last; + } + + } + + return $status; +} + +# insertMsg +# +# This routine inserts a message into a user's mailbox +# +sub insertMsg { + +local ($conn, $mbx, *message, $flags, $date) = @_; +local ($lenx); + + $lenx = length($message); + + Log(" Inserting message") if $debug; + + $totalBytes = $totalBytes + $lenx; + $totalMsgs++; + + $flags = flags( $flags ); + fixup_date( \$date ); + +if ( $CONNECTIONS{"$conn"} ) { + $conn = $CONNECTIONS{"$conn"}; + Log("Using the new connection $conn"); +} + + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + readResponse ($conn); + + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: >$response<"); + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our session"); + exit; + } + + if ( $response eq '' ) { + Log("response is NULL"); + ($src,$dst) = reconnect(); + next; + } + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$message\r\n"; + + undef @response; + my $loops; + while ( 1 ) { + readResponse ($conn); + $loops++; + exit if $loops > 9; + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + + if ( $response eq '' ) { + Log("response is NULL"); + ($src,$dst) = reconnect(); + } + next; + } + } + + return 1; +} + +# Make a connection to a IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + # Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $host = shift; +my $conn = shift; +my $method = shift; + + Log("method $method") if $debug; + + return 1 if $method eq 'PREAUTH'; # Server pre-authenticates users + + Log("Authenticating to $host as $user") if $debug; + if ( uc( $method ) eq 'CRAM-MD5' ) { + # A CRAM-MD5 login is requested + Log("login method $method"); + my $rc = login_cram_md5( $user, $pwd, $conn ); + return $rc; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + if ( lc( $host ) eq 'imap.gmail.com:993' ) { + # Use AUTHENTICATE PLAIN with Gmail + login_plain( $user, $user, $pwd, $conn ) or exit; + return 1; + } + + if ( $user =~ /(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + $sourceUser = $1; + $authuser = $2; + login_plain( $sourceUser, $authuser, $pwd, $conn ) or exit; + return 1; + } + + # Otherwise do an ordinary login + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Cyrus/i and $conn eq $dst ) { + Log("Destination is a Cyrus server"); + $cyrus = 1; + } + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + unless ( $exchange_override ) { + $exchange = 1; + Log("The destination is an Exchange server"); + } + } + last if $response =~ /^1 OK/i; + + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + + +sub login_cram_md5 { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + + Log("challenge $challenge") if $debug; + $response = cram_md5( $challenge, $user, $pwd ); + Log("response $response") if $debug; + + sendCommand ($conn, $response); + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Cyrus/i and $conn eq $dst ) { + Log("Destination is a Cyrus server"); + $cyrus = 1; + } + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + exit; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $prefix = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes",2) if $debugMode; + + if ( $mbxList ) { + foreach $mbx ( split(/,/, $mbxList) ) { + $mbx = encode( 'IMAP-UTF-7', $mbx ) unless isAscii( $srcmbx ); + # $mbx = $prefix . $mbx if $prefix; + if ( $opt_R ) { + # Get all submailboxes under the ones specified + $mbx .= '*'; + @mailboxes = listMailboxes( $mbx, $conn); + push( @mbxs, @mailboxes ); + } else { + push( @mbxs, $mbx ); + } + } + } else { + # Get all mailboxes + @mbxs = listMailboxes( '*', $conn); + } + + return @mbxs; +} + +# exclude_mbxs +# +# Exclude certain mailboxes from the list if the user has provided an +# exclude list of complete mailbox names with the -e argument. He may +# also supply a list of regular expressions with the -g argument +# which we will process separately. + +sub exclude_mbxs { + +my $mbxs = shift; +my $conn = shift; +my @new_list; +my %exclude; +my (@regex_excludes,@final_list); + + # Do the exact matches first + + if ( $excludeMbxs ) { + foreach my $exclude ( split(/,/, $excludeMbxs ) ) { + if ( $opt_R ) { + # Include all submailboxes + $exclude .= '*'; + @mailboxes = listMailboxes( $exclude, $conn); + foreach $_ ( @mailboxes ) { + Log("Excluding $_") if $debug; + $exclude{"$_"} = 1; + } + } else { + Log("Excluding $exclude") if $debug; + $exclude{"$exclude"} = 1; + } + } + foreach my $mbx ( @$mbxs ) { + next if $exclude{"$mbx"}; + push( @new_list, $mbx ); + } + @$mbxs = @new_list; + } + + # Next do the regular expressions if any + my %excludes; + @new_list = (); + if ( $excludeMbxs_regex ) { + my @regex_excludes; + foreach $_ ( split(/,/, $excludeMbxs_regex ) ) { + push( @regex_excludes, $_ ); + } + foreach my $mbx ( @$mbxs ) { + foreach $_ ( @regex_excludes ) { + if ( $mbx =~ /$_/ ) { + $excludes{"$mbx"} = 1; + } + } + } + foreach my $mbx ( @$mbxs ) { + push( @new_list, $mbx ) unless $excludes{"$mbx"}; + } + @$mbxs = @new_list; + } + + @new_list = (); + +} + +# listMailboxes +# +# Get a list of the user's mailboxes +# +sub listMailboxes { + +my $mbx = shift; +my $conn = shift; +my @mbxs; + + sendCommand ($conn, "1 LIST \"\" \"$mbx\""); + undef @response; + while ( 1 ) { + &readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + &Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $mode = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $msgid; +my %MESSAGEIDS; + + @$msgs = (); + $mode = 'SELECT' unless $mode; + sendCommand ($conn, "1 $mode \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + return 1 if $empty; + + my $start = 1; + my $end = '*'; + $start = $start_fetch if $start_fetch; + $end = $end_fetch if $end_fetch; + + if ( $msgs_per_folder ) { + $start = 1; + $end = $msgs_per_folder; + } + + sendCommand ( $conn, "1 FETCH $start:$end (uid flags internaldate RFC822.SIZE body.peek[header.fields (From Date Message-Id Subject)])"); + + @response = (); + my $nulls; + while ( 1 ) { + readResponse ( $conn ); + + if ( $response eq '' ) { + $nulls++; + if ( $nulls > 9 ) { + Log("server has stopped responding after $nulls loops"); + ($src,$dst) = reconnect(); + return 0; + } + } else { + $nulls = 0; + } + + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response"); + exit; + } + } + + $flags = ''; + my $nulls; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ( $response[$i] eq '' ) { + $nulls++; + if ( $nulls > 9 ) { + Log("server has stopped responding after $nulls loops"); + ($src,$dst) = reconnect(); + return 0; + } + } else { + $nulls = 0; + } + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response[$i]"); + Log("msgnum $msgnum"); + exit; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE (.+) RFC822\.SIZE/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } elsif ( $response[$i] =~ /INTERNALDATE "(.+)" BODY/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } elsif ( $response[$i] =~ /INTERNALDATE "(.+)" FLAGS/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /RFC822\.SIZE/i) { + # $response[$i] =~ /RFC822\.SIZE ([0-9]+) BODY/i; + $response[$i] =~ /RFC822\.SIZE ([0-9]+) /i; + $size = $1; + } + + if ( $response[$i] =~ /From:\s*(.+)/i) { + $from = $1; + } + if ( $response[$i] =~ /Date:\s*(.+)/i) { + $header_date = $1; + } + + if ( $response[$i] =~ /Subject: (.+)/i) { + $subject = $1; + } + + if ( $response[$i] =~ /^Message-Id:/i ) { + $response[$i] =~ /^Message-Id: (.+)/i; + $msgid = $1; + trim(*msgid); + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + # if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) { + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + if ( $msgid eq '' ) { + # The message lacks a message-id so construct one. + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)//g; + Log("msgnum $msgnum has no msgid, build one as $msgid") if $debug; + } + + if ( $skip_msgids ) { + # The user said to not copy this message + if ( $SKIP{"$msgid"} ) { + Log("Skipping $msgid because it's in the imapcopy.skip file"); + next; + } + } + + push (@$msgs,"$msgnum|$date|$flags|$msgid|$size|$header_date"); + $msgnum = $date = $flags = $msgid = $from = $subject = $header_date = ''; + } + } + + return 1; + +} + +# getDatedMsgList +# +# Get a list of the user's messages in a mailbox on +# the host which were sent after the specified date +# + +sub getDatedMsgList { + +my $mailbox = shift; +my $sent_before = shift; +my $sent_after = shift; +my $msgs = shift; +my $conn = shift; +my ($seen, $empty, @list,$msgid); + + # Get a list of messages sent in the range specified by $sent_before + # and $sent_after + + if ( $sent_before and $sent_after ) { + $search = "(SINCE $sent_after) (BEFORE $sent_before)"; + } elsif ( $sent_after ) { + $search = "SINCE $sent_after"; + } elsif ( $sent_before ) { + $search = "BEFORE $sent_before"; + } + + Log("Searching for messsages $search"); + + @list = (); + @$msgs = (); + + sendCommand ($conn, "1 SELECT \"$mailbox\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ / EXISTS/i) { + $response =~ /\* ([^EXISTS]*)/; + } elsif ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO/i ) { + Log ("unexpected response: $response"); + return 0; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + my ($date,$ts) = split(/\s+/, $cutoff_date); + + # + # Get list of messages sent before/after the reference date + # + Log("Get messages sent $operator $date") if $debug; + $nums = ""; + sendCommand ($conn, "1 SEARCH $search"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response =~ /^\*\s+SEARCH/i ) { + ($nums) = ($response =~ /^\*\s+SEARCH\s+(.*)/i); + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected SEARCH response: $response"); + return; + } + } + Log("$nums") if $debug; + if ( $nums eq "" ) { + Log (" $mailbox has no messages $search") if $debug; + return; + } + my @number = split(/\s+/, $nums); + $n = $#number + 1; + + $nums =~ s/\s+/ /g; + @msgList = (); + @msgList = split(/ /, $nums); + + if ($#msgList == -1) { + # No msgs in this mailbox + return 1; + } + +@$msgs = (); +for $num (@msgList) { + + # sendCommand ( $conn, "1 FETCH $num (uid flags internaldate body[header.fields (Message-Id Date)])"); + sendCommand ( $conn, "1 FETCH $num (uid flags internaldate RFC822.SIZE body.peek[header.fields (Message-Id Date)])"); + + @response = (); + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + $flags = ''; + my $msgid; + foreach $_ ( @response ) { + last if /^1 OK FETCH complete/i; + if ( /FLAGS/ ) { + # Get the list of flags + /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( /Message-ID:\s*(.*)/i ) { + $msgid = $1; + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + if ( /INTERNALDATE/i) { + # /INTERNALDATE (.+) BODY/i; + # /INTERNALDATE (.+) RFC822\.SIZE/i; + /INTERNALDATE (.+) [RFC822\.SIZE|BODY|FLAGS]/i; + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + #### next if check_cutoff_date( $date, $cutoff_date ); + } + + if ( /RFC822\.SIZE/i) { + /RFC822\.SIZE ([0-9]+) BODY/i; + $size = $1; + } + + if ( /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( /^\)/ or /\)\)$/ ) { + push (@$msgs,"$msgnum|$date|$flags|$msgid|$size"); + $msgnum=$msgid=$date=$flags=$size=''; + } + + } + } + + foreach $_ ( @$msgs ) { + Log("getDated found $_") if $debug; + } + + return 1; +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub fetchMsg { + +my $msgnum = shift; +my $size = shift; +my $message = shift; +my $mbx = shift; +my $conn = shift; + + Log(" Fetching msg $msgnum ($size bytes)...") if $debug; + + if ( $header_only ) { + $item = 'RFC822.HEADER'; + } else { + $item = 'RFC822'; + # Some servers don't do 'RFC822' correctly + $item = 'BODY[]'; + } + + if ( $CONNECTIONS{"$conn"} ) { + $fd = $CONNECTIONS{"$conn"}; + Log("Using the new connection $conn"); + } + + $$message = ''; + sendCommand( $conn, "1 FETCH $msgnum ($item)"); + my $nulls; + while (1) { + readResponse ($conn); + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + + if ( $response eq '' ) { + $nulls++; + if ( $nulls > 9 ) { + Log("RESP2 >$response<"); + ($src,$dst) = reconnect(); + return 0; + } + } else { + $nulls = 0; + } + + if ( $response =~ /^1 OK/i ) { + $size = length($$message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{[0-9]+\}/i) { + $item =~ s/BODY\[\]/BODY\\[\\]/ if $response =~ /BODY/; + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + + if ( $CONNECTIONS{"$conn"} ) { + $conn = $CONNECTIONS{"$conn"}; + Log("Using the new connection $conn"); + } + + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + ($src,$dst) = reconnect(); + return 0; + } + + strip_mult_line_terminators( \$segment ) if $strip_mult_line_terminators; + + $$message .= $segment; + $cc += $n; + } + } + } + + return 1; +} + + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " imapcopy -S sourceHost/sourceUser/sourcePassword [/CRAM-MD5]\n"; + print STDOUT " -D destHost/destUser/destPassword [/CRAM-MD5]\n"; + print STDOUT " (if the password is an OAUTH2 token prefix it with 'oauth2:'\n"; + print STDOUT " -d debug\n"; + print STDOUT " -I show IMAP protocol exchanges\n"; + print STDOUT " -L logfile\n"; + print STDOUT " -m mailbox list (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n"; + print STDOUT " -R include submailboxes when used with -m\n\n"; + print STDOUT " -e exclude mailbox list (using exact matches)\n"; + print STDOUT " -g exclude mailbox list (using regular expressions)\n"; + print STDOUT " -C remove msgs from source mbx after copying\n"; + print STDOUT " -p put copied mailboxes under a root mailbox\n"; + print STDOUT " -A copy to local mailbox from scrmbx\n"; + print STDOUT " -o put all messages in this mbx on the destination\n"; + print STDOUT " -x source (eg, -x '. INBOX.'\n"; + print STDOUT " -y destination\n"; + print STDOUT " -i initialize mailbox (remove existing messages first\n"; + print STDOUT " -M mailbox map file. Maps src mbxs to dst mbxs. "; + print STDOUT "Each line in the file should be 'src mbx:dst mbx'\n"; + print STDOUT " -q quiet mode (still writes to the logfile)\n"; + print STDOUT " -t \n"; + print STDOUT " -T copy custom flags (eg, \$Label1,\$MDNSent,etc)\n"; + print STDOUT " -a copy only messages after this date\n"; + print STDOUT " -b copy only messages before this date\n"; + print STDOUT " -X Skip any message exceeding this size\n"; + print STDOUT " -U update mode, don't copy messages that already exist\n"; + print STDOUT " -s In update mode delete messages from the destination which don't exist on the source\n"; + print STDOUT " -B Starting point for message fetch\n"; + print STDOUT " -E Ending point for message fetch\n"; + print STDOUT " -u Don't copy unread (Unseen) messages\n"; + print STDOUT " -H copy message headers only\n"; + print STDOUT " -Z Record the msgids for copied messages in a DBM file at this location (eg -Z ). Used to prevent copying dups messages.\n"; + print STDOUT " -j Display count every msgs\n"; + print STDOUT " -z Don't require messsages to have Message-IDs in the header\n"; + print STDOUT " -G source is Gmail, strip the '[Gmail]' prefix from mailbox names\n"; + print STDOUT " -c destination is Cyrus, fix the line terminator characters\n"; + print STDOUT " -Y number of processes to run in parallel\n"; + print STDOUT " -f In Update mode remove messages from the source if they exist on the destination\n"; + print STDOUT " -l Duplicate messages on the source will not be copied\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dS:D:L:m:hIp:M:rqx:y:e:Rt:Tia:b:X:vP:A:UB:E:uHzZ:j:g:CsnWwGF:cK:Y:kfQJ:lo:OV" ) ) { + # Remaining args: N + usage(); + } + if ( $opt_S =~ /\\/ ) { + ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\\/, $opt_S); + } else { + ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\//, $opt_S); + } + + if ( $opt_D =~ /\\/ ) { + ($destHost, $destUser, $destPwd,$dstMethod) = split(/\\/, $opt_D); + } else { + ($destHost, $destUser, $destPwd,$dstMethod) = split(/\//, $opt_D); + } + + # If the source and destination passwords have been passed as ENV vars + # then use them. + + $sourcePwd = $ENV{SOURCEPWD} if $sourcePwd eq 'SOURCEPWD'; + $destPwd = $ENV{DESTPWD} if $destPwd eq 'DESTPWD'; + + $mbxList = $opt_m; + $logfile = $opt_L; + $root_mbx = $opt_p; + $timeout = $opt_t; + $tags = $opt_T; + $debug = 1 if $opt_d; + $verbose = 1 if $opt_v; + $showIMAP = 1 if $opt_I; + $submbxs = 1 if $opt_R; + $init_mbx = 1 if $opt_i; + $header_only = 1 if $opt_H; + $quiet_mode = 1 if $opt_q; + $skip_unread = 1 if $opt_u; + $update = 1 if $opt_U; + $del_from_dest = 1 if $opt_s; + $rem_src_msgs = 1 if $opt_C; + $exchange_override = 1 if $opt_w; + $dovecot_mbox_format = 1 if $opt_O; + $cyrus = 1 if $opt_c; + $mbx_map_fn = $opt_M; + $excludeMbxs = $opt_e; + $excludeMbxs_regex = $opt_g; + $sent_after = $opt_a; + $sent_before = $opt_b; + $max_size = $opt_X; + $public_mbxs = $opt_P; + $archive_src_mbx = $opt_A; + $archive_dst_mbx = $opt_o; + $start_fetch = $opt_B; + $end_fetch = $opt_E; + $progress = $opt_j; + $msgid_dbm_dir = $opt_Z; + $wrap_long_lines = 1 if $opt_W; + $dont_need_msgid = 1 if $opt_z; + # -n deprecated. + # $include_nosel_mbxs = 1 if $opt_n; + $gmail_source = 1 if $opt_G; + $timeout = 300 unless $timeout; + $msgs_per_folder = $opt_F; + $rem_src_msgs = 1 if $opt_r; + $create_form = $opt_K; + $num_children = $opt_Y; + # $strip_mult_line_terminators = 1 if $opt_k; + $update_rm_src_msg = 1 if $opt_f; + $reset_unseen = 1 if $opt_Q; + $special_search = $opt_J; + $dont_copy_source_dups = 1 if $opt_l; + + if ( $opt_Z ) { + unless ( -d $opt_Z ) { + print STDERR "The directory given by -Z $opt_Z does not exist\n"; + exit; + } + } + validate_date( $sent_after ) if $sent_after; + validate_date( $sent_before ) if $sent_before; + + $sourcePwd = prompt_for_pwd( 'source' ) if $sourcePwd eq 'PROMPT'; + $destPwd = prompt_for_pwd( 'dest' ) if $destPwd eq 'PROMPT'; + + usage() if $opt_h; + +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; + + # Some IMAP clients such as Outlook and Netscape) do not automatically list + # all mailboxes. The user must manually subscribe to them. This routine + # does that for the user by marking the mailbox as 'subscribed'. + + # Workaround for a certain customer + $mbx =~ s/^INBOX.INBOX/INBOX/; + + sendCommand( $conn, "1 SUBSCRIBE \"$mbx\""); + my $loops; + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + Log("Mailbox $mbx has been subscribed") if $debug; + last; + } elsif ( $response =~ /^1 NO|^1 BAD|\^* BYE/i ) { + Log("Unexpected response to subscribe $mbx command: $response"); + last; + } + last if $loops++ > 99; + } + + # Now select the mailbox + sendCommand( $conn, "1 SELECT \"$mbx\""); + my $loops; + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to SELECT $mbx command: $response"); + last; + } +last if $response =~ /\+ OK/i; + last if $loops++ > 99; + } + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; +my $substChar = '_'; + + if ( $public_mbxs ) { + my ($public_src,$public_dst) = split(/:/, $public_mbxs ); + # If the mailbox starts with the public mailbox prefix then + # map it to the public mailbox destination prefix + + if ( $srcmbx =~ /^$public_src/ ) { + Log("src: $srcmbx is a public mailbox") if $debug; + $dstmbx = $srcmbx; + $dstmbx =~ s/$public_src/$public_dst/; + Log("dst: $dstmbx") if $debug; + return $dstmbx; + } + } + + # Change the mailbox name if the user has supplied mapping rules. + + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + unless ( $srcmbx =~ /\[Gmail]\// ) { + if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + $srcmbx =~ s/^$srcPrefix//; + # $srcmbx =~ s/\\$srcDelim/\//g; + $srcmbx =~ s/\\$srcDelim/$dstDelim/g; + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + # $dstmbx = $srcmbx; + if ( lc( $srcmbx ) eq 'inbox' ) { + $dstmbx = $srcmbx; + } else { + $dstmbx = $srcPrefix . $srcmbx; + } + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + + # $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx unless uc( $srcmbx ) eq 'INBOX'; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + + # if ( uc($srcmbx) eq 'INBOX' ) { + # # Special case for the INBOX + # $dstmbx =~ s/INBOX$//i; + # $dstmbx =~ s/$dstDelim$//; + # } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub flags { + +my $flags = shift; +my @newflags; +my $newflags; +my %standard_flags = ( + '\\Seen', 1, '\\Deleted', 1, '\\Draft', 1, + '\\Answered', 1, '\\Flagged', 1, '\\Recent', 1, + '\\SEEN', 1, '\\DELETED', 1, '\\DRAFT', 1, + '\\ANSWERED', 1, '\\FLAGGED', 1, '\\RECENT', 1 ); + + # Make sure the flags list contains standard + # IMAP flags and optionally custom tags + + return unless $flags; + + $flags =~ s/\\Recent//i; + foreach $_ ( split(/\s+/, $flags) ) { + # push( @newflags, $_ ) if substr($_,0,1) eq '\\'; + if ( substr($_,0,1) eq '\\' ) { + # Should be a standard flag. Make sure it is. + push( @newflags, $_ ) if $standard_flags{$_}; + } + if ( $opt_T ) { + # Include user-defined flags + push( @newflags, $_ ) if substr($_,0,1) eq '$'; + } + } + + $newflags = join( ' ', @newflags ); + + $newflags =~ s/\\Deleted//ig if $opt_r; + $newflags =~ s/^\s+|\s+$//g; + + return $newflags; +} + +sub map_mbx_names { + +my $mbx_map = shift; +my $srcDelim = shift; +my $dstDelim = shift; + + # The -M argument causes imapcopy to read the + # contents of a file with mappings between source and + # destination mailbox names. This permits the user to + # to change the name of a mailbox when copying messages. + # + # The lines in the file should be formatted as: + # : + # For example: + # Drafts/2008/Save: Draft_Messages/2008/Save + # Action Items: Inbox + # + # Note that if the names contain non-ASCII characters such + # as accents or diacritical marks then the Perl module + # Encode::IMAPUTF7 module must be installed. + + return unless $mbx_map_fn; + + unless ( open(MAP, "<$mbx_map_fn") ) { + Log("Error opening mbx map file $mbx_map_fn: $!"); + exit; + } + while( ) { + chomp; + s/[\r\n]$//; # In case we're on Windows + s/^\s+//; + next if /^#/; + next unless $_; + ($srcmbx,$dstmbx) = split(/\s*:\s*/, $_); + + # Unless the mailbox name is entirely ASCII we'll have to use + # the Modified UTF-7 character set. + $srcmbx = encode( 'IMAP-UTF-7', $srcmbx ) unless isAscii( $srcmbx ); + $dstmbx = encode( 'IMAP-UTF-7', $dstmbx ) unless isAscii( $dstmbx ); + + $srcmbx =~ s/\//$srcDelim/g unless $srcDelim eq '_'; + $dstmbx =~ s/\//$dstDelim/g; + + $$mbx_map{"$srcmbx"} = $dstmbx; + + } + close MAP; + +# if ( $use_utf7 ) { +# if ( $@ ) { +# Log("At least one mailbox map contains non-ASCII characters. This means you"); +# Log("have to install the Perl Encode::IMAPUTF7 module in order to map mailbox "); +# Log("names between the source and destination servers."); +# print "At least one mailbox map contains non-ASCII characters. This means you\n"; +# print "have to install the Perl Encode::IMAPUTF7 module in order to map mailbox\n"; +# print "names between the source and destination servers.\n"; +# exit; +# } +# } + + my %temp; + foreach $srcmbx ( keys %$mbx_map ) { + $dstmbx = $$mbx_map{"$srcmbx"}; + Log("Mapping src:$srcmbx to dst:$dstmbx"); + $srcmbx = encode( 'IMAP-UTF-7', $srcmbx ) unless isAscii( $srcmbx ); + $dstmbx = encode( 'IMAP-UTF-7', $dstmbx ) unless isAscii( $dstmbx ); + $temp{"$srcmbx"} = $dstmbx; + } + %$mbx_map = %temp; + %temp = (); + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + +# Reconnect to the servers after a timeout error. +# +sub reconnect { + + Log("Attempting to reconnect"); + + Log("Sleeping 10 seconds"); + sleep 10; + + $old_src = $src; + $old_dst = $dst; + + close $src; + close $dst; + + connectToHost($sourceHost,\$src); + login($sourceUser,$sourcePwd,$sourceHost,$src); + selectMbx( $srcmbx, $src ); + + connectToHost($destHost,\$dst); + login($destUser,$destPwd,$destHost,$dst); + + createMbx( $dstmbx, $dst ) unless $DST_MBXS{"$dstmbx"}; + selectMbx( $dstmbx, $dst ); + + Log("Reconnected"); + alarm 0; + + Log("reconnect NEW SRC = $src"); + Log("reconnect NEW DST = $dst"); + + $CONNECTIONS{"$old_src"} = $src; + $CONNECTIONS{"$old_dst"} = $dst; + + return ($src,$dst); + +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + ($src,$dst) = reconnect(); + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } + Log("Resuming"); +} + +sub fixup_date { + +my $date = shift; +my ($hrs,$dom); + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. Same for the DOM. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + $hrs = $2; + ($dom) = split(/-/, $$date, 2); + + if ( length( $hrs ) == 1 ) { + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + $hrs = $2; + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + } + if ( length( $dom ) == 1 ) { + $$date =~ s/^\s+//; + my $newdom = '0' . $dom if length( $dom ) == 1; + $$date =~ s/^$dom/$newdom/; + } + +} + +sub init_mbx { + +my $mbx = shift; +my $conn = shift; +my @msgs; + + # Remove all messages from a mailbox + + Log("Initializing mailbox $mbx"); + getMsgList( $mbx, \@msgs, $conn, 'SELECT' ); + my $msgcount = $#msgs + 1; + Log("$mbx has $msgcount messages"); + + return if $msgcount == 0; # No messages to delete + + foreach my $msgnum ( @msgs ) { + ($msgnum) = split(/\|/, $msgnum); + delete_msg( $msgnum, $conn ); + } + expungeMbx( $mbx, $conn ); + +} + +sub delete_msg_list { + +my $msgnums = shift; +my $mbx = shift; +my $conn = shift; +my $rc; + + # Mark a set of messages for deletion + + selectMbx( $mbx, $conn ); + + foreach my $msgnum ( split(/\s+/, $msgnums ) ) { + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msg number $msgnum for delete") if $debug; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + } + + return $rc; + +} + +sub cram_md5 { + +my $challenge = shift; +my $user = shift; +my $password = shift; + +eval 'use Digest::HMAC_MD5 qw(hmac_md5_hex)'; +use MIME::Base64 qw(decode_base64 encode_base64); + + # Adapated from script by Paul Makepeace , 2002-10-12 + # Takes user, key, and base-64 encoded challenge and returns base-64 + # encoded CRAM. See, + # IMAP/POP AUTHorize Extension for Simple Challenge/Response: + # RFC 2195 http://www.faqs.org/rfcs/rfc2195.html + # SMTP Service Extension for Authentication: + # RFC 2554 http://www.faqs.org/rfcs/rfc2554.html + # Args: tim tanstaaftanstaaf PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+ + # should yield: dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw + + my $challenge_data = decode_base64($challenge); + my $hmac_digest = hmac_md5_hex($challenge_data, $password); + my $response = encode_base64("$user $hmac_digest"); + chomp $response; + + if ( $debug ) { + Log("Challenge: $challenge_data"); + Log("HMAC digest: $hmac_digest"); + Log("CRAM Base64: $response"); + } + + return $response; +} + +sub validate_date { + +my $date = shift; +my $invalid; + + # Make sure the "after" date is in DD-MMM-YYYY format + + my ($day,$month,$year) = split(/-/, $date); + $invalid = 1 unless ( $day > 0 and $day < 32 ); + $invalid = 1 unless $month =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i; + $invalid = 1 unless $year > 1900 and $year < 2999; + if ( $invalid ) { + Log("The 'Sent after' date $date must be in DD-MMM-YYYY format"); + exit; + } +} + +sub commafy { + +my $number = shift; + + $_ = $$number; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + + $$number = $_; + +} + +sub delete_msg { + +my $msgnum = shift; +my $conn = shift; +my $rc; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msg number $msgnum for delete") if $debug; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + + +# getMsgIdList +# +# Get a list of the user's messages in a mailbox +# +sub getMsgIdList { + +my $mailbox = shift; +my $msgids = shift; +my $conn = shift; +my $empty; +my $msgnum; +my $from; +my $msgid; +my $MESSAGEIDS; +my $msgcount=0; + + %$msgids = (); + sendCommand ($conn, "1 SELECT \"$mailbox\""); + undef @response; + $empty=0; + my $loops; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /\* (.+) EXISTS/i ) { + $msgcount = $1; + $empty=1 if $msgcount == 0; + } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + last if $loops++ > 10; + } + + if ( $empty ) { + return 0 ; + } + + Log("There are $msgcount messages in the mailbox"); + + Log("Fetch the header info") if $debug; + + # sendCommand ( $conn, "1 FETCH 1:* (body[header.fields (Message-Id)])"); + sendCommand ( $conn, "1 FETCH 1:* (internaldate body.peek[header.fields (From Date Subject Message-Id)])"); + undef @response; + my $nulls; + while ( 1 ) { + readResponse ( $conn ); + + if ( $response eq '' ) { + $nulls++; + if ( $nulls > 9 ) { + Log("server has stopped responding after $nulls loops"); + ($src,$dst) = reconnect(); + return 0; + } + } else { + $nulls = 0; + } + + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return 0; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return 0; + } + } + + $flags = ''; + my $nulls; + for $i (0 .. $#response) { + $_ = $response[$i]; + + if ( $response[$i] eq '' ) { + $nulls++; + if ( $nulls > 9 ) { + Log("server has stopped responding after $nulls loops"); + ($src,$dst) = reconnect(); + return 0; + } + } else { + $nulls = 0; + } + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /INTERNALDATE (.+) RFC822\.SIZE/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } elsif ( $response[$i] =~ /INTERNALDATE "(.+)" BODY/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } elsif ( $response[$i] =~ /INTERNALDATE "(.+)" FLAGS/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ($response[$i] =~ /Subject:\s*(.+)/i ) { + $subject = $1; + } + + if ($response[$i] =~ /From:\s*(.+)/i ) { + $from = $1; + } + + if ($response[$i] =~ /Date:\s*(.+)/i ) { + $header_date = $1; + } + + if ($response[$i] =~ /Message-ID:/i) { + $response[$i] =~ /Message-Id: (.+)/i; + $msgid = $1; + trim(*msgid); + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + # if ( $response[$i] =~ /^\)/ ) { + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + if ( $msgid eq '' ) { + # No msgid, construct one + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)//g; + Log("msgnum $msgnum has no msgid, built one as $msgid") if $debug; + } + $$msgids{"$msgid"} = $msgnum; + $msgid = ''; + } + } + return $msgcount; +} + +sub encode_ampersand { + +my $mbx = shift; + + # The IMAP RFC requires mailbox names with '&' be + # encoded as '&-' + + # The problem with this routine is a mailbox name may be + # encoded in Mod UTF7 which uses the '&' character for its + # own purposes, eg r&AOk-pertoire_XXX. We have to leave it + # alone. Anyway, this code was inserted because of an IMAP + # server which did not do its job so the usefulness of this + # conversion is limited. + + if ( $$mbx =~ /\&/ ) { + if ( $$mbx !~ /\&-/ ) { + # Need to encode the '&' as '&-' + $$mbx =~ s/\&/\&-/g; + Log("Encoded $$mbx"); + } + } + +} + +sub openDBM { + +my $user = shift; + + # Open a DBM for this user + + my $dbm = $msgid_dbm_dir . '/' . $user; + + unless( dbmopen(%MSGID_DBM, $dbm, 0600) ) { + print STDERR "Can't open $dbm: $!\n"; + exit; + } + +} + +sub deleteMsg { + +my $conn = shift; +my $msgnum = shift; +my $rc; + + # Mark a message for deletion by setting \Deleted flag + + Log(" msgnum is $msgnum") if $verbose; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked $msgid for delete") if $verbose; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; +my $status; +my $loops; + + # Remove the messages from a mailbox + + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/ ) { + $status = 1; + last; + } + + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Error selecting mailbox $mbx: $response"); + last; + } + if ( $loops++ > 100 ) { + Log("No response to SELECT command, skipping this mailbox"); + last; + } + } + + return unless $status; + + my $expunged = 0; + sendCommand ( $conn, "1 EXPUNGE"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + + if ( $response =~ /\* (.+) EXPUNGE/ ) { + $expunged++; + } + if ( $response =~ /^1 BAD|^1 NO/i ) { + print "Error expunging messages: $response\n"; + last; + } + } + + Log(" $expunged message(s) purged from $mbx"); + +} + +sub wrap_long_line { + +my $line = shift; + + # Wrap lines too long to be accepted by an IMAP server (Office365 doesn't + # seem to like very long lines). We'll wrap at 1000 characters since + # that seems to be acceptable to Office365. + + my $len1 = length( $line ); + my @output = (); + @output = ( $line =~ m/.{1000}/g ); + my $new; + $new .= "$_\r\n" foreach (@output ); + + # Pick up the trailing chars + + my $temp = $new; + $temp =~ s/\r|\n//g; + my $len2 = length( $temp ); + $new .= substr( $line, $len2, $len1-$len2); + $new .= "\r\n"; + + return $new; +} + +sub exchange_workaround { + + # Because Exchange limits the number of mailboxes you can create + # during a single IMAP session we have to get a new session before + # we can continue. + + Log("$errors errors have occurred, disconnecting and reconnecting to Exchange server"); + $errors = 0; + logout( $dst ); + connectToHost( $destHost, \$dst ); + + # Log back into Exchange + + if ( $destUser =~ /(.+):(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + Log("PLAIN login") if $debug; + return 0 unless login_plain( $destUser, $dst ); + } else { + # Otherwise do an ordinary login + unless ( login( $destUser,$destPwd, $destHost, $dst ) ) { + logout( $src ); + return 0; + } + } + + return; + +} + +# get_dest_mailboxes +# +# get a list of the user's mailboxes on the destination host +# +sub get_dest_mailboxes { + +my $MBXS = shift; +my $conn = shift; + + # Get a list of the user's mailboxes on the destination + + %$MBXS = (); + my @mbxs = listMailboxes( '*', $conn); + foreach $_ ( @mbxs ) { + $$MBXS{"$_"} = 1; + } + +} + +sub fix_msg_line_terminators { + +my $msg = shift; +my $tmp; + + # Cyrus requires all lines in a message be terminated properly. Most + # IMAP servers are tolerant about this but not Cyrus + + foreach $_ ( split(/\n/, $$msg ) ) { + chomp; + s/\r$//; + $_ .= "\r\n"; + $tmp .= $_; + } + + $$msg = $tmp; + +} + +sub notify_user { + +my $user = shift; +my $conn = shift; +my $too_large = shift; +my $mbx_errors = shift; + + # Insert the summary into the user's Inbox on the source and destination + + $now = localtime(); + $msgid = time() . '@imapcopy'; + + my $message = +"From: imapcopy +To: $user +Subject: IMAP COPY completed at $now +Message-Id: <$msgid> +Date: $now +X-Mailer: IMAP Tools + +Here is a summary of the job: +Completed at $now + +"; + + $report = summarize(); + $message .= $report; + + if ( @$too_large ) { + $message .= "\nThe following messages were not copied because they exceeded the maximum size ($max_size megabytes):\n\n"; + foreach $_ ( @$too_large ) { + ($size,$mbx,$subject) = split(/\|/, $_); + commafy( \$size ); + $message .= "Subject: $subject\n"; + $message .= "Folder: $mbx\n"; + $message .= "Size: $size bytes\n\n"; + } + } + if ( @mbx_errors ) { + $message .= "\nThe following folders could not be created on the destination server:\n\n"; + foreach $_ ( @$mbx_errors ) { + $message .= "$_\n"; + } + } + + my ($dow,$mon,$dom,$ts,$yr) = split(/\s+/, $now); + $dom = '0' . $dom if length( $dom ) == 1; + my $date = "$dom-$mon-$yr $ts +0000"; + + $flags = ''; + insertMsg( $conn, 'Inbox', \$message, $flags, $date ); + +} + +sub summarize { + + # Format the summary data nicely + + my $report = "Msgs Copied Folder\r\n"; + $report .= "==================================================================\r\n"; + foreach $_ ( split(/\n/, $summary ) ) { + if ( /Copied (.+) messages to (.+)/ ) { + $copied = $1; + $folder = $2; + $copied = pack("A10", $copied ); + $report .= "$copied $folder\n"; + } + } + + return $report; + +} + +sub copy_folder { + +my $srcmbx = shift; +my $src = shift; +my $dst = shift; +my $copied = 0; + + return if $srcmbx eq $archive_src_mbx; + + if ( $srcmbx eq '[Gmail]/All Mail' ) { + # The Gmail 'All Mail' folder is where all msgs in Gmail are stored. + # Gmail uses pointers to group the messages into folders. We don't + # need to copy the contents of the All Mail folders because we'll + # get them from the other 'folders'. + Log("Skipping $srcmbx"); + next; + } + # next if $srcmbx =~ /^\[Gmail]/; + + $archived=0; + $mbxs_processed++; + if ( $verbose ) { + $line = "Processing $srcmbx " . '(' . $mbxs_processed . '/' . $num_mbxs . ')'; + Log("$line"); + } + $dstmbx = mailboxName( $srcmbx,$srcPrefix,$srcDelim,$dstPrefix,$dstDelim ); + $dstmbx =~ s/\s+$//g; + + # Workaround for a certain customer + $dstmbx =~ s/^INBOX.INBOX/INBOX/; + + if ( $gmail_source ) { + # Change '[Gmail]' to 'Gmail' + if ( $dstPrefix ) { + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^\[Gmail\]/Gmail/; + $dstmbx = $dstPrefix . $dstmbx; + } else { + $dstmbx =~ s/^\[Gmail\]/Gmail/; + } + } + + # Special for issue with Exchange IMAP which doesn't like + # trailing spaces in mailbox names. + $dstmbx =~ s/\s+\//\//g; + + $dstmbx =~ s/\[Gmail\]// if $opt_g; + + # $LAST = "$dstmbx"; + $LAST = "$srcmbx"; + + Log("Do we need to create dstmbx >$dstmbx$dstmbx< already exists") if $debug; + } + + # Mbxs marked NOSELECT don't hold any messages so after creating them + # we don't need to do anything else. + next if $nosel_mbxs{"$srcmbx"}; + + selectMbx( $dstmbx, $dst ); + + if ( $update ) { + Log("Get msgids on the destination") if $debug; + $msgcount = getMsgIdList( $dstmbx, \%DST_MSGS, $dst ); + $dst_count = keys %DST_MSGS; + Log("There are $msgcount messages in $dstmbx on the dest ($dst_count with unique Message-IDs)"); + } + + init_mbx( $dstmbx, $dst ) if $init_mbx; + + $checkpoint = "$srcmbx|$sourceHost|$sourceUser|$sourcePwd|"; + $checkpoint .= "$destHost|$destUser|$destPwd"; + + if ( $sent_after or $sent_before ) { + getDatedMsgList( $srcmbx, $sent_before, $sent_after, \@msgs, $src ); + } else { + getMsgList( $srcmbx, \@msgs, $src, 'EXAMINE' ); + } + + my $msgcount = $#msgs + 1; + Log("There are $msgcount messages in $srcmbx on the source"); + + if ( $sent_after and $sent_before ) { + Log("There are $msgcount messages between those dates"); + } + Log(" Copying $msgcount messages in $srcmbx mailbox") if $verbose; + if ( $msgcount == 0 ) { + Log(" $srcmbx mailbox is empty") unless $ENV{'HTTP_CONNECTION'}; + next; + } + + $copied=0; + $delete_msg_list = ''; + %MSGIDS_COPIED = (); + + foreach $_ ( @msgs ) { + alarm $timeout; + ($msgnum,$date,$flags,$msgid,$size,$header_date) = split(/\|/, $_); + + if ( $special_search ) { + next unless special_date_filtering( $date, $special_search ); + } + + if ( $skip_unread ) { + next if $flags !~ /Seen/; + } + + if ( $dont_copy_source_dups ) { + # Don't copy a message if we've already copied it + # eg, there are dups on the source. + next if $MSGIDS_COPIED{"$msgid"}; + } + + Log(" msgnum=$msgnum,msgid=$msgid") if $debug; + + next if $msgnum eq ''; + + if ( $update ) { + # Don't insert the message if it already exists + # next if $DST_MSGS{"$msgid"}; + + if ( $DST_MSGS{"$msgid"} ) { + # Msg exists on the destination + Log("$msgid exists on the destination, skip it") if $debug; + delete_msg( $msgnum, $src ) if $update_rm_src_msg; + next; + } + Log("$msgid does not exist on the destination") if $debug; + } + + if ( $msgid_dbm_dir ) { + # Don't copy the message if we have already done so + # in the past + next if $MSGID_DBM{"$msgid"}; + } + + # Strip off TZ offset if it exists + $date =~ s/\((.+)\)$//; + $date =~ s/\s+$//g; + + # $LAST = "$dstmbx|$msgnum"; + $LAST = "$srcmbx|$msgnum"; + + my $mb = $size/1000000; + + if ( $max_size and $mb > $max_size ) { + commafy( \$lenx ); + Log(" Skipping message $msgnum because its size ($size) exceeds the $max_size MB limit"); + $subject = get_subject( $msgnum, $size, $srcmbx, $src ); + Log("subject $subject"); + push( @too_large, "$size|$srcmbx|$subject"); + next; + } + + next unless fetchMsg( $msgnum, $size, \$message, $srcmbx, $src ); + + if ( $flags !~ /SEEN/i and $reset_unseen ) { + reset_unseen( $msgnum, $src ) if $reset_unseen; + } + + alarm 0; + + fix_msg_line_terminators( \$message ) if $cyrus; + + if ( $wrap_long_lines ) { + $new_message = ''; + foreach $_ ( split(/\r\n/, $message ) ) { + if ( length( $_ ) < 1000 ) { + $new_message .= "$_\r\n"; + next; + } + $len = length( $_ ); + Log(" Need to wrap this line: length = $len") if $debug; + # Wrap the line in chunks of 1,000 chars + $line = wrap_long_line( $_ ); + $new_message .= $line; + } + $message = $new_message; + } + + next unless $message; + + if ( $archive_dst_mbx ) { + # Put all messages being copied into the destination archive mailbox only + # (eg, don't copy them to any other mbxs) + $stat = insertMsg( $dst, $archive_dst_mbx, *message, $flags, $date ); + $copied++ if $stat; + next; + } + if ( $archive_src_mbx ) { + # Put a copy of the message in the archive mbx on the source + # and copy it to the destination as well. + if ( insertMsg( $src, $archive_src_mbx, *message, $flags, $date ) ) { + $archived++; + if ( $rem_src_msgs ) { + $delete_msg_list .= "$msgnum "; + } + } + } + + eval { + alarm $timeout; + local $SIG{ALRM} = sub { + Log("$mbx mailbox: message number $msgnum timed out"); + ($src,$dst) = reconnect(); + next; + }; + + $stat = insertMsg( $dst, $dstmbx, *message, $flags, $date ); + $MSGIDS_COPIED{"$msgid"} = 1; + alarm 0; + }; + + + if ( $stat ) { + $copied++; + + if ( $rem_src_msgs and !$archive_src_mbx ) { + # User wants to delete msgs from src and they have been copied + if ( $rem_src_msgs ) { + $delete_msg_list .= "$msgnum "; + } + } + } + + if ( $progress ) { + if ( $copied/$progress == int($copied/$progress ) ) { + Log("Copied $copied of $msgcount messages from $srcmbx"); + } + } + + # Record the msgid if -Z specified + if ( $msgid_dbm_dir ) { + $MSGID_DBM{"$msgid"} = today(0); + } + + if ( $copied/100 == int($copied/100)) { + Log(" Copied $copied messages so far") if $verbose; + } + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $copied == $msgs_per_folder; + } + + alarm 0; + + if ( $conn_timed_out ) { + Log("$destHost timed out"); + reconnect( $checkpoint, $dst ); + $conn_timed_out = 0; + next; + } + + } + + if ( $update and $del_from_dest ) { + %DST_MSGS = %SRC_MGS = (); + Log("Get msgids on the destination") if $debug; + selectMbx( $dstmbx, $dst ); + getMsgIdList( $dstmbx, \%DST_MSGS, $dst ); + + selectMbx( $srcmbx, $src ); + Log("Get msgids on the source") if $debug; + getMsgIdList( $srcmbx, \%SRC_MSGS, $src ); + + my $dst_count = keys %DST_MSGS; + my $src_count = keys %SRC_MSGS; + $s = keys %SRC_MSGS; + $d = keys %DST_MSGS; + Log("There are $s msgs on the src and $d on the dest for $dstmbx") if $debug; + Log("Remove msgs from the destination which aren't on the source") if $debug; + + $expunge = 0; + foreach $msgid ( keys %DST_MSGS ) { + next if $SRC_MSGS{"$msgid"}; + + # This message no longer exists on the source. Delete it from the dest + Log("$msgid is not on the source, delete it from the dest") if $debug; + + $dst_msgnum = $DST_MSGS{"$msgid"}; + deleteMsg( $dst, $dst_msgnum ); + $expunge = 1; + } + expungeMbx( $dstmbx, $dst ) if $expunge; + } + + $total += $copied; + $dstmbx = decode( 'IMAP-UTF-7', $dstmbx ) unless isAscii( $dstmbx ); + + if ( $archive_dst_mbx ) { + Log(" Copied $copied messages to $archive_dst_mbx on the destination"); + } else { + if ( $verbose ) { + $line = " Copied $copied messages to $dstmbx on the destination"; + $line .= '(' . $mbxs_processed . '/' . $num_mbxs . ')'; + Log( "$line "); + } else { + Log(" Copied $copied messages to $dstmbx on the destination"); + } + } + + if ( $archive_src_mbx ) { + Log(" Copied $archived messages to $archive_src_mbx mailbox on the source"); + if ( $rem_src_msgs ) { + # Remove the messages from the source mailbox + Log("Removing messages from $srcmbx on source"); + delete_msg_list( $delete_msg_list, $srcmbx, $src ); + expungeMbx( $srcmbx, $src ); + } + } elsif ( $rem_src_msgs ) { + Log("Removing messages from $srcmbx on source"); + delete_msg_list( $delete_msg_list, $srcmbx, $src ); + expungeMbx( $srcmbx, $src ); + } + return $copied; +} + +sub copy_folders_parallel { + +my $mbxs = shift; +my $src = shift; +my $dst = shift; +my @summary; + + $parent_pid = $$; + my $pm = Parallel::ForkManager->new( $num_children - 1 ); + foreach $srcmbx ( @$mbxs ) { + + $pm->run_on_finish( sub { + my($pid,$exit_code,$ident,$exit_signal,$core_dump,$var,$v)=@_; + ($copied,$mbx) = split(/,/, ${$var}); + $total += $copied; + push( @summary, "Copied $copied messages from $mbx"); + }); + + exit if $$ ne $parent_pid; # Don't let a child try to launch another child + + $pm->start and next; + + # This is the child process, copy the folder + + Log("I am child pid $$") if $debug; + connectToHost($sourceHost, \$src) or exit; + login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) or exit; + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + + connectToHost( $destHost, \$dst ) or exit; + login( $destUser,$destPwd, $destHost, $dst, $dstMethod ) or exit; + namespace( $dst, \$dstPrefix, \$dstDelim, $opt_y ); + + $count = copy_folder( $srcmbx, $src, $dst ); + $var = "$count,$srcmbx"; + $v = ''; + $pm->finish(0, \$var, \$v ); + } + + $pm->wait_all_children; + + return @summary; + +} + +sub strip_mult_line_terminators { + +my $segment = shift; + + # This routine is disabled. + return; + + # This is an optional cleanup routine for cases where + # the source server is sending us lines with \r\r\r + # line terminators. Ugh. + + my $temp; + foreach $_ ( split(/\n/, $$segment ) ) { + s/\r+$//g; + $temp .= "$_\r\n"; + } + $$segment = $temp; + +} + +sub reset_unseen { + +my $msgnum = shift; +my $conn = shift; + + # Some servers (Smartermail is one) change a message from UNSEEN to + # SEEN even if the mailbox is opened in Examine mode. This is a workaround + # for that. + + sendCommand ($conn, "1 STORE $msgnum -flags \\SEEN"); + my $loops; + while ( 1 ) { + last if $loops++ > 9; + readResponse ($conn); + last if $response =~ /^1 OK|^1 BAD|^1 NO/i; + } + +} + +sub get_subject { + +my $msgnum = shift; +my $size = shift; +my $srcmbx = shift; +my $conn = shift; +my $subject; + + # Extract the subject field from a message + + my $saved = $header_only; + $header_only = 1; + fetchMsg( $msgnum, '', \$message, $srcmbx, $conn ); + $subject = $1 if $message =~ /Subject: (.+)/; + $header_only = $saved; + + return $subject; +} + + +sub convert_date { + +my $date = shift; + +%months = ('JAN',0,'FEB',1,'MAR',2,'APR',3,'MAY',4,'JUN',5,'JUL',6, + 'AUG',7,'SEP',8,'OCT',9,'NOV',10,'DEC',11); + + my ($day,$mon,$yr) = split(/-/, $date); + $mon = uc( $mon ); + $mon = $months{"$mon"}; + $mon = '0' . $mon if length( $mon == 1); + $day = '0' . $day if length( $day == 1); + + return ($day,$mon,$yr); +} + +sub compare_dates { + +my $date1 = shift; +my $date2 = shift; +my $stat = 1; + + # Return 0 if $date1 is earlier than $date2 + + ($day,$mon,$yr) = convert_date( $date1 ); + eval '$secs1 = timelocal(0,0,0,$day,$mon,$yr)'; + + ($day,$mon,$yr) = convert_date( $date2 ); + eval '$secs2 = timelocal(0,0,0,$day,$mon,$yr)'; + + $diff = $secs2 - $secs1; + $stat = 0 if $diff > 0; + + return $stat; +} + +sub special_date_filtering { + +my $date = shift; +my $oper = shift; +my $status = 1; + + # Return false unless the date satifies the search date criteria. This code + # is used only when the IMAP server does not support the standard SINCE/BEFORE/ + # etc searching. + + ($date) = split(/\s+/, $date); + $date = uc( $date ); + Log("date = $date") if $debug; + ($oper,$cutoff) = split(/=/, $oper); + + $rc = compare_dates( $date, $cutoff ); + + # rc=1 means later; 0 means earlier + + $status = 0; + if ( $oper eq 'SINCE' ) { + $status = 1 if $rc == 1; + } elsif ( $oper eq 'BEFORE' ) { + $status = 1 if $rc == 0; + } + + if ( $status == 1 and $debug ) { + Log("Include this message"); + } + + return $status; +} + +sub prompt_for_pwd { + +my $string = shift; + + # Prompt the user for the password + + print STDOUT "Enter the $string user password: "; + system('stty', '-echo'); # Disable echoing + my $password = <>; + chomp $password; + system('stty', 'echo'); # Turn it back on + print STDOUT "\n"; + + return $password; + +} + +sub create_dovecot_mbxs { + +my $mbxs = shift; +my $dst = shift; +my @list; + + # Sort mailboxes by length so they can be created in the right order. This + # is used with IMAP servers (such as Dovecot with mbox storage) that cannot + # have messages and child mailboxes in the same mailbox. + + foreach my $mailbox ( @$mbxs ) { + my $len = length( $mailbox ); + push( @list, "$len $mailbox" ); + } + + @list = reverse sort {$a <=> $b} @list; + + @$mbxs = (); + foreach $_ ( @list ) { + my ($n,$mailbox) = split(/\s+/, $_, 2 ); + push( @$mbxs, $mailbox ); + } + + # Now create the mailboxes in the right order, eg A/B/C/D before A/B/C + + foreach $mailbox ( @$mbxs ) { + $stat = createMbx( $mailbox, $dst ); + } + +} + +sub get_wrapped_msgid { + +my $response = shift; +my $i = shift; +my $msgid; + + # The Message-ID is not on the same line as the Message-ID: keyword + # Get it from the next line or lines (if it continues onto succeeding lines) + + $$response[$i+1] =~ s/^\s+//; + $msgid = $$response[$i+1]; + $msgid =~ s/\s+$//g; + + my $j = 1; + while ( 1 ) { + if ( $msgid =~ /\>$/ ) { + # We've got all of it + last; + } + $j++; + # The msgid continues onto the next line + $$response[$i+$j] =~ s/^\s+//; + $msgid .= $$response[$i+$j]; + if ( $msgid =~ /Message-ID:/i ) { + ($start,$msgid) = split(/Message-ID:/, $msgid ); + } + + last if $j > 99; + } + + return $msgid; + +} diff --git a/S/imap_tools.V1.333/imapcopy_de.html b/S/imap_tools.V1.333/imapcopy_de.html new file mode 100644 index 0000000..149bedb --- /dev/null +++ b/S/imap_tools.V1.333/imapcopy_de.html @@ -0,0 +1,86 @@ + +IMAPCOPY + + +
    + + + + + + +

    IMAPCOPY

    + +

    + EN + DE +

    + +
    + + + + + + +
    Quellserver: + + +
    Zielserver: + +
    Benutzername Quellserver: +Passwort Quellserver: + +
    Benutzername Zielserver: +Passwort Zielserver: +
    + +

    + + + + + + +
    Nur diese Ordner kopieren: + Ordner1,Ordner2, ... + +
    Diese Ordner nicht kopieren: + Ordner1,Ordner2, ... + +
    Nachrichten kopieren nach Datum + TT-MMM-JJJJ + +
    Nachrichten kopieren vor Datum + TT-MMM-JJJJ + +
    Update Mode
    (nur noch nicht kopierte Nachrichten) +
    +
    + +

    + + + +

    +Nach Start imapcopy wird der Kopierprozess gestartet. Abhängig von der Größe der zu kopierenden Accounts kann es einige Minuten oder länger dauern bis alle Nachrichten kopiert sind. Am Ende des Kopierprozesses erhalten Sie eine Nachricht per E-Mail. +
    + + diff --git a/S/imap_tools.V1.333/imapcopy_en.html b/S/imap_tools.V1.333/imapcopy_en.html new file mode 100644 index 0000000..b3674db --- /dev/null +++ b/S/imap_tools.V1.333/imapcopy_en.html @@ -0,0 +1,91 @@ + + +IMAPCOPY + + +
    + + + + + + +

    IMAPCOPY

    + +

    + EN + DE +

    + +
    + + + + + + +
    Source server + + +
    Destination server + +
    Source username +Source password + +
    Destination username +Destination password +
    + +

    + + + + + + +
    Copy only these folders + folder1,folder2,... + +
    Exclude these folders + folder1,folder2,... + +
    After date + DD-MMM-YYYY + +
    Before Date + DD-MMM-YYYY + +
    Update Mode +
    +
    + +

    + + + +

    +After clicking on Submit the copy process will start. +Depending on the size of your +account it will take a few minutes or more to copy everything over. +When it finishes you will receive an e-mail notifying of the results. + +
    + + diff --git a/S/imap_tools.V1.333/imapdump.pl b/S/imap_tools.V1.333/imapdump.pl new file mode 100755 index 0000000..240753b --- /dev/null +++ b/S/imap_tools.V1.333/imapdump.pl @@ -0,0 +1,1697 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imapdump.pl,v 1.36 2015/03/05 20:09:28 rick Exp $ + +####################################################################### +# Program name imapdump.pl # +# Written by Rick Sanders # +# Date 1/03/2008 # +# # +# Description # +# # +# imapdump.pl is a utility for extracting all of the mailboxes # +# and messages in an IMAP user's account. When supplied with # +# host/user/password information and the location of a directory # +# on the local system imapdump.pl will connect to the IMAP server, # +# extract each message from the user's account, and write it to # +# a file. The result looks something like this: # +# # +# /var/backups/INBOX # +# 1 2 3 4 5 # +# /var/backups/Drafts # +# 1 2 # +# /var/backups/Notes/2002 # +# 1 2 3 4 5 6 7 # +# /var/backups/Notes/2003 # +# 1 2 3 # +# etc etc # +# # +# imapdump.pl is called like this: # +# ./imapdump.pl -S host/user/password -f /var/backup # +# # +# Optional arguments: # +# -d debug # +# -I show IMAP protocol exchanges # +# -L logfile # +# -m mailbox list (dumps only the specified mailboxes, see # +# the usage notes for syntax) # +####################################################################### + +use Socket; +use IO::Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use File::Path; +use MIME::Base64 qw(decode_base64 encode_base64); + +################################################################# +# Main program. # +################################################################# + + init(); + + if ( $users_file ) { + @users = get_users( $users_file ); + } else { + push( @users, $sourceUser ); + } + + my $pm = Parallel::ForkManager->new( $num_children ) if $num_children != -1; + + foreach $sourceUser ( @users ) { + if ( $num_children == -1 ) { + # We're on Windows or the number of children has not been set + dump_user( $sourceUser, $dir ); + next; + } + + $pm->run_on_finish( sub { + my($pid,$exit_code,$ident,$exit_signal,$core_dump,$var,$v)=@_; + ($copied,$mbx) = split(/,/, ${$var}); + $total += $copied; + push( @summary, "Copied $copied messages from $mbx"); + }); + + $pm->start and next; + + # This is the child process, backing up $sourceUser"); + + dump_user( $sourceUser, $dir ); + exit; + } + + $pm->wait_all_children if $num_children != -1; + + Log("Done"); + + exit; + +sub dump_user { + +my $sourceUser = shift; +my $dir = shift; +my %DUMPED; + + ($user) = split(/:/, $sourceUser); + Log("Dumping messages for $user"); + mkdir( "$dir/$user", 0777 ) unless -d "$dir/$user"; + if ( $no_dups ) { + # The user wants to make sure we only dump messages which + # have not been dumped before. Use a dbm file to keep + # track of previously dumped messages. + Log("Running in no-duplicates mode"); + + if ( !$dbm_dir ) { + $dbm_dir = $dir; + } + $dbm = $dbm_dir . '/' . $user . '/dumped'; + unless( dbmopen(%DUMPED, $dbm, 0600) ) { + Log("Can't open $dbm: $!\n"); + exit unless $debug; + } else { + Log("Opened dbm file $dbm"); + } + + if ( $debug ) { + Log("Messages previously dumped"); + while(($x,$y) = each( %DUMPED ) ) { + Log(" $x"); + } + } + } + + # Get list of all messages on the source host by Message-Id + # + connectToHost($sourceHost, \$conn); + + if ( $extract_attachments ) { + $workdir = $dir . "/work"; + mkdir( $workdir, 0777 ) unless -d $workdir; + } + + login( $sourceUser, $sourcePwd, $conn ); + + @mbxs = getMailboxList($sourceUser, $conn); + + # Exclude certain mbxs if that's what the user wants + if ( $excludeMbxs or $excludeMbxs_regex ) { + exclude_mbxs( \@mbxs ); + } + + $added=0; + foreach $mbx ( @mbxs ) { + Log("Dumping messages in $mbx mailbox") if $dump_flags; + my @msgs; + + if ( $sent_after ) { + getDatedMsgList( $mbx, $sent_after, \@msgs, $conn, 'EXAMINE' ); + } else { + getMsgList( $mbx, \@msgs, $conn, 'EXAMINE' ); + } + + if ( $update ) { + # Get a list of the messages in the dump directory by msgid + Log("Reading $dir/$user/$mbx"); + $count = get_msgids( "$dir/$user/$mbx", \%MSGIDS ); + Log("There are $count messages in $dir/$user/$mbx"); + } + + my $i = $#msgs + 1; + Log("$mbx has $i messages"); + my $msgnums; + $updated = $flags_updated = $added = 0; + + foreach $msgnum ( @msgs ) { + $fn = ''; + ($msgnum,$date,$flags,$msgid) = split(/\|/, $msgnum); + ($fn,$oldflags) = split(/\|/, $MSGIDS{"$msgid"} ); + if ( $no_dups ) { + # If the user wants no duplicates and we have already + # dumped this message then skip it. + if ( $DUMPED{"$msgid"} ) { + Log(" $msgid has already been dumped") if $debug; + next; + } else { + Log(" Dumping msgnum $msgnum - $msgid") if $debug; + } + } elsif ( $update and $sync_flags and $fn ) { + summarize_flags( \$flags ); + # ($fn,$oldflags) = split(/\|/, $MSGIDS{"$msgid"} ); + if ( $oldflags ne $flags ) { + Log("$fn: The flags have changed: new=$flags old=$oldflags"); + ($newfn) = split(/,/, $fn); + $newfn .= ',' . $flags; + $rc = rename( $fn, $newfn ); + $flags_updated++; + next; + } else { + next; + } + } elsif ( $update ) { + # Don't dump the message if it already exists in the dump directory + if ( $MSGIDS{"$msgid"} ) { + Log(" $msgid exists in the dump directory") if $debug; + next; + } else { + Log(" Dumping msgnum $msgnum --- $msgid"); + $updated++; + } + } + + $message = fetchMsg( $msgnum, $mbx, $conn ); + mkpath( "$dir/$user/$mbx" ) if !-d "$dir/$user/$mbx"; + $msgfile = $msgnum; + + if ( $update ) { + # Make sure filename is unique + $msgfile = unique( $msgfile, "$dir/$user/$mbx" ); + } + + $msgfile .= $extension if $extension; + + if ( $include_all_flags ) { + summarize_flags( \$flags); + $msgfile .= ",$flags" if $flags; + } elsif ( $include_flag and $flags =~ /Seen/i ) { + $msgfile .= ',S'; + } + + if ( !open (M, ">$dir/$user/$mbx/$msgfile") ) { + Log("Error opening $dir/$user/$mbx/$msgfile: $!"); + next; + } + Log(" Copying message $msgnum") if $debug; + print M $message; + close M; + $added++; + + if ( $no_dups ) { + # Flag it as dumped + $DUMPED{"$msgid"} = 1; + } + + if ( $extract_attachments ) { + extract_attachments( $msgfile, "$dir/$user/$mbx", $workdir ); + } + + $msgnums .= "$msgnum "; + } + if ( $sync_flags and $update ) { + Log("Flags updated $flags_updated messages in $mbx"); + } + Log("Dumped $added messages in $mbx") if $added; + + if ( $remove_msgs ) { + selectMbx( $mbx, $conn ); + deleteMsg( $conn, $msgnums, $mbx ) if $remove_msgs; + expungeMbx( $conn, $mbx ) if $remove_msgs; + } + } + + logout( $conn ); + Log("$added total messages dumped"); + + # Remove the workdir + rmdir $workdir; +} + + +sub init { + + $version = 'V1.0'; + $os = $ENV{'OS'}; + + processArgs(); + + if ($timeout eq '') { $timeout = 60; } + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("\n$0 starting"); + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + if ( $dump_flags ) { + Log("Dumping only those messages with one of the following flags: $dump_flags"); + } + + if ( $extract_attachments ) { + eval 'use MIME::Parser'; + if ( $@ ) { + Log("The Perl module MIME::Parser must be installed to extract attachments."); + exit; + } + + Log("Attachments will be extracted"); + $workdir = $dir . '/work' if $extract_attachments; + mkdir( $workdir, 0777 ) unless -d $workdir; + } + + if ( $num_children and $OS =~ /Windows/i ) { + Log("Multi-process mode is not supported on Windows"); + $num_children = -1; + } elsif ( $num_children > 0 ) { + eval 'use Parallel::ForkManager'; + if ( $@ ) { + Log("In order to run multiple copy processes you must install the Parallel::ForkManager Perl module."); + exit; + } + Log("Running in parallel mode, number of children = $num_children"); + } else { + $num_children = -1; + } + + Log("Running in Update mode") if $update; + Log("Running in no-duplicates mode") if $no_dups; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + Log (">> $cmd") if $showIMAP; + +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } + print STDOUT "$str\n"; + +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + +sub imap_login { + + # Not used + + if ( $sourceUser =~ /(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + my $sourceUser = $1; + my $authuser = $2; + login_plain( $sourceUser, $authuser, $sourcePwd, $conn ) or exit; + } else { + if ( !login($sourceUser,$sourcePwd, $conn) ) { + Log("Check your username and password"); + print STDOUT "Login failed: Check your username and password\n"; + exit; + } + } + +} + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $user =~ /:/ ) { + ($user,$pwd) = split(/:/, $user); + } + + if ( $admin_user ) { + ($auth_user,$auth_pwd) = split(/:/, $admin_user); + login_plain( $user, $auth_user, $auth_pwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $user = shift; +my $conn = shift; +my @mbxs; +my @mailboxes; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + foreach $mbx ( @mbxs ) { + trim( *mbx ); + push( @mailboxes, $mbx ); + } + return @mailboxes; + } + + if ($debug) { Log("Get list of user's mailboxes",2); } + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + undef @mbxs; + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx= $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + if ($debug) { Log("$mbx is set NOSELECT,skip it",2); } + next; + } + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # those + @mbxs = split(/,/, $mbxList); + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $mode = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $msgid; + + $mode = 'EXAMINE' unless $mode; + sendCommand ($conn, "1 $mode \"$mailbox\""); + undef @response; + $empty=0; + $loops=0; + while ( 1 ) { + readResponse ( $conn ); + + if ( $loops++ > 99 ) { + Log("The IMAP server stopped responding"); + exit; + } + + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + if ( $opt_R ) { + # Fetch this many messages (for testing) + $end = $opt_R; + } else { + $end = '*'; + } + + sendCommand ( $conn, "1 FETCH 1:$end (uid flags internaldate body[header.fields (From Date Message-Id Subject)])"); + + undef @response; + $no_response=0; + while ( 1 ) { + readResponse ( $conn ); + check_response(); + + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + @msgs = (); + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /Message-Id: (.+)/i ) { + $msgid = $1; + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + # $response[$i] =~ /INTERNALDATE "(.+)" BODY/; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^From:\s*(.+)/i) { + $from = $1 unless $from; + } + if ( $response[$i] =~ /^Date:\s*(.+)/i) { + $header_date = $1 unless $header_date; + } + + if ( $response[$i] =~ /^Subject: (.+)/i) { + $subject = $1 unless $subject; + } + + # if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) { + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + if ( $msgid eq '' ) { + # The message lacks a message-id so construct one. + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + if ( !$subject and !$from and !$subject ) { + Log(" message has no from/subject/date fields. Can't build dummy msgid"); + } else { + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)|\@|\.//g; + Log(" msgnum $msgnum has no msgid, built one as $msgid"); + } + } + push (@$msgs,"$msgnum|$date|$flags|$msgid"); + $msgnum = $date = $flags = $msgid = ''; + } + } + + return 1; + +} + +# getDatedMsgList +# +# Get a list of the user's messages in a mailbox on +# the host which were sent after the specified date +# +sub getDatedMsgList { + +my $mailbox = shift; +my $cutoff_date = shift; +my $msgs = shift; +my $conn = shift; +my $oper = shift; +my ($seen, $empty, @list,$msgid); + + # Get a list of messages sent after the specified date + + Log("Searching for messages after $cutoff_date"); + + @list = (); + @$msgs = (); + + sendCommand ($conn, "1 $oper \"$mailbox\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ / EXISTS/i) { + $response =~ /\* ([^EXISTS]*)/; + # Log(" There are $1 messages in $mailbox"); + } elsif ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO/i ) { + Log ("unexpected SELECT response: $response"); + return 0; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected SELECT response: $response"); + return 0; + } + } + + my ($date,$ts) = split(/\s+/, $cutoff_date); + + # + # Get list of messages sent after the reference date + # + Log("Get messages sent after $date") if $debug; + $nums = ""; + $no_response=0; + sendCommand ($conn, "1 SEARCH SINCE \"$date\""); + while ( 1 ) { + readResponse ($conn); + check_response(); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response =~ /^\*\s+SEARCH/i ) { + ($nums) = ($response =~ /^\*\s+SEARCH\s+(.*)/i); + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected SEARCH response: $response"); + return; + } + } + Log("$nums") if $debug; + if ( $nums eq "" ) { + Log (" $mailbox has no messages sent before $date") if $debug; + return; + } + my @number = split(/\s+/, $nums); + $n = $#number + 1; + + $nums =~ s/\s+/ /g; + @msgList = (); + @msgList = split(/ /, $nums); + + if ($#msgList == -1) { + # No msgs in this mailbox + return 1; + } + + $n = $#msgList + 1; + Log("there are $n messages after $sent_after"); + +@$msgs = (); +$no_response=0; +for $num (@msgList) { + + sendCommand ( $conn, "1 FETCH $num (uid flags internaldate body[header.fields (Message-Id Date)])"); + + undef @response; + while ( 1 ) { + readResponse ( $conn ); + check_response(); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + $flags = ''; + my $msgid; + foreach $_ ( @response ) { + last if /^1 OK FETCH complete/i; + if ( /FLAGS/ ) { + # Get the list of flags + /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( /Message-Id:\s*(.+)/i ) { + $msgid = $1; + } + + if ( /INTERNALDATE/) { + /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + #### next if check_cutoff_date( $date, $cutoff_date ); + } + + if ( /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( /^\)/ or /\)\)$/ ) { + push (@$msgs,"$msgnum|$date|$flags|$msgid"); + $msgnum=$msgid=$date=$flags=''; + } + } + } + + foreach $_ ( @$msgs ) { + Log("getDated found $_") if $debug; + } + + return 1; +} + + +sub fetchMsg { + +my $msgnum = shift; +my $mbx = shift; +my $conn = shift; +my $message; + + Log(" Fetching msg $msgnum...") if $debug; + + $no_response=0; + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + check_response(); + + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ( $response =~ /^1 NO|^1 BAD/ ) { + Log("$response"); + return 0; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " imapdump.pl -S Host/User/Password -f     \n"; + print STDOUT " is the file directory to write the message structure\n"; + print STDOUT " Optional arguments:\n"; + print STDOUT " -F (eg dump only messages with specified flags\n"; + print STDOUT " -l \n"; + print STDOUT " -d debug\n"; + print STDOUT " -x File extension for dumped messages\n"; + print STDOUT " -g Dump message attachments as separate files\n"; + print STDOUT " -G Dump only message attachments not complete message or header (Used with -g)\n"; + print STDOUT " -r remove messages after dumping them\n"; + print STDOUT " -L logfile\n"; + print STDOUT " -m mailbox list (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n"; + print STDOUT " -a copy only messages after this date\n"; + print STDOUT " -e exclude mailbox list (using exact matches)\n"; + print STDOUT " -E exclude mailbox list (using regular expressions)\n"; + print STDOUT " [-s] Include Seen/Unseen status in message filename (2454,S or 2454,U\n"; + print STDOUT " [-z] Include all status flags in message filename (2454,DSF or 2454,SA\n"; + print STDOUT " [-C] Include custom (nonstandard) flags in message filename, eg $SPECIAL$\n"; + print STDOUT " [-u] Don't dump messages already dumped\n"; + print STDOUT " [-D 0 and $day < 32 ); + $invalid = 1 unless $month =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i; + $invalid = 1 unless $year > 1900 and $year < 2999; + if ( $invalid ) { + Log("The 'Sent after' date $date must be in DD-MMM-YYYY format"); + exit; + } +} + +sub get_msgids { + +my $dir = shift; +my $msgids = shift; +my $i; +my $progress = 100; +my $count = 0; +my $msgid; + + # Build a list of the messageIDs for the messages in the requested directory + + %$msgids = (); + + return 0 if !-e $dir; # No such directory + + if ( !opendir D, $dir ) { + Log("Error opening $dir: $!"); + return 0; + } + my @files = readdir( D ); + closedir D; + + $count = scalar @files; + $count = $count - 2; + + foreach $_ ( @files ) { + next if /^\./; + $fn = "$dir/$_"; + next if -d $fn; # Skip directories + $i++; + Log("fn $fn") if $debug; + ($filename,$flags) = split(/,/, $fn); + if ( !open(MSG, "<$fn" ) ) { + Log("Error opening $fn: $!"); + next; + } + $msgid = ''; + while( ) { + chomp; + s/\r$|\m$//g; + if (/^Subject:\s+(.+)/i ) { + $subject = $1 unless $subject; + } + if (/^From:\s+(.+)/i ) { + $from = $1 unless $from; + } + if (/^Date:\s+(.+)/i ) { + $header_date = $1 unless $header_date; + } + + if (/^Message-ID:\s+(.+)/i ) { + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)|\@|\.//g; + $$msgids{"$1"} = "$fn|$flags"; + $msgid = 1; + if ( !$msgid ) { + # Wrapped to next line + chomp( $msgid = ); + $msgid =~ s/\r$|\m$//g; + } + } + last if $_ eq ''; # End of header + } + close MSG; + + if ( !$msgid ) { + # The message lacks a message-id so construct one. + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)|\@|\.//g; + Log("msgnum $msgnum has no msgid, built one as $msgid") if $debug; +Log("$msgid"); + $$msgids{"$msgid"} = "$fn|$flags"; + } + + if ( $i/$progress == int($i/$progress) ) { Log(" $i messages read so far"); } + } + + return $count; +} + +sub unique { + +my $fn = shift; +my $dir = shift; +my @letters = qw( a b c d e f g h i j k l m n o p q r s t u v w x y z ); + + # Generate a filename which is unique in the directory + + return $fn if !-e "$dir/$fn"; + + # A file with this name exists. + + my $new; + foreach $letter ( @letters ) { + $new = $fn . $letter; + last if !-e "$dir/$new"; + } + + return $new; + +} + +# exclude_mbxs +# +# Exclude certain mailboxes from the list if the user has provided an +# exclude list of complete mailbox names with the -e argument. He may +# also supply a list of regular expressions with the -E argument +# which we will process separately. + +sub exclude_mbxs { + +my $mbxs = shift; +my @new_list; +my %exclude; +my (@regex_excludes,@final_list); + + # Do the exact matches first + if ( $excludeMbxs ) { + foreach my $exclude ( split(/,/, $excludeMbxs ) ) { + $exclude{"$exclude"} = 1; + } + foreach my $mbx ( @$mbxs ) { + next if $exclude{"$mbx"}; + push( @new_list, $mbx ); + } + @$mbxs = @new_list; + } + + # Next do the regular expressions if any + my %excludes; + @new_list = (); + if ( $excludeMbxs_regex ) { + my @regex_excludes; + foreach $_ ( split(/,/, $excludeMbxs_regex ) ) { + push( @regex_excludes, $_ ); + } + foreach my $mbx ( @$mbxs ) { + foreach $_ ( @regex_excludes ) { + if ( $mbx =~ /$_/ ) { + $excludes{"$mbx"} = 1; + } + } + } + foreach my $mbx ( @$mbxs ) { + push( @new_list, $mbx ) unless $excludes{"$mbx"}; + } + @$mbxs = @new_list; + } + + @new_list = (); + +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; + + # select the mailbox + sendCommand( $conn, "1 SELECT \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to SELECT $mbx command: $response"); + last; + } + } + +} + +sub reconnect { + + # The IMAP server has dropped our session or stopped responding for some reason. + # Re-establish the session and continue if we can + + $number_of_reconnects++; + if ( $number_of_reconnects > 25 ) { + # That's enough. Declare a fatal error and give up. + Log("FATAL ERROR: Number of reconnects exceeded 25. Exiting."); + exit; + } + + Log("Reconnecting..."); + sleep 30; + + connectToHost($sourceHost, \$conn); + login(); + selectMbx( $mbx, $conn ); + + # We now return you to the previously scheduled programming already in progress +} + +sub check_response { + + # If the server has stopped responding call the reconnect() routine + + if ( $response eq '' ) { + $no_response++; + } else { + $no_response = 0; + } + + if ( $no_response > 99 ) { + Log("The IMAP server has stopped responding"); + reconnect(); + } + +} + +sub extract_attachments { + +my $msgfn = shift; +my $dir = shift; +my $workdir = shift; + + # Extract all attachments + + Log("msgfn $msgfn") if $debug; + + $msgfn = $dir . '/' . $msgfn; + + # Get the message header and write it out to a file + open(H, "<$msgfn"); + $header = ''; + while( ) { + chomp; + $header .= "$_\n"; + last if length( $_ ) == 1; # end of the header + } + close H; + + unless( $extract_only_attachments ) { + # Write the header to a file unless the user only wants attachments + my $header_fn = "$msgfn" . ".header"; + open(H, ">$header_fn"); + print H "$header\n"; + close H; + } + + parseMsg( $msgfn, $dir, $workdir ); + + if ( $extract_only_attachments ) { + # The user wants the attachments but not the complete file or + # the header file + unlink $msgfn; + } + +} + +sub parseMsg { + +my $msgfn = shift; +my $dir = shift; +my $workdir = shift; + + # This routine dumps the message parts to files and returns + # the filenames + + # Remove any existing files from the workdir + opendir D, $workdir; + my @files = readdir( D ); + closedir D; + foreach $_ ( @files ) { + next if /^\./; + $fn = "$workdir/$_"; + unlink $fn if -e $fn; + } + + my @terms = split(/\//, $msgfn ); + my $prefix = $terms[$#terms]; + Log("prefix $prefix") if $debug; + + my $parser = new MIME::Parser; + + $parser->extract_nested_messages(0); + $parser->output_dir( $workdir ); + + # Read the MIME message and parse it. + $entity = $parser->parse_open( $msgfn ); + $entity = $parser->parse_data( $msgfn ); + + save_attachments( $dir, $workdir, $prefix ); +} + +sub save_attachments { + +my $dir = shift; +my $workdir = shift; +my $prefix = shift; + + # Apply the prefix to attachment names and move the attachments into + # the dump directory + + opendir D, $workdir; + my @files = readdir( D ); + closedir D; + my $i = 0; + foreach $_ ( @files ) { + next if /^\./; + $i++; + $filename = $_; + if ( $filename =~ /msg-(.+)-(.+).txt/ ) { + # Unnamed attachment is given a random name by the parser. + # Rename it so we don't get dups each time we run + $old = "$workdir/$filename"; + $new = "$workdir/attachment" . '-' . "$i.txt"; + $rc = rename( $old, $new ); + $old = $workdir . '/' . $msg . 'attachment-' . $i . ".txt"; + $new = "$dir/$prefix." . 'attachment-' . $i . ".txt"; + } else { + $old = "$workdir/$_"; + $new = "$dir/$prefix.$_"; + $i--; + } + + # Move it into the dump directory + $rc = rename( $old, $new ); + + if ( !$rc ) { + Log("Error moving $old to $new: $!"); + } + unlink $old if -e $old; + } + +} + +sub get_users { + +my $dir = shift; + + # Build the list of users to be backed up from the users_list file + + if ( !-e $users_file ) { + print "$users_file does not exist\n"; + exit; + } + if ( !open(U, "<$users_file" ) ) { + print "Can't open $users_file: $!\n"; + exit; + } + + while( ){ + chomp; + s/^\s+//g; + next if /^#/; + push( @users, $_ ); + } + close U; + + return @users; + +} + +sub create_user_dir { + +my $user = shift; +my $status = 1; + + # Create a subdirectory this user's messages + + print STDOUT "user $user\n"; + print STDOUT "dir $dir\n"; + + mkdir ( "$dir/$user", 0644 ); + + unless ( -d "$dir/$user" ) { + Log("Unable to create $dir/$user: $!"); + return 0; + } + + return $status; +} + +sub summarize_flags { + +my $flags = shift; + + # Turn a list of IMAP flags into a list of single character flags + + my $FLAGS = $$flags; + $$flags = ''; + foreach $_ ( split(/\s+/, $FLAGS ) ) { + s/DRAFT/draft/i; + if ( /^\\/ ) { + Log("standard flag $_") if $debug; + $$flags .= substr($_,1,1); + } elsif ( /^\$/ ) { + Log("custom flag $_") if $debug; + $$flags .= $_ . '$' if $include_custom_flags; + } + } + Log("flags $$flags") if $debug; + +} diff --git a/S/imap_tools.V1.333/imapfilter.pl b/S/imap_tools.V1.333/imapfilter.pl new file mode 100644 index 0000000..6fb7af2 --- /dev/null +++ b/S/imap_tools.V1.333/imapfilter.pl @@ -0,0 +1,2151 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imapfilter.pl,v 1.48 2015/01/23 14:12:17 rick Exp $ + +####################################################################### +# Program name imapfilter.pl # +# Written by Rick Sanders # +# # +# Description # +# # +# imapfilter is a tool for moving messages from one IMAP mailbox # +# to another based on a set of regular expressions. The "rules" # +# file defines the actions to be taken: # +# # +# Header-fieldStringsource mbxdestination mbx # +# # +# Header-fields are the keywords in an SMTP message header, for # +# example From, Subject, To, cc, etc. A destination mailbox may # +# a local one or on a remote IMAP server. Connection information # +# for remote servers is provided by the "RemoteServer" keyword in # +# the rules file, eg RemoteServer: myhost/myuser/mypassword. A # +# remote mailbox is defined in the rules as remotehost:mbx_name. # +# # +# ./imapfilter.pl -S host/user/password -r [-d] [-I] # +# # +# Optional arguments: # +# -d debug # +# -I show IMAP protocol exchanges # +# # +# Notes on Date comparision operations. imapfilter permits you # +# to filter on dates which are earlier, later, or the same as a # +# specified date. The date in the rules must be in RFC822 Mail # +# date format (eg, 12 Nov 2009 12:45:10 +0500) or expressed as an # +# offset from the current date (eg +30 meaning within the past 30 # +# days). Some examples: # +# # +# Date ">22 Dec 2008 15:00:00 +0000" INBOX MOVED # +# Date "<15 Jan 2009 00:00:00 +0500" INBOX MOVED # +# Date "=25 Dec 2009 08:00:00 +0500" INBOX MOVED # +# Date ">+60" INBOX MOVED # +# Date "*2009*" DATE INBOX # +####################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use MIME::Base64 qw( encode_base64 decode_base64); + +################################################################# +# Main program. # +################################################################# + +init(); +sigprc(); +getRules( \@rules, \%remhosts ); +usage() if !$host; + +foreach $user ( @users ) { + Log("$user"); + $total = 0; + + remoteConnections( \%remhosts ) if %remhosts; + + connectToHost($host, \$conn) or die; + login( $user, $conn) or next; + + @mbxs = expandRules( \@rules, $user, $conn ); + + foreach $rule ( @rules ) { Log("rule $rule"); } + + $marked = evaluateRules( \@mbxs, $conn, \%moves ); + + Log("expunge_trash $expunge_trash") if $debug; + if ( $expunge_trash and !$test ) { + expunge_trash( $expunge_trash, $conn); + } + + logout( $conn ); + foreach $host ( keys %connections ) { + logout( $host ); + } + if ( $test ) { + Log("Would have moved $total_moved messages"); + } else { + Log("$total_moved total messages moved"); + } + + Log("Done"); + +} + +exit; + + +sub init { + + $version = 'V1.0.1'; + $os = $ENV{'OS'}; + + processArgs(); + + if ($timeout eq '') { $timeout = 60; } + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">>$logfile")) { + print STDERR "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("$0 starting"); + Log("Running in test mode, no messages will actually be moved") if $test; + $total=0; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + if ( $users_file ) { + ($sourceHost) = split(/\//, $opt_S); + if ( !open(U, "<$users_file") ) { + print STDERR "Error opening users file $users_file: $!\n"; + exit; + } + my $n; + while( ) { + $n++; + s/^\s+//g; + next if /^#/; + chomp; + next unless $_; + push( @users, $_ ); + } + close U; + + } else { + ($host,$user,$pwd) = split(/\//, $opt_S); + push( @users, "$user:$pwd" ); + } + + Log("Processing messages in batches of $chunk"); + +} + +sub getRules { + +my $rules = shift; +my $remhosts = shift; +my $fn; +my $line; +my $field; + + $xdate=0; + + if ( !open(R, "<$rulesfn") ) { + Log("Can't open rules file $rulesfn: $!"); + exit; + } + while ( ) { + $line++; + chomp; + s/^\s+//; + next if /^\#/; + next if $_ eq ''; + + if ( /^LocalServer:\s*(.+)\/(.+)\/(.+)/ ) { + # Local IMAP server connection info (can be supplied + # in the rules file or in the -S argument) + $host = $1; + $user = $2; + $pwd = $3; + } elsif ( /^RemoteServer:\s*(.+)\/(.+)\/(.+)/ ) { + # Remote IMAP server connection info + my $remhost = $1; + my $remuser = $2; + my $rempwd = $3; + ($remhost,$remport) = split(/:/, $remhost); + $remport = 143 unless $remport; + $$remhosts{"$remhost"} = { port=>$remport, user=>$remuser, pwd=>$rempwd }; + } elsif ( !/(.+)\t(.+)\t(.+)\t(.+)/ ) { + Log("Line $line in rules file is not in tab-delimited format"); + exit; + } else { + ($field) = split(/\t/, $_); + if ( lc($field) eq 'date' or lc($field) eq 'internaldate' ) { + $line = $_; + # Check for date comparison operator + $xdate = 1 if advanced_date_rule( $line ); + } + } + if ( /\tcopy$/i ) { + # This is a 'copy' rule not a standard 'move' rule + s/\tcopy$//i; + $COPY{"$_"} = 1; + } + push( @$rules, "$_"); + } + + if ( $xdate ) { + my @modules = qw( DateTime DateTime::Format::Mail DateTime::Format::DateParse ); + foreach $module ( @modules ) { + eval "use $module"; + if ( $@ ) { + Log("\nIn order to do 'earlier than' and 'later than' filtering on the Date"); + Log("field you must install the DateTime, DateTime::Format::Mail and"); + Log("DateTime::Format::DateParse Perl modules."); + exit; + } + } + } + +} + +sub processArgs { + + if ( !getopts( "dIS:D:L:r:tfc:u:E:X:T:" ) ) { + usage(); + } + + ($host,$user,$pwd) = split(/\//, $opt_S); + $logfile = $opt_L; + $rulesfn = $opt_r; + $chunk = $opt_c; + $users_file = $opt_u; + $admin_user = $opt_E; + $expunge_trash = $opt_X; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $top_mbx = $opt_T; + $test = 1 if $opt_t; # Dry-run + $first_match = 1 if $opt_f; # Apply only the first match, ignore others. + + $chunk = 500 unless $chunk; # How many messages we fetch at a time + + usage() if $opt_h; + + if ( !$rulesfn ) { + usage(); + } + +} + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " imapfilter.pl -S host/sourceUser/sourcePassword "; + print STDOUT "-r \n"; + print STDOUT " Optional arguments:\n"; + print STDOUT " -L logfile\n"; + print STDOUT " -d debug\n"; + print STDOUT " -E \n"; + print STDOUT " -I show IMAP protocol exchanges\n"; + print STDOUT " -c the number of messages processed at a time (default 500)\n"; + print STDOUT " -t test mode (don't actually move the messages\n"; + print STDOUT " -X expunge the Trash mbx, eg -X Trash\n\n"; + exit; + +} + +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $use_utf7 ) { + $str = Unicode::IMAPUtf7::imap_utf7_decode( $str ); + } + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } else { + print STDOUT "$str\n"; + } + print STDOUT "$str\n"; + +} + +sub sigprc { + + $SIG{'HUP'} = 'dieright'; + $SIG{'INT'} = 'dieright'; + $SIG{'QUIT'} = 'dieright'; + $SIG{'ILL'} = 'dieright'; + $SIG{'TRAP'} = 'dieright'; + $SIG{'IOT'} = 'dieright'; + $SIG{'EMT'} = 'dieright'; + $SIG{'FPE'} = 'dieright'; + $SIG{'BUS'} = 'dieright'; + $SIG{'SEGV'} = 'dieright'; + $SIG{'SYS'} = 'dieright'; + $SIG{'PIPE'} = 'dieright'; + $SIG{'ALRM'} = 'dieright'; + $SIG{'TERM'} = 'dieright'; + $SIG{'URG'} = 'dieright'; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + Log("Connecting to host $host port $port"); + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port") if $debug; + + return 1; + +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $conn = shift; + + ($user,$pwd) = split(/:/, $user, 2); + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$pwd) = split(/:/, $admin_user); + ($user) = split(/:/, $user); + my $status = login_plain( $user, $authuser, $pwd, $conn ); + return $status; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + # Do an oauth2 login + $pwd = $1; + $status = login_xoauth2( $user, $pwd, $conn ); + return $status; + } + + # Otherwise do a normal login + + unless ( $user and $pwd ) { + Log("You must supply both user and password in the users file (user:pwd)"); + return 0; + } + + sendCommand ($conn, "1 LOGIN \"$user\" \"$pwd\""); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /NO|BYE|BAD/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE PLAIN {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + @response = (); + sendCommand ($conn, "1 LOGOUT"); + $counter=0; + while (1) { + readResponse ($conn); + last if $response =~ /1 OK/i; + last if $response =~ /1 NO/; + $counter++; + last if $counter > 100; + } + close $conn; +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /NO|BAD/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^NO|^BAD/; + } + +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + $dstmbx = $srcmbx; + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; + + Log(" Expunging mailbox $mbx") if $debug; + + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Unexpected EXPUNGE response: $response "); + return 0; + } + last if ( $response =~ /^1 OK/i ); + } + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK EXPUNGE complete/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error purging messages: $response"); + last; + } + } + + $totalExpunged += $expunged; + +} + +sub expandRules { + +my $rules = shift; +my $user = shift; +my $conn = shift; +my $expand; +my %mbxs; + + # If a user has set a rule which applies to all mailboxes + # rather than just one then add a rule for each mailbox + + my %mbxs; + # Do we have a "search all mbxs" rule? + foreach $rule ( @$rules ) { + ($field,$search,$srcmbx,$dstmbx) = split(/\t/, $rule); + $mbxs{"$srcmbx"} = 1; + $expand = 1 if $srcmbx eq '*'; + } + + unless ( $expand ) { + # No need to change the rules + @mbxs = sort keys %mbxs; + return @mbxs; + } + + # Get a list of the user's mailboxes + + @mbxs = getMailboxList($user, $conn); + + foreach $mbx ( @mbxs ) { + next if $nosel_mbxs{"$mbx"}; + $mbxs{"$mbx"} = 1 unless $mbx eq '*'; + } + delete $mbxs{"*"}; + + # Replace any 'search all mbxs" rules with a rule for + # each mailbox. + + Log("Applying the rule to $top_mbx and its subfolders") if $top_mbx; + + my @newrules; + foreach $rule ( @$rules ) { + ($field,$search,$srcmbx,$dstmbx) = split(/\t/, $rule); + if ( $srcmbx eq '*' ) { + foreach $mbx ( @mbxs ) { + if ( $top_mbx ) { + if ( $mbx !~ /^$top_mbx/ ) { + delete $mbxs{"$mbx"}; + next; + } + } + $newrule = "$field\t$search\t$mbx\t$dstmbx"; + push ( @newrules, $newrule ); + } + } else { + push( @newrules, $rule ); + } + } + + @$rules = @newrules; + if ( $debug ) { + foreach $rule ( @$rules ) { Log("Rule $rule"); } + } + + @mbxs = sort keys %mbxs; + + return @mbxs; +} + +sub evaluateRules { + +my $mbxs = shift; +my $conn = shift; +my $moves = shift; +my $marked = 0; + +# Evaluate the messages in each mailbox against the rules +# and return a list of messages to be moved. + + Log("Checking for filter matches"); + %$moves = (); + @msgs = @moves = (); + foreach $mbx ( @$mbxs ) { + next unless mbxExists( $mbx, $conn ); + $msgcount = count_msgs( $mbx, $conn ); + Log("There are $msgcount msgs in $mbx"); + next if $msgcount == 0; + + %$moves=(); + $i=0; + $start = 1; + $range = "$start:$chunk+1"; + $end = $chunk; + $total_moved = 0; + foreach $rule ( @rules ) { + $i++; + + ($field,$search,$srcmbx,$dstmbx) = split(/\t/, $rule); + next if $srcmbx eq $dstmbx; + next unless lc($mbx) eq lc($srcmbx); + + if ( $rule =~ /^ISEARCH/i ) { + # IMAP SEARCH + $rule = format_isearch_rule( $rule ); + %moves = (); + $start = 1; + $range = "$start:$chunk"; + while( 1 ) { + ($moved,$total) = imap_search( $range, $rule, \%moves, $conn ); + $total_moved += $moved; + moveMessages( $conn, \%moves, \%remhosts ); + + $start = $start + $chunk - $moved; + $start = 1 if $start == 0; + $end = $start + $chunk; + + $end = $total if $end >= $total; + $range = "$start:$end"; + last if $total <= 0; + last if $start >= $end; + } + moveMessages( $conn, \%moves, \%remhosts ) if %moved; + + } else { + # Regular search + $total_moved = 0; + %moves = (); + $start = 1; + $range = "$start:$chunk"; + + while( 1 ) { + $total = getMsgList( $range, $field, $mbx, \@msgs, $conn ); + $moved = get_matches( $field, $search, \@msgs, \%matches ); + + $total_moved += $moved; + + moveMessages( $conn, \%matches, \%remhosts ) if $moved != 0; + + $start = $start + $chunk - $moved; + $start = 1 if $start == 0; + $end = $start + $chunk; + + $end = $total if $end >= $total; + $range = "$start:$end"; + last if $total <= 0; + last if $start >= $end; + } + } + } + } + +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub count_msgs { + +my $mailbox = shift; +my $conn = shift; +my $msgcount; + + # Return a count of the messages in the mailbox + + trim( *mailbox ); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + @response = (); + my $loops; + while ( 1 ) { + readResponse ( $conn ); + last if $loops++ > 99; + if ( $response =~ /\* (.+) EXISTS/i ) { + $msgcount = $1; + } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("Unexpected response: $response. Check that $mailbox exists"); + return 0; + } + } + + return $msgcount; + +} + +sub format_isearch_rule { + +my $rule = shift; + + # Format ISEARCH rule with date + + if ( $rule =~ /\(SINCE (.*?)\)/i ) { + if ( $1 !~ /(.+)-(.+)-(.+)/ ) { + # The day is a relative number of days + $date = get_date( $1 ); + $rule =~ s/SINCE $1/SENTSINCE $date/i; + } + } + if ( $rule =~ /\(SENTSINCE (.*?)\)/i ) { + if ( $1 !~ /(.+)-(.+)-(.+)/ ) { + # The day is a relative number of days + $date = get_date( $1 ); + $rule =~ s/SENTSINCE $1/SENTSINCE $date/i; + } + } + if ( $rule =~ /\(BEFORE (.*?)\)/i ) { + if ( $1 !~ /(.+)-(.+)-(.+)/ ) { + # The day is a relative number of days + $date = get_date( $1 ); + $rule =~ s/BEFORE $1/BEFORE $date/i; + } + } + if ( $rule =~ /\(SENTBEFORE (.*?)\)/i ) { + if ( $1 !~ /(.+)-(.+)-(.+)/ ) { + # The day is a relative number of days + $date = get_date( $1 ); + $rule =~ s/SENTBEFORE $1/SENTBEFORE $date/i; + } + } + + return $rule; + +} + +sub imap_search { + +my $range = shift; +my $rule = shift; +my $moves = shift; +my $conn = shift; +my $msgnums; +my $moved = 0; + + # Execute an IMAP SEARCH using the supplied syntax and + # return a list of matching message numbers + + my ($label,$search,$srcmbx,$dstmbx) = split(/\t/, $rule); + + if ( $debug ) { + Log("This is imap_search"); + Log("search = $search"); + Log("range = $range"); + Log("srcmbx = $srcmbx"); + Log("conn = $conn"); + } + + $search =~ s/^"|"$//g; + Log("Executing search $search on $srcmbx") if $debug; + + $msgcount = 0; + Log("SELECT $srcmbx") if $debug; + sendCommand ( $conn, "1 SELECT \"$srcmbx\""); + while (1) { + readResponse ($conn); + $msgcount = $1 if $response =~ /\* (.+) EXISTS/i; + last if $response =~ /^1 OK/; + return if $response =~ /^1 NO/; + } + + sendCommand ( $conn, "1 SEARCH $range $search"); + my $loops; + $msglist = ''; + while (1) { + readResponse ($conn); + if ( $response =~ /BAD command syntax error/i ) { + Log(" $response: $search"); + return -1; + } + + last if $loops++ > 99; + + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msglist) = split(/\* SEARCH /i, $response); + $msglist =~ s/\s+/,/g; + my @msgs = split(/,/, $msglist ); + $moved = scalar @msgs; + } + last if $response =~ /^1 OK/; + last if $response =~ /^1 NO/; + last if $response =~ /complete/i; + } + + $$moves{"$srcmbx|$dstmbx"} = $msglist; + return ($moved,$msgcount); +} + +sub moveMessages { + +my $srcconn = shift; +my $moves = shift; +my $remhosts = shift; + + # Move the selected messages to their new homes + + return if $test; # Dry run + + $moved=0; + # foreach $mbx ( sort keys %$moves ) { + foreach $mbx ( keys %$moves ) { + $msglist = $$moves{"$mbx"}; + ($srcmbx,$dstmbx) = split(/\|/, $mbx); + + $msglist =~ s/,$//; + # Move 'em + if ( $dstmbx =~ /:/ ) { + $moved = move_remote( $srcconn, $srcmbx, $dstmbx, $msglist, $remhosts ); + } else { + $moved = move_local( $srcconn, $msglist, $srcmbx, $dstmbx ); + } + + # Remove msgnums which are 'copy' not 'move' + + my $msg_list; + + foreach $msgnum ( split(/,/,$msglist) ) { + next if $COPY_ONLY{"$srcmbx|$dstmbx|$msgnum"}; + $msg_list .= "$msgnum,"; + } + chop $msg_list; + + deleteMsgs( $msg_list, $srcmbx, $srcconn ) if $moved; + + Log(" Moved $moved message(s) from $srcmbx to $dstmbx "); + } +} + +sub move_local { + +my $conn = shift; +my $msglist = shift; +my $srcmbx = shift; +my $dstmbx = shift; +my $moved=0; + + # Move filtered messages from the mailbox they are in to + # the designated mailbox on the localhost. + + $msglist =~ s/\s+$//; + return $moved if $msglist eq ''; + + Log(" Moving msg number(s) $msglist to $dstmbx") if $debug; + + # Create the mailbox if it doesn't already exist + unless ( mbxExists( $dstmbx, $conn ) ) { + sendCommand ($conn, "1 CREATE \"$dstmbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|file exists|can\'t create/i)) { + ## print STDOUT "WARNING: $response\n"; + } + last; + } + } + } + sendCommand ($conn, "1 SELECT \"$srcmbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /^1 OK/i ); + if ( $response =~ /^1 NO|^1 BAD/ ) { + Log("Unexpected response to SELECT $srcmbx command: $response"); + return 0; + } + } + + my @msgs = split(/,/, $msglist); + my $moved = $#msgs + 1; + sendCommand ($conn, "1 COPY $msglist \"$dstmbx\""); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD/) { + Log("unexpected COPY response: $response"); + Log("Please verify that mailbox $dstmbx exists"); + exit; + } + } + + return $moved; +} + +sub move_remote { + +my $srcconn = shift; +my $srcmbx = shift; +my $dstmbx = shift; +my $msglist = shift; +my $remhosts = shift; +my $moved=0; + + # Copy filtered messages from the mailbox they are in to + # the designated mailbox on a remote host. + + if ( $dstmbx =~ /(.+):(.+):(.+)/ ) { + ($remhost,$port,$dstmbx) = split(/:/,$dstmbx); + } else { + ($remhost,$dstmbx) = split(/:/,$dstmbx); + } + $remconn = $remhosts{$remhost}{conn}; + $remdelim = $remhosts{$remhost}{delim}; + $remprefix = $remhosts{$remhost}{prefix}; + + if ( $debug ) { + Log("remhost $remhost"); + Log("srcmbx $srcmbx"); + Log("dstmbx $dstmbx"); + Log("srcconn $srcconn"); + Log("remconn $remconn"); + Log("remdelim $remdelim"); + Log("remprefix $remprefix"); + } + + $msglist =~ s/\s+$//; + return $moved if $msglist eq ''; # No msgs to move + + $dstmbx = $srcmbx if $dstmbx eq '*'; + $dstmbx = $remprefix . $dstmbx unless uc($dstmbx) eq 'INBOX'; + + # Create the mailbox if it doesn't already exist + unless ( mbxExists( $dstmbx, $remconn ) ) { + Log("Need to create $dstmbx"); + sendCommand ($remconn, "1 CREATE \"$dstmbx\""); + while ( 1 ) { + readResponse ($remconn); + last if $response =~ /^1 OK/i; + if ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|file exists|can\'t create/i)) { + ## print STDOUT "WARNING: $response\n"; + } + last; + } + } + } + + &sendCommand ($remconn, "1 SELECT \"$dstmbx\""); + while (1) { + &readResponse ($remconn); + last if ( $response =~ /^1 OK/i ); + last if $response =~ /^1 NO|^1 BAD/; + } + + # Get each msg from the source server and add it to the remote one + + $moved=0; + foreach $msgnum ( split(/,/, $msglist) ) { + Log(" Moving msg number $msgnum to $remhost:$mbx") if $debug; + $message = fetchMsg( $msgnum, $srcmbx, $srcconn ); + ($date,$flag) = getMsgInfo( $msgnum, $srcconn); + insertMsg( $remconn, $dstmbx, *message, $flags, $date ); + $moved++; + } + + return $moved; +} + +sub deleteMsgs { + +my $msglist = shift; +my $mbx = shift; +my $conn = shift; +my $rc; + + return if $msglist eq ''; + + # Log("Send select command for $mbx") if $debug; + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /^1 OK/i ); + last if $response=~ /^1 NO|^1 BAD/; + } + + sendCommand ( $conn, "1 STORE $msglist +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 NO|^1 BAD/ ) { + Log("Error setting \Deleted flags"); + Log("Unexpected STORE response: $response"); + return 0; + } + last if $response =~ /^1 OK/i; + } + + expungeMbx( $mbx, $conn ); + +} + +# insertMsg +# +# This routine inserts a message into a user's mailbox +# +sub insertMsg { + +local ($conn, $mbx, *message, $flags, $date) = @_; +local ($lenx); + + Log(" Inserting message into $mbx") if $debug; + $lenx = length($message); + $totalBytes = $totalBytes + $lenx; + $totalMsgs++; + + $flags = flags( $flags ); + + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + readResponse ($conn); + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: $response"); + # next; + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$message\r\n"; + + @response = (); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + # next; + return 0; + } + } + + return 1; +} + +sub flags { + +my $flags = shift; +my @newflags; +my $newflags; + + # Make sure the flags list contains only standard + # IMAP flags. + + return unless $flags; + + $flags =~ s/\\Recent//i; + foreach $_ ( split(/\s+/, $flags) ) { + next unless substr($_,0,1) eq '\\'; + push( @newflags, $_ ); + } + + $newflags = join( ' ', @newflags ); + + $newflags =~ s/\\Deleted//ig if $opt_r; + $newflags =~ s/^\s+|\s+$//g; + + return $newflags; +} + +sub dieright { + local($sig) = @_; + logout( $conn ); + exit(-1); +} + +sub advanced_date_rule { + +my $line = shift; +my $advanced; + + # Return 1 if the date rule uses a comparision operator + # like >, <, or =. In that case we'll need to load the + # DateTime, DateTime::Format::Mail and DateTime::Format::DateParse + # Perl modules. + + my ($field,$rule,$src,$dst) = split(/\t/, $line); + + $rule =~ s/"//g; + my $oper = substr( $rule, 0, 1); + if ( $oper =~ /\>|\<|=/ ) { + # We have a valid compare operator + $advanced = 1; + } + + return $advanced; +} + +sub convert_internaldate { + +my $date = shift; +my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); + + # Convert the date to "DD MMM YYY 00:00" + + my @terms = split(/-/, $$date); + my $mon = $terms[1]; + my $newmon = lc( $mon ); + $newmon = ucfirst( $newmon ); + $$date =~ s/$mon/$newmon/; + + $$date .= " 00:00:00 +0000"; + $$date = "Mon, " . $$date; + $$date =~ s/-/ /g; + +} + +sub convert_delta_date { + +my $delta = shift; +my $time = time(); +my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); + + # Build the date in RFC822 format given a delta of n days. + + my ($sec,$min,$hr,$mday,$mon,$year,$wday,$yday,$idist) = + localtime( time() - $delta*86400); + + $mon =~ s/^0//; + + my $date = sprintf("%02d %02s %04d", $mday, $months[$mon], ($year+1900)); + $date .= ' 00:00:00 +0000'; + + return $date; +} + +sub check_size { + +my $rule_size = shift; +my $msg_size = shift; +my $match = 0; + + # See if the message size triggers an action + + Log("Message size is $msg_size") if $debug; + my $oper = substr($rule_size,0,1); + $rule_size = substr($rule_size,1); + + if ( $oper eq '>' ) { + $match = 1 if $msg_size > $rule_size; + } elsif ( $oper eq '<' ) { + $match = 1 if $msg_size < $rule_size; + } elsif ( $oper eq '=' ) { + $match = 1 if $msg_size == $rule_size; + } else { + Log("Unrecognized operation $oper"); + } + + return $match; +} + +sub isNumber { + +my $value = shift; +my $nonnumber; +my $isnumber=0; + + # Return 1 if the value is a purge number + + for $i ( 0 .. length($value)-1 ) { + $char = substr($value,$i,1); + next if $char =~ /\<|\>/; + $nonnumber = 1 if $char !~ /[0-9]/; + } + my $isnumber = 1 unless $nonnumber; + + return $isnumber; + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub remoteConnections { + +my $connections = shift; +my $conn,$host,$prefix,$delim; + + # Make a connection to each of the remote IMAP servers + # in the rules file. Store the connection handle, the + # mailbox prefix and delimiter for later user. + + foreach my $host ( sort keys %$connections ) { + my $port = $$connections{$host}{port}; + my $user = $$connections{$host}{user}; + my $pwd = $$connections{$host}{pwd}; + exit unless connectToHost( "$host:$port", \$conn); + exit unless login($user,$pwd, $conn); + namespace( $conn, \$prefix, \$delim ); + $$connections{"$host"} = { conn=>$conn, prefix=>$prefix, delim=>$delim }; + Log("$host connection $conn") if $debug; + } + +} + +sub expunge_trash { + +my $mbx = shift; +my $conn = shift; + + Log("Expunging $mbx mailbox"); + + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Unexpected EXPUNGE response: $response "); + return 0; + } + last if ( $response =~ /^1 OK/i ); + } + + # Mark the messages for deletion + + sendCommand ($conn, "1 STORE 1:* +flags \\deleted"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Unexpected STORE response: $response "); + return 0; + } + last if ( $response =~ /^1 OK/i ); + } + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK EXPUNGE complete/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error purging messages: $response"); + last; + } + } + + $totalExpunged += $expunged; + +} + +sub get_date { + +my $days = shift; +my $time = time(); +my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); + + # Get a date in yyyymmdd format. The 'days' param defines how + # many days ago to set the 'date' value. 0 => today, 1 => yesterday. + + my ($sec,$min,$hr,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime( $time - $days*86400 ); + + my $month = $months[$mon]; + my $date = sprintf( "%02d-%02s-%04d", $mday, $month, ($year+1900) ); + + return $date; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $user = shift; +my $conn = shift; +my @mbxs; +my @mailboxes; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + foreach $mbx ( @mbxs ) { + trim( *mbx ); + push( @mailboxes, $mbx ); + } + return @mailboxes; + } + + if ($debug) { Log("Get list of user's mailboxes",2); } + + sendCommand ($conn, "1 LIST \"\" *"); + @response = (); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + %nosel_mbxs = (); + @mbxs = (); + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # those + @mbxs = split(/,/, $mbxList); + } + + return @mbxs; +} + +sub fetchMsg { + +my $msgnum = shift; +my $mbx = shift; +my $conn = shift; +my $message; + + Log(" Fetching msg $msgnum...") if $debug; + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /^1 OK|^1 NO/i ); + } + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + +sub getMsgInfo { + +my $msgnum = shift; +my $conn = shift; +my $flags; +my $internaldate; + + sendCommand ( $conn, "1 FETCH $msgnum (flags internaldate)"); + @response = (); + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + last if $response =~ /^1 NO|^1 BAD/; + } + + @msgs = (); + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ( $response[$i] =~ /^From:\s*(.+)/ ) { + $from = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE "(.+)"/; + # $response[$i] =~ /INTERNALDATE "(.+)" BODY/; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + # if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) { + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + } + + return ($date,$flags); + +} + +sub create_mbx { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if it doesn't already exist + + Log("Need to create $mbx"); + sendCommand ($conn, "1 CREATE \"$mbx\""); + my $loops; + while ( 1 ) { + readResponse ($conn); + last if $loops++ > 99; + last if $response =~ /^1 OK/i; + if ( $response !~ /^\*/ ) { + Log("Unexpected response to CREATE $mbx command: $response"); + } + last; + } + +} + +sub checkRules { + +my $rules = shift; + + $use_utf7 = 0; + foreach my $rule ( @$rules ) { + ($field,$val,$src,$dst) = split(/\t/, $rule ); + $use_utf7 = 1 unless isAscii( $src ); + $use_utf7 = 1 unless isAscii( $dst ); + } + + if ( $use_utf7 ) { + eval 'use Unicode::IMAPUtf7'; + if ( $@ ) { + Log("At least one mailbox contains non-ASCII characters. This means you"); + Log("need to install the Perl Unicode::IMAPUtf7 module in order to "); + Log("convert the mailbox name into the format required by IMAP."); + exit; + } + } + + my @temp; + foreach my $rule ( @$rules ) { + ($field,$val,$src,$dst) = split(/\t/, $rule ); + if ( $use_utf7 ) { + $src = Unicode::IMAPUtf7::imap_utf7_encode( $src ); + $dst = Unicode::IMAPUtf7::imap_utf7_encode( $dst ); + } + push( @temp, "$field\t$val\t$src\t$dst" ); + } + @$rules = @temp; + +} + +sub check_date_format { + +my $date = shift; + + # Some message dates don't follow the rules. Try to fix + # them if we can. + + # If the date has a timezone code like (CST) then remove it. Seems + # that DateTime::Format::Mail -> parse_datetime considers it invalid. + $$date =~ /\((.+)\)/; + $$date =~ s/\(($1)\)//; + + $$date =~ /"(.+)"/; + $$date =~ s/"$1"//; + + $$date =~ s/\s+AM|\s+PM//g; + + # Some dates don't pad the number of characters in the hr:min:sec part to 2. + @terms = split(/\s+/, $$date); + foreach $term ( @terms ) { + next unless $term =~ /(.+):(.+):(.+)/; + $hr = $1; $min = $2; $sec = $3; + $hr = '0' . $hr if length($hr) == 1; + $min = '0' . $min if length($min) == 1; + $sec = '0' . $sec if length($sec) == 1; + my $ts = "$hr:$min:$sec"; + $$date =~ s/$term/$ts/; + last; + } + + if ( $$date =~ /,/ ) { + # Make sure the DOW is just 3 characters + my ($day) = split(/,/, $$date ); + my $newday = substr($day,0,3); + $$date =~ s/$day/$newday/; + } + + +} + +sub compare_dates { + +my $rule_date = shift; +my $msg_date = shift; +my ($earlier,$later,$exact_match,$ignore_ts); +my $match=0; + + # Compare the date in a rule with the date in the message + # and return 1 if the date matches the rule. + + $msg_date =~ s/\|$|^Date: //g; + if ( $debug ) { + Log("rule_date $rule_date"); + Log("msg_date $msg_date"); + } + + check_date_format( \$msg_date ); + + $rule_date =~ s/"//g; + my $oper = substr( $rule_date, 0, 1); + if ( $oper =~ /\>|\<|=/ ) { + # We have a valid compare operator + $later = 1 if $oper eq '>'; + $earlier = 1 if $oper eq '<'; + $exact_match = 1 if $oper eq '='; + $rule_date = substr( $rule_date,1); + } else { + $oper = ''; + } + + # If no operator specified treat date as just + # another string and look for match + # $match = 1 if $rule_date =~ /$msg_date/i; + # return $match; + + # parse input date format + +$rule_date =~ s/^\s+|\s+$//g; + + if ( $rule_date =~ /\*$/ ) { + # Match date regardless of the HH::MM:SS part + $ignore_ts = 1; + $rule_date =~ s/\*$//; + } + + # if ( $rule_date !~ /[\s+]/ ) { + if ( isNumber( $rule_date ) ) { + # Rule has a delta time rather than a fixed date + $rule_date = convert_delta_date( $rule_date ); + } else { + } + + my $rdate = DateTime::Format::DateParse -> parse_datetime( $rule_date ); + + ($msg_date) = split(/ Mount|\(/, $msg_date); + + eval '$mdate = DateTime::Format::Mail -> parse_datetime( $msg_date )'; + if ( $@ ) { + Log("Bad date: $msg_date. The rule cannot be evaluated."); + return ''; + } + + if ( $oper eq '' ) { + # If no operator specified treat date as just another string + ($mdate) = split(/T/, $mdate); + ($rdate) = split(/T/, $rdate); + $match = 1 if $rdate =~ /$mdate/; + return $match; + } + + # compare result is -1 if earlier, 0 if the same, and 1 if later + # + + my $cmp = DateTime -> compare ( $mdate, $rdate ); + + if ( $debug ) { + $line = pack("A5 A25 A25", $cmp, $mdate, $rdate); + Log("$line"); + Log(" oper $oper"); + Log(" mdate $mdate"); + Log(" rdate $rdate"); + Log(" Exact match") if $mdate eq $rdate; + Log(" Message date is earlier than Rule date") if $cmp == -1; + Log(" Message date is later than Rule date") if $cmp == 1; + } + + $oper = -1 if $oper eq '<'; + $oper = 0 if $oper eq '='; + $oper = 1 if $oper eq '>'; + + # Now check the operator the user specified for this rule + + if ( $cmp == $oper ) { + # Log("$msg_date matches"); + $match = 1; + } + + Log("match = $match") if $debug; + + return $match; + +} + +# Get a list of messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $range = shift; +my $field = shift; +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $msgnum; +my %messages; +my $value; +my %values; +my %FLAGS; + + $total = 0; + @$msgs = (); + trim( *mailbox ); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + @response = (); + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /\* (.+) EXISTS/i ) { + $count = $total = $1; + } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("Unexpected response: $response. Check that $mailbox exists"); + return 0; + } + } + + ($start,$end) = split(/:/, $range); + if ( $count < $end ) { + $range = "$start:$count"; + } + + if ( $start > $count ) { + # This mbx is done + return $total; + } + + Log("$mbx has $total msgs") if $debug; + return $total if $total == 0; + + Log("Fetching message range $range") if $debug; + + sendCommand ( $conn, "1 FETCH $range (uid rfc822.size flags internaldate body[header.fields ($field)])"); + @response = (); + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response =~ /Broken pipe|Connection reset by peer/i ) { + Log("Fetch from $mailbox: $response"); + exit; + } + } + + # Get a list of the msgs in the mailbox + # + for $i (0 .. $#response) { + $seen=0; + $flags = ''; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( lc($field) eq 'size' ) { + if ( $response[$i] =~ /rfc822\.size (.+) /i ) { + ($size) = split(/\s+/, $1); + $_ = $response[$i] = "Size: $size"; + } + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $deleted = 0; + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags .= ' \\Unseen' unless $flags =~ /\\Seen/i; + $deleted = 1 if $flags =~ /Deleted/i; + $flags =~ s/^\s+|\s+$|$\|//g; + $flags =~ s/\|//g; + $flags =~ s/\$//g; + $FLAGS{$msgnum} = $flags; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + $date = $1; + # $response[$i] =~ /INTERNALDATE ([^BODY]*)/i; + # $date = $1; + $date =~ s/"//g; + $date =~ s/^\s+//; + ($date) = split(/ /, $date); + $date = uc( $date ); + $internaldate = uc( $date ); + $date =~ s/"//g; + } + + next if /^\*|^1 OK|^\)$/g; + # next unless $_; + + if ( lc( $field ) eq 'size' ) { + $messages{$msgnum} .= "$size|"; + } elsif ( lc( $field ) eq 'internaldate' ) { + $messages{$msgnum} .= "$internaldate|"; + } else { + $messages{$msgnum} .= "$response[$i]|"; + } + } + + foreach $msgnum ( keys %messages ) { + $flags = $FLAGS{$msgnum}; + $val = $messages{$msgnum}; + $val =~ s/^$field: //; + push( @$msgs, "$msgnum|$val|$flags") ; + } + + return $total; +} + +sub get_matches { + +my $field = shift; +my $search = shift; +my $msgs = shift; +my $MATCHES = shift; +my $matches=0; + + # Get a list of msgs which match the search criteria + + %$MATCHES = (); + foreach $_ ( sort {$a<=>$b} @msgs ) { + ($msgnum,$value,$flags) = split(/\|/, $_, 3); + $value =~ s/\|//g; + $value = $flags if uc( $field ) eq 'FLAGS'; + Log(" msgnum $msgnum: $field = $value") if $debug; + Log("Processing rule # $i: $rule") if $debug; + $count = 0; + + $search =~ s/^"|"$//g; + if ( $search eq '-' ) { + # Use the value of the field for the dst mailbox + $$moves{"$value"} .= "$msgnum,"; + } else { + # Mark the msg for transfer to dst mailbox if the field value matches + $search =~ s/^\*/\.\*/; # Replace leading * with .* + + Log("value >$value<") if $debug; + Log("search >$search<") if $debug; + + $match = 0; + if ( (lc( $field ) eq 'date' ) and $xdate ) { + $match = compare_dates( $search, $value ); + } elsif ( (lc( $field ) eq 'internaldate' ) and $xdate ) { + # $value .= " 00:00:00" unless $rule_date !~ /[\s+]/; + convert_internaldate( \$value ); + $match = compare_dates( $search, $value ); + } elsif ( (lc( $field ) eq 'size' ) ) { + $match = check_size( $search, $value ); + } elsif ( (lc( $field ) eq 'flags' ) ) { + $flags =~ s/\\//g; + $flags =~ s/\|//; + my %FLAGS; + $match = 0; + foreach $flag ( split(/\s+/, $flags ) ) { + $match = 1 if uc($flag) eq uc($search); + } + } else { + $match = 1 if $value =~ /$search/i; + } + + if ( $match ) { + $matches++; + if ( $first_match ) { + # If "first match" option is enabled we only apply + # the first rule that matches and ignore any others. + unless( $COPY{"$rule"} ) { + next if $$MATCHES{"$srcmbx $msgnum"}; + } + } + $$MATCHES{"$srcmbx|$dstmbx"} .= "$msgnum,"; + + $$moves{"$srcmbx|$dstmbx"} .= "$msgnum,"; + + if ( $COPY{"$rule"} ) { + # User has flagged this rule for copy not move + $COPY_ONLY{"$srcmbx|$dstmbx|$msgnum"} = 1; + } + + $RULE = $rule; $RULE =~ s/\t/ /g; + Log(" Message in $srcmbx matches rule: '$RULE'"); + + $marked++; + } + + } +} + +return $matches; + +} diff --git a/S/imap_tools.V1.333/imapsync.pl b/S/imap_tools.V1.333/imapsync.pl new file mode 100755 index 0000000..dcf8b65 --- /dev/null +++ b/S/imap_tools.V1.333/imapsync.pl @@ -0,0 +1,2348 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/imapsync.pl,v 1.72 2015/07/06 12:45:54 rick Exp $ + +####################################################################### +# Program name imapsync.pl # +# Written by Rick Sanders # +# # +# Description # +# # +# imapsync is a utility for synchronizing a user's account on two # +# IMAP servers. When supplied with host/user/password information # +# for two IMAP hosts imapsync does the following: # +# 1. Adds any messages on the 1st host which aren't on the 2nd # +# 2. Deletes any messages from the 2nd which aren't on the 1st # +# 3. Sets the message flags on the 2nd to match the 1st's flags# +# # +# imapsync is called like this (single user): # +# ./imapsync -S host1/user1/password1 -D host2/user2/password2 # +# (multiple users) # +# ./imapsync -S host1 -D host2 -u # +# # +# Optional arguments: # +# -d debug # +# -u src_user:src_pwd:dst_user:dst_pwd # +# -L logfile # +# -m mailbox list (sync only certain mailboxes,see usage notes) # +####################################################################### + +use Socket; +use IO::Socket; +use IO::Socket::INET; +use FileHandle; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw( encode_base64 decode_base64 ); + +################################################################# +# Main program. # +################################################################# + +init(); + +foreach $user ( @users ) { + $user =~ s/oauth2:/oauth2---/g; + ($sourceUser,$sourcePwd,$destUser,$destPwd) = split(/:/, $user); + + # Replace the placeholder for the : character if present + $sourceUser =~ s/XXXXXX/:/g; + $sourcePwd =~ s/XXXXXX/:/g; + $destUser =~ s/XXXXXX/:/g; + $destPwd =~ s/XXXXXX/:/g; + + if ( $src_admin_user and !$destPwd ) { + # Do an admin login using AUTHENTICATION = PLAIN + $sourceUser .= ":$src_admin_user"; + $src_admin_user =~ /(.+)\s*:\s*(.+)/; + $src_admin_pwd = $2; + } + + if ( $dst_admin_user and !$destPwd ) { + # Do an admin login using AUTHENTICATION = PLAIN + $destUser .= ":$dst_admin_user"; + $dst_admin_user =~ /(.+)\s*:\s*(.+)/; + $dst_admin_pwd = $2; + } + + # Get list of all messages on the source host by Message-Id + # + connectToHost($sourceHost, \$src) or exit; +$SOURCE = $src; + if ( $sourceUser =~ /(.+)[:;](.+)[:;](.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + next unless login_plain( $sourceUser, $src ); + } else { + # Otherwise do an ordinary login + next unless login($sourceUser,$sourcePwd, $src); + } + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + + connectToHost( $destHost, \$dst ) or exit; +$DEST = $dst; + + if ( $destUser =~ /(.+)[:;](.+)[:;](.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + next unless login_plain( $destUser, $dst ); + } else { + # Otherwise do an ordinary login + unless ( login( $destUser,$destPwd, $dst ) ) { + logout( $src ); + next; + } + } + namespace( $dst, \$dstPrefix, \$dstDelim, $opt_y ); + + # Create mailboxes on the dst if they don't already exist + my @source_mbxs = getMailboxList( $src ); + + $n = scalar @source_mbxs; + Log("There are $n mailboxes to sync"); + + # Exclude certain ones if that's what the user wants + exclude_mbxs( \@source_mbxs ) if $excludeMbxs; + + map_mbx_names( \%mbx_map, $srcDelim, $dstDelim ); + + createDstMbxs( \@source_mbxs, $dst ); + + # Check for new messages and existing ones with new flags + $adds=$updates=$deletes=0; + $would_have_added=$would_have_deleted=$would_have_updated=0; + @moves = (); + ($added,$updated,$deleted) = check_for_adds( \@source_mbxs, \%REVERSE, $src, $dst ); + + logout( $src ); + logout( $dst ); + + Log("\nSummary of results for $user"); + if ( $test ) { + Log(" Would have added $would_have_added"); + Log(" Would have updated $would_have_updated"); + Log(" Would have deleted $would_have_deleted"); + } else { + Log(" Added $added"); + Log(" Updated $updated"); + Log(" Deleted $deleted"); + if ( @moves ) { + $moved = scalar @moves; + Log(" Moved $moved"); + } + } + +} + +summarize(); + +exit; + +sub init { + + $os = $ENV{'OS'}; + + processArgs(); + + if ( $users_file ) { + ($sourceHost) = split(/\//, $opt_S); + ($destHost) = split(/\//, $opt_D); + if ( !open(U, "<$users_file") ) { + print STDERR "Error opening users file $users_file: $!\n"; + exit; + } + my $n; + while( ) { + $n++; + s/^\s+//g; + next if /^#/; + chomp; + next unless $_; + s/\\:/XXXXXX/g; # Replace : with a placeholder + if ( !/(.+):(.*):(.+):(.*)/ ) { + print STDERR "Error at line $n in users file\n"; + print STDERR "Not in srcuser:srcpwd:dstuser:dstpwd format\n"; + exit; + } + push( @users, $_ ); + } + close U; + + } else { + # ($sourceHost,$sourceUser,$sourcePwd) = split(/\//, $opt_S); + # ($destHost, $destUser, $destPwd) = split(/\//, $opt_D); + + if ( $opt_S =~ /\\/ ) { + ($sourceHost, $sourceUser, $sourcePwd) = split(/\\/, $opt_S); + } else { + ($sourceHost, $sourceUser, $sourcePwd) = split(/\//, $opt_S); + } + + if ( $opt_D =~ /\\/ ) { + ($destHost, $destUser, $destPwd) = split(/\\/, $opt_D); + } else { + ($destHost, $destUser, $destPwd) = split(/\//, $opt_D); + } + push( @users, "$sourceUser:$sourcePwd:$destUser:$destPwd" ); + } + + $timeout = 60 unless $timeout; + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">>$logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("$0 starting\n"); + Log("Syncing messages after $opt_s") if $opt_s; + + if ( $source_archive ) { + # The user wants messages on the source in certain mailboxes to be moved + # to archive mailboxes on the source after being copied to the destination + foreach $term ( split(/,/, $source_archive) ) { + # mbx1 is the source mbx and mbx2 is the archive mbx on the source + ($mbx1,$mbx2) = split(/:/, $term); + Log("Messages in $mbx1 on the source will be moved to $mbx2 on the source after syncing"); + $SOURCE_ARCHIVE{"$mbx1"} = $mbx2; + } + } + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + Log("Running in test mode, no changes will be made") if $test; + +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + $fd = $NEW{$fd} if $NEW{$fd}; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $fd = $NEW{$fd} if $NEW{$fd}; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } + + if ( $response =~ /^\* BYE/ ) { + # Log("The server closed the connection: $response "); + # exit; + } + + if ( $exchange and $response =~ /^1 NO|^1 BAD/ ) { + $errors++; + if ( $errors == 9 ) { + $newdst = exchange_workaround() if $errors == 9; + $NEW{$dst} = $newdst; + } + } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logfile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $line =~ /^\>\> 1 LOGIN (.+) "(.+)"/ ) { + # Obscure the password for security's sake + $line = ">> LOGIN $1 \"XXXX\""; + } + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + + } + + if ( $quiet ) { + print STDOUT "$str\n" unless $str =~ /^\>|^\<|^Inserting/g; + } else { + print STDOUT "$str\n"; + } + +} + +# insertMsg +# +# This routine inserts an RFC822 messages into a user's folder +# + +sub insertMsg { + +local ($conn, $mbx, *message, $flags, $date, $msgid) = @_; +local ($lenx); + + Log("Inserting message $msgid") if $debug; + $totalMsgs++; + +$conn = $NEW{$conn} if $NEW{$conn}; + + if ( $wrap_long_lines ) { + $new_message = ''; + foreach $_ ( split(/\r\n/, $message ) ) { + if ( length( $_ ) < 1000 ) { + $new_message .= "$_\r\n"; + next; + } + $len = length( $_ ); + Log(" Need to wrap this line: length = $len") if $debug; + # Wrap the line in chunks of 1,000 chars + $line = wrap_long_line( $_ ); + $new_message .= $line; + } + $message = $new_message; + } + + $lenx = length($message); + $totalBytes = $totalBytes + $lenx; + + $flags = flags( $flags ); + fixup_date( \$date ); + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + readResponse ($conn); + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: $response"); + # next; + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$message\r\n"; + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + # next; + return 0; + } + } + + return 1; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $verbose; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $verbose; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + exit; + } + } + Log("Connected to $host on port $port"); + + return 1; +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# + +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $pwd =~ /^oauth2---(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token") if $debug; + $status = login_xoauth2( $user, $token, $conn ); + return $status; + } + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + Log("Authenticating as $user"); + sendCommand ($conn, "1 LOGIN \"$user\" \"$pwd\""); + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + unless ( $exchange_override ) { + $exchange = 1; + Log("The destination is an Exchange server"); + } + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK|^1 BYE/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $conn = shift; +my $delim = shift; +my @mbxs; +my @mailboxes; +my $COUNTER; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + foreach $mbx ( @mbxs ) { + # trim( *mbx ); + push( @mailboxes, $mbx ); + } + return @mailboxes; + } + + Log("Get list of mailboxes") if $verbose; + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + %nosel_mbxs = (); + @mbxs = (); + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + $mbx =~ s/\s+/ /g if $trim_mbx_spaces; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + if ($mbx =~ /^\#|^Public Folders/i) { + # Skip public mbxs + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# exclude_mbxs +# +# Exclude certain mailboxes from the list if the user +# has provided an exclude list with the -e argument + +sub exclude_mbxs { + +my $mbxs = shift; +my @new_list; +my %exclude; + + foreach my $exclude ( split(/,/, $excludeMbxs ) ) { + $exclude{"$exclude"} = 1; + } + foreach my $mbx ( @$mbxs ) { + next if $exclude{"$mbx"}; + push( @new_list, $mbx ); + } + + @$mbxs = @new_list; + +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# + +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $list = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $msgid; +my $header_date; +my $from; +my $subject; +my $uid; + + # Get a list of the msgs in this mailbox + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + @$msgs = (); + %$list = (); + trim( *mailbox ); + return if $mailbox eq ""; + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + return if $empty; + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date Message-ID Subject)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + last if $response =~ /^1 NO|^1 BAD/; + } + + @$msgs = (); + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent|\\Forwarded//ig; + } + + if ( $response[$i] =~ /UID (.+)/ ) { + ($uid) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^Message-ID:\s*(.*)/i ) { + $msgid = $1; + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + # if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) { + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /Subject:\s*(.+)/i) { + $subject = $1; + } + + if ( $response[$i] =~ /Date:\s*(.+)/i) { + $header_date = $1; + } + + if ( $response[$i] =~ /From:\s*(.+)/i) { + $from = $1; + } + + # if ( $msgnum and $date and $msgid ) { + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + if ( $ignore_msgids ) { + if ( $IGNORE_MSGIDS{"$msgid"} ) { + Log("Ignoring $msgid"); + next; + } + } + + if ( $msgid eq '' ) { + # The message lacks a message-id so construct one. + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)//g; + Log("msgnum $msgnum has no msgid, build one as $msgid") if $debug; + } + + push (@$msgs,"$msgid||||||$msgnum||||||$flags||||||$date||||||$header_date||||||$uid"); + $$list{"$msgid"} = "$msgnum,$flags"; + $msgnum=$msgid=$date=$flags=$header_date=$from=$subject=$uid=''; + } + } + + +} + +# getDatedMsgList +# +# Get a list of the user's messages in a mailbox on +# the host which were sent after the specified date +# +sub getDatedMsgList { + +my $mailbox = shift; +my $date = shift; +my $msgs = shift; +my $list = shift; +my $conn = shift; +my ($seen, $empty, @list,$msgid,$header_date,$from,$subject); +my $loops; +my $uid; + + # Get a list of messages sent after the specified date + + my @list; + @$msgs = (); + %$list = (); + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + if ( $date !~ /-/ ) { + # Delta in days, convert to DD-MMM-YYYY + $date = get_date( $sync_since ); + } + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ / EXISTS/i) { + $response =~ /\* ([^EXISTS]*)/; + Log(" There are $1 messages in $mailbox"); + } elsif ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected EXAMINE response: $response"); + return 0; + } + if ( $loops++ > 100 ) { + Log("No response to EXAMINE command, skipping this mailbox"); + last; + } + } + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + # + # Get list of messages sent after the reference date + # + Log(" Get messages sent after $date") if $debug; + $nums = ""; + sendCommand ($conn, "1 SEARCH SENTSINCE \"$date\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response =~ /^\*\s+SEARCH/i ) { + ($nums) = ($response =~ /^\*\s+SEARCH\s+(.*)/i); + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected SEARCH response: $response"); + return; + } + } + if ( $nums eq "" ) { + Log (" $mailbox has no messages sent after $date") if $debug; + return; + } + # Log(" Msgnums for messages in $mailbox sent after $date $nums") if $debug; + $nums =~ s/\s+/ /g; + @msgList = (); + @msgList = split(/ /, $nums); + + my $n = scalar @msgList; + if ( $n == 0 ) { + # No msgs in this mailbox + return 1; + } else { + Log(" There are $n messages after $date"); + } + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + +@$msgs = (); +for $num (@msgList) { + + sendCommand ( $conn, "1 FETCH $num (uid flags internaldate body[header.fields (Message-Id From Subject Date)])"); + + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + $flags = ''; + foreach $_ ( @response ) { + last if /^1 OK FETCH complete/i; + $response = $_; + + if ( /FLAGS/ ) { + # Get the list of flags + /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent|\\Forwarded//ig; + } + + if ( /Message-Id:\s*(.*)/i ) { + $msgid = $1; + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + if ( $response[$i] =~ /UID (.+)/ ) { + ($uid) = split(/\s+/, $1); + } + + if ( /Date:\s*(.+)/i) { + $header_date = $1; + } + + if ( /Subject:\s*(.+)/i) { + $subject = $1; + } + + if ( /From:\s*(.+)/i) { + $from = $1; + } + + if ( /INTERNALDATE/) { + /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + # if ( $msgid and $msgnum and $date and $msgid ) { + + if ( /^\)/ or ( /\)\)$/ ) ) { + # End of header + if ( $msgid eq '' ) { + # The message lacks a message-id so construct one. + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)//g; + Log("msgnum $msgnum has no msgid, build one as $msgid") if $debug; + } + + $$list{"$msgid"} = "$msgnum,$flags"; + push (@$msgs,"$msgid||||||$msgnum||||||$flags||||||$date||||||$header_date||||||$uid"); + $msgnum=$msgid=$date=$flags=$header_date=$from=$subject=$uid=''; + } + } + } + + return 1; +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; +my $created; +my $loops; + + # Create the mailbox if necessary + + return if uc( $mbx ) eq 'INBOX'; + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $created = 1; + last; + } + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD/ ) { + Log ("Error creating $mbx: $response"); + last; + } + if ( $loops++ > 100 ) { + Log("No response to CREATE command, skipping this mailbox"); + last; + } + + } + Log("Created mailbox $mbx") if $created; +} + +sub fetchMsg { + +my $msgnum = shift; +my $conn = shift; +my $message; +my $loops; +my $error=1; + + $item = 'BODY[]'; + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + # sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + sendCommand( $conn, "1 FETCH $msgnum ($item)"); + while (1) { + $loops++; + # Log("loops = $loops") if $debug; + if ( $loops > 99 ) { + # Something is wrong. The server should have provided the + # message by now. Break out of the loop and return an empty message. + $message = ''; + Log("Error1: Unable to fetch message after 99 tries"); + last; + } + readResponse ($conn); + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Unexpected FETCH response: $response"); + return ''; + } + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$dstMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$dstMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{[0-9]+\}/i) { + $item =~ s/BODY\[\]/BODY\\[\\]/ if $response =~ /BODY/; + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + $loops = 0; + while ( $cc < $len ) { + $loop++; + # Log("loops = $loops") if $debug; + if ( $loops > 99 ) { + # Something is wrong. The server should have provided the + # message by now. Break out of the loop and return an empty message. + $message = ''; + Log("Error2: Unable to fetch message after 99 tries"); + last; + } + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + +sub fetchMsgFlags { + +my $msgnum = shift; +my $conn = shift; +my $flags; +my $loops; + + # Read the IMAP flags for a message + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand( $conn, "1 FETCH $msgnum (flags)"); + while (1) { + $loops++; + Log("XXXLoops $loops") if $debug; + if ( $loops > 99 ) { + Log("fetchMsgFlags failed to receive the requested flags at $loops loops"); + Log("Giving up on this message"); + last; + } + readResponse ($conn); + if ( $response =~ /^1 OK|^1 BAD|^1 NO/i ) { + last; + } + if ( $response =~ /\* $msgnum FETCH \(FLAGS \((.+)\)\)/i ) { + $flags = $1; + Log(" $msgnum - flags $flags") if $verbose; + } + } + + return $flags; +} + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " imapsync -S sourceHost/sourceUser/sourcePassword\n"; + print STDOUT " -D destHost/destUser/destPassword\n"; + print STDOUT " -d debug\n"; + print STDOUT " -L logfile\n"; + print STDOUT " -s Sync messages since this date (DD-MMM-YYYY) or number of days ago\n"; + print STDOUT " -m mailbox list (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n"; + print STDOUT " -e exclude mailbox list\n"; + print STDOUT " -u format srcuser:srcpwd:dstuser:dstpwd\n"; + print STDOUT " -n do not delete messages from destination\n"; + print STDOUT " -E source admin user and password\n"; + print STDOUT " -F destination admin user and password\n"; + print STDOUT " -R collapse spaces in mbx names to 1 space (Gmail doesn't accept multiples\n"; + print STDOUT " -W wrap lines longer than 1,000 characters\n"; + print STDOUT " -t test run. Say what would have been done but don't do it\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dvS:D:L:m:e:hIx:y:M:s:nNqu:E:F:f:i:RWtA:" ) ) { + usage(); + } + + $mbxList = $opt_m; + $excludeMbxs = $opt_e; + $logfile = $opt_L; + $mbx_map_fn = $opt_M; + $sync_since = $opt_s; + $users_file = $opt_u; + $no_deletes = 1 if $opt_n; + $debug = 1 if $opt_d; + $verbose = 1 if $opt_v; + $showIMAP = 1 if $opt_I; + $quiet = 1 if $opt_q; + $test = 1 if $opt_t; + # -N option deprecated + $include_nosel_mbxs = 1 if $opt_N; + $src_admin_user = $opt_E; + $dst_admin_user = $opt_F; + $msgs_per_folder = $opt_f; + $ignore_msgids = $opt_i; + $trim_mbx_spaces = 1 if $opt_R; + $wrap_long_lines = 1 if $opt_W; + $source_archive = $opt_A; + + usage() if $opt_h; + + if ( $ignore_msgids ) { + # -i points to a file of msgids we are to ignore + if (!open(I, "<$ignore_msgids") ) { + print STDERR "Error opening $ignore_msgids: $!\n"; + exit; + } + while( ) { + chomp; + s/^\s+|\s+$//g; + next if /^#/; + $IGNORE_MSGIDS{"$_"} = 1; + } + close I; + } + +} + +sub deleteMsg { + +my $conn = shift; +my $msgnum = shift; +my $rc; + + # Mark a message for deletion by setting \Deleted flag + + Log(" msgnum is >$msgnum<") if $debug; + ($msgnum,$flags) = split(/,/,$msgnum); + + if ( $msgnum eq '' ) { + Log("Error: msgnum is blank"); + return 0; + } + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked $msgid for delete") if $verbose; + last; + } + if ( $response =~ /^\* BYE/ ) { + Log("Fatal error: $response"); + Log("The server has ended the session"); + $rc = -1; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $conn = shift; +my $mbx = shift; +my $status; +my $loops; + + # Remove the messages from a mailbox + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + Log("Expunging $mbx mailbox") if $verbose; + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/ ) { + $status = 1; + last; + } + + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Error selecting mailbox $mbx: $response"); + last; + } + if ( $loops++ > 100 ) { + Log("No response to SELECT command, skipping this mailbox"); + last; + } + } + + return unless $status; + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ( $conn, "1 EXPUNGE"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + print "Error expunging messages: $response\n"; + last; + } + } + +} + +sub check_for_adds { + +my $source_mbxs = shift; +my $REVERSE = shift; +my $src = shift; +my $dst = shift; +my @sourceMsgs; + + # Compare the contents of the user's mailboxes on the source + # with those on the destination. Add any new messages to the + # destination and update if necessary the flags on the existing + # ones. + + if ( %SOURCE_ARCHIVE ) { + # If the user wants source archiving create the archive mbxs if they don't exist + while(($mbx,$archive_mbx) = each( %SOURCE_ARCHIVE ) ) { + createMbx( $archive_mbx, $src ) unless mbxExists( $archive_mbx, $src ); + } + } + + $total_added=$total_updated=$total_deleted=0; + $would_have_added=$would_have_deleted=$would_have_updated=0; + ($user) = split(/:/, $destUser); + Log("Checking for adds & updates for $user"); + foreach my $src_mbx ( @$source_mbxs ) { + my $added=$updated=0; + next if $src_mbx eq ""; + + # Mbxs marked NOSELECT don't hold any messages so after creating them + # we don't need to do anything else. + next if $nosel_mbxs{"$src_mbx"}; + + expungeMbx( $src, $src_mbx ) unless $test; + $dst_mbx = mailboxName( $src_mbx,$srcPrefix,$srcDelim,$dstPrefix,$dstDelim ); + $dst_mbx =~ s/\s+/ /g if $trim_mbx_spaces; + + # Record the association between source and dest mailboxes + $$REVERSE{"$dst_mbx"} = $src_mbx; + next if $src_mbx eq ""; + + next unless selectMbx( $src_mbx, $src, 'EXAMINE' ); + + @sourceMsgs=(); + + if ( $sync_since ) { + getDatedMsgList( $src_mbx, $sync_since, \@sourceMsgs, \%sourceList, $src ); + } else { + getMsgList( $src_mbx, \@sourceMsgs, \%sourceList, $src ); + } + getMsgList( $dst_mbx, \@destMsgs, \%destList, $dst ); + + # if ( $verbose ) { + # Log(" src_mbx $src_mbx has the following $n messages"); + # foreach $_ ( @sourceMsgs ) { + # Log(" $_"); + # } + # } + + selectMbx( $dst_mbx, $dst, 'SELECT' ); + + my $msgcount = $#sourceMsgs + 1; + Log("source $src_mbx has $msgcount messages"); + foreach $_ ( @sourceMsgs ) { + Log(" $_") if $verbose; + ($msgid,$msgnum,$src_flags,$date,$header_date,$uid) = split(/\|\|\|\|\|\|/, $_,6); + $src_flags = flags( $src_flags ); + next if $src_flags =~ /\\Deleted/; # Don't sync deleted messages + + if ( !$destList{"$msgid"} ) { + # The msg doesn't exist in the mailbox on the dst, need to add it. + + if ( $test ) { + Log("Would haves added msgnum $msgnum") if $verbose; + $would_have_added++; + next; + } + + Log(" Need to insert $msgnum") if $verbose; + $message = fetchMsg( $msgnum, $src ); + next unless $message; + $src_flags = validate_flags( $src_flags ); + $added++ if insertMsg( $dst, $dst_mbx, *message, $src_flags, $date, $msgid ); + + Log(" Added $added msgs") if $added/100 == int($added/100); + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $added == $msgs_per_folder; + } + + if ( $SOURCE_ARCHIVE{"$src_mbx"} ) { + push( @moves, $uid ); + } + + } else { + # The message exists, see if the flags have changed. + Log(" msgnum=$msgnum exists, check its flags") if $verbose; + # $dst_flags = fetchMsgFlags( $dst_msgnum, $dst ); + ($dst_msgnum,$dst_flags) = split(/,/, $destList{"$msgid"}); + + sort_flags( \$src_flags ); + sort_flags( \$dst_flags ); + + unless ( $dst_flags eq $src_flags ) { + if ( $test ) { + Log(" Would have updated the flags for msgnum $dst_msgnum") if $verbose; + $would_have_updated++; + next; + } + + if ( $verbose ) { + Log(" Updating the flags for msgnum $dst_msgnum"); + Log("src_flags $src_flags"); + Log("dst_flags $dst_flags"); + } + $rc = setFlags( $dst_msgnum, $src_flags, $dst_flags, $dst ); + return $rc if $rc == -1; + $updated++; + } + } + } + if ( $test ) { + Log(" Would have added $would_have_added messages to $dst_mbx"); + } else { + Log(" Added $added messages to $dst_mbx"); + } + + ($user) = split(/:/, $destUser ); + + if ( $test ) { + push( @summary, "$user:$dst_mbx:Would have added:$would_have_added" ); + push( @summary, "$user:$dst_mbx:Would have updated:$would_have_updated" ); + } else { + push( @summary, "$user:$dst_mbx:added: $added" ); + push( @summary, "$user:$dst_mbx:Updated: $updated" ); + } + + if ( $SOURCE_ARCHIVE{"$src_mbx"} ) { + my $archive_mbx = $SOURCE_ARCHIVE{"$src_mbx"}; + createMbx( $archive_mbx, $src ) unless mbxExists( $archive_mbx, $src ); + selectMbx( $src_mbx, $src, 'SELECT' ); + foreach $uid ( @moves ) { + move_msg( $uid, $archive_mbx, $src ) unless $test; + } + } + + # Remove messages from the dst mbx that no longer exist on + # the src mbx + + $deleted = check_for_deletes( $src_mbx, $dst_mbx, \%sourceList, $dst, $src ); + last if $deleted == -1; # Server dropped our session. + + $total_added += $added; + $total_updated += $updated; + $total_deleted += $deleted; + } + + if ( $test ) { + return ($total_added,$total_updated,$total_deleted); + } else { + return ($total_added,$total_updated,$total_deleted); + } +} + +sub check_for_deletes { + +my $src_mbx = shift; +my $dst_mbx = shift; +my $sourceList = shift; +my $dst = shift; +my $src = shift; +my $deleted=0; +my $deletes=0; +my $total_deletes=0; + + # Delete any messages on the dst that are no longer on the src. + + return 0 if $no_deletes; + + if ( $sync_since ) { + getDatedMsgList( $dst_mbx, $sync_since, \@destMsgs, \%destList, $dst ); + } else { + getMsgList( $dst_mbx, \@destMsgs, \%destList, $dst ); + } + + ($user) = split(/:/, $destUser); + Log("Checking $dst_mbx for deletes for $user") if $verbose; + + $n = keys %$sourceList; + + selectMbx( $dst_mbx, $dst, 'SELECT' ); + selectMbx( $src_mbx, $src, 'EXAMINE' ); + + foreach $_ ( @destMsgs ) { + ($msgid,$dst_msgnum,$dst_flags,$date,$header_date,$uid) = split(/\|\|\|\|\|\|/, $_,6); + if ( $verbose ) { + Log(" msgid $msgid"); + Log(" dst msgnum $dst_msgnum"); + Log(" dst_mbx $dst_mbx"); + } + + if ( !$$sourceList{"$msgid"} ) { + # The msg doesn't exist in the mailbox on the source, need to remove it from the dest + + if ( $test ) { + Log("Removing $msgid from the dest") if $verbose; + $would_have_deleted++; + next; + } + + Log("Removing $msgid from the dest") if $verbose; + $rc = deleteMsg( $dst, $dst_msgnum ); + if ( $rc == 1 ) { + # Need to expunge messages from this mailbox when we're done + $deletes++; + $deleted=1; + } elsif ( $rc == -1 ) { + # The server terminated our session. + return $rc; + } + } + } + + if ( $test ) { + $deletes = $would_have_deleted; + Log(" Would have deleted $deletes messages from $dst_mbx"); + } else { + expungeMbx( $dst, $dst_mbx ) if $deleted; + Log(" Deleted $deletes messages from $dst_mbx"); + } + + ($user) = split(/:/, $destUser ); + + if ( $test ) { + push( @summary, "$user:$dst_mbx:Would have deleted:$deletes" ); + } else { + push( @summary, "$user:$dst_mbx:deleted: $deletes" ); + } + + return $deletes; +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; +my $namespace; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /NO|BAD/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + $namespace = 0; + last; + } + } + +# if ( !$namespace and !$opt_x ) { +# # Not implemented yet. Needs more testing +# # NAMESPACE is not supported by the server so try to +# # figure out the mbx delimiter and prefix +# $$delimiter = get_mbx_delimiter( $conn ); +# $$prefix = get_mbx_prefix( $delimiter, $conn ); +# +# return; +# } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^1 NO|^1 BAD/; + } + + if ( $verbose ) { + Log("prefix $$prefix"); + Log("delim $$delimiter"); + } + +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $direction = shift; +my $dstmbx; + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + # Change the mailbox name if the user has supplied mapping rules. + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = '\.' if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + return $dstmbx; +} + +sub flags { + +my $flags = shift; +my @newflags; +my $newflags; +my %standard_flags = ( '\\Seen', 1, '\\Deleted', 1, '\\Draft', 1, + '\\Answered', 1, '\\Flagged', 1, '\\Recent', 1 ); + + # Make sure the flags list contains standard + # IMAP flags and optionally custom tags + + return unless $flags; + + $flags =~ s/\\Recent//i; + foreach $_ ( split(/\s+/, $flags) ) { + # push( @newflags, $_ ) if substr($_,0,1) eq '\\'; + if ( substr($_,0,1) eq '\\' ) { + # Should be a standard flag. Make sure it is. + $_ = lc( $_ ); + s/^\\//; + $_ = ucfirst( $_ ); + $_ = '\\' . $_; + push( @newflags, $_ ) if $standard_flags{$_}; + } + if ( $opt_T ) { + # Include user-defined flags + push( @newflags, $_ ) if substr($_,0,1) eq '$'; + } + } + + $newflags = join( ' ', @newflags ); + + $newflags =~ s/\\Deleted//ig if $opt_r; + $newflags =~ s/^\s+|\s+$//g; + + return $newflags; +} + +sub createDstMbxs { + +my $mbxs = shift; +my $dst = shift; +my %dst_mbxs; + + # Create a corresponding mailbox on the dst for each one + # on the src. + + my @dst_mbxs = getMailboxList( $dst ); + foreach $_ ( @dst_mbxs ) { + $dst_mbxs{"$_"} = 1; + } + + foreach my $mbx ( @$mbxs ) { + $dstmbx = mailboxName( $mbx,$srcPrefix,$srcDelim,$dstPrefix,$dstDelim ); + $dstmbx =~ s/\s+/ /g if $trim_mbx_spaces; + + if ( $test and !mbxExists($dstmbx, $dst) ) { + Log("Would have created $dstmbx on the destination") unless uc( $mbx ) eq 'INBOX'; + } else { + ### createMbx( $dstmbx, $dst ) unless mbxExists( $dstmbx, $dst ); + createMbx( $dstmbx, $dst ) unless $dst_mbxs{"$dstmbx"}; + } + } +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; +my $loops; + + # Determine whether a mailbox exists + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD/ ) { + $status = 0; + last; + } + if ( $loops++ > 100 ) { + Log("No response to EXAMINE command, skipping this mailbox"); + last; + } + } + + return $status; +} + +sub sort_flags { + +my $flags = shift; +my @newflags; +my $newflags; + + # Make sure the flags list contains only standard + # IMAP flags. Sort the list to make comparision + # easier. + + return unless $$flags; + + $$flags =~ s/\\Recent|\\Forwarded//ig; + foreach $_ ( split(/\s+/, $$flags) ) { + next unless substr($_,0,1) eq '\\'; + push( @newflags, $_ ); + } + + @newflags = sort @newflags; + $newflags = join( ' ', @newflags ); + $newflags =~ s/^\s+|\s+$//g; + + $$flags = $newflags; +} + +sub setFlags { + +my $msgnum = shift; +my $new_flags = shift; +my $old_flags = shift; +my $conn = shift; +my $rc; + + # Set the message flags as indicated. + + if ( $verbose ) { + Log("old flags $old_flags"); + Log("new flags $new_flags"); + } + + # Clear the old flags + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ( $conn, "1 STORE $msgnum -FLAGS ($old_flags)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + last; + } + if ( $response =~ /^\* BYE/ ) { + Log("Fatal error: $response"); + Log("The server has ended the session"); + return -1; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting flags for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + # Set the new flags + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS ($new_flags)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting flags for msg $msgnum: $response"); + $rc = 0; + last; + } + } +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; +my $type = shift; +my $status; +my $loops; + + # Select the mailbox. Type is either SELECT (R/W) or EXAMINE (R). + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand( $conn, "1 $type \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + $status = 1; + last; + } elsif ( $response =~ /does not exist/i ) { + $status = 0; + return 0; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Unexpected response to SELECT/EXAMINE $mbx command: $response"); + return 0; + } + + if ( $loops++ > 100 ) { + Log("No response to $type command, skipping this mailbox"); + return 0; + } + } + + return $status; + +} + +sub map_mbx_names { + +my $mbx_map = shift; +my $srcDelim = shift; +my $dstDelim = shift; + + # The -M argument causes imapcopy to read the + # contents of a file with mappings between source and + # destination mailbox names. This permits the user to + # to change the name of a mailbox when copying messages. + # + # The lines in the file should be formatted as: + # : + # For example: + # Drafts/2008/Save: Draft_Messages/2008/Save + # Action Items: Inbox + # + # Note that if the names contain non-ASCII characters such + # as accents or diacritical marks then the Perl module + # Unicode::IMAPUtf7 module must be installed. + + return unless $mbx_map_fn; + + unless ( open(MAP, "<$mbx_map_fn") ) { + Log("Error opening mbx map file $mbx_map_fn: $!"); + exit; + } + $use_utf7 = 0; + while( ) { + chomp; + s/[\r\n]$//; # In case we're on Windows + s/^\s+//; + next if /^#/; + next unless $_; + ($srcmbx,$dstmbx) = split(/\s*:\s*/, $_); + + # Unless the mailbox name is entirely ASCII we'll have to use + # the Modified UTF-7 character set. + $use_utf7 = 1 unless isAscii( $srcmbx ); + $use_utf7 = 1 unless isAscii( $dstmbx ); + + $srcmbx =~ s/\//$srcDelim/g; + $dstmbx =~ s/\//$dstDelim/g; + + $$mbx_map{"$srcmbx"} = $dstmbx; + + } + close MAP; + + if ( $use_utf7 ) { + eval 'use Unicode::IMAPUtf7'; + if ( $@ ) { + Log("At least one mailbox map contains non-ASCII characters. This means you"); + Log("have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox "); + Log("names between the source and destination servers."); + print "At least one mailbox map contains non-ASCII characters. This means you\n"; + print "have to install the Perl Unicode::IMAPUtf7 module in order to map mailbox\n"; + print "names between the source and destination servers.\n"; + exit; + } + } + + my %temp; + foreach $srcmbx ( keys %$mbx_map ) { + $dstmbx = $$mbx_map{"$srcmbx"}; + Log("Mapping src:$srcmbx to dst:$dstmbx"); + if ( $use_utf7 ){ + # Encode the name in Modified UTF-7 charset + $srcmbx = Unicode::IMAPUtf7::imap_utf7_encode( $srcmbx ); + $dstmbx = Unicode::IMAPUtf7::imap_utf7_encode( $dstmbx ); + } + $temp{"$srcmbx"} = $dstmbx; + } + %$mbx_map = %temp; + %temp = (); + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub get_date { + +my $days = shift; +my $time = time(); +my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); + + # Generate a date in DD-MMM-YYYY format. The 'days' parameter + # indicates how many days to go back from the present date. + + my ($sec,$min,$hr,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime( $time - $days*86400 ); + + $mday = '0' . $mday if length( $mday ) == 1; + my $month = $months[$mon]; + my $date = $mday . '-' . $month . '-' . ($year+1900); + + return $date; +} + +sub fixup_date { + +my $date = shift; + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. Do the same for the day of month + # part of the date (Zimbra doesn't like it). + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + my $hrs = $2; + my ($dom) = split(/-/, $1); + if ( length( $dom ) == 1 ) { + $$date = '0' . $$date; + } + + return if length( $hrs ) == 2; + + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + +} + +sub get_mbx_prefix { + +my $delim = shift; +my $conn = shift; +my %prefixes; +my @prefixes; + + # Not implemented yet. + # Try to figure out whether the server has a mailbox prefix + # and if so what it is. + + $$delim = "\\." if $$delim eq '.'; + + my @mbxs = getMailboxList( $conn ); + + my $num_mbxs = $#mbxs + 1; + foreach $mbx ( @mbxs ) { + next if uc( $mbx ) eq 'INBOX'; + ($prefix,$rest) = split(/$$delim/, $mbx); + $prefixes{"$prefix"}++; + } + + my $num_prefixes = keys %prefixes; + if ( $num_prefixes == 1 ) { + while(($$prefix,$count) = each(%prefixes)) { + push( @prefixes, "$$prefix|$count"); + } + ($$prefix,$count) = split(/\|/, pop @prefixes); + $num_mbxs--; # Because we skipped the INBOX + if ( $num_mbxs != $count ) { + # Did not find a prefix + $$prefix = ''; + } + + } + + $$delim =~ s/\\//; + $$prefix .= $$delim if $$prefix; + + Log("Determined prefix to be $$prefix") if $debug; + + return $$prefix; + +} + +sub get_mbx_delimiter { + +my $conn = shift; +my $delimiter; + + # Not implemented yet. + # Determine the mailbox hierarchy delimiter + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ($conn, "1 LIST \"\" INBOX"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /INBOX/i ) { + my @terms = split(/\s+/, $response ); + $delimiter = $terms[3]; + $delimiter =~ s/"//g; + } + last if $response =~ /^1 OK|^1 BAD|^1 NO/; + last if $response !~ /^\*/; + } + + Log("Determined delimiter to be $delimiter") if $debug; + return $delimiter; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + my ($user,$admin,$pwd) = split(/:/, $user, 3); + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + # sendCommand ($conn, "1 AUTHENTICATE PLAIN {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + unless ( $exchange_override ) { + $exchange = 1; + Log("The destination is an Exchange server"); + } + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +sub wrap_long_line { + +my $line = shift; + + # Wrap lines too long to be accepted by an IMAP server (Office365 doesn't + # seem to like very long lines). We'll wrap at 1000 characters since + # that seems to be acceptable to Office365. + + my $len1 = length( $line ); + my @output = (); + @output = ( $line =~ m/.{1000}/g ); + my $new; + $new .= "$_\r\n" foreach (@output ); + + # Pick up the trailing chars + + my $temp = $new; + $temp =~ s/\r|\n//g; + my $len2 = length( $temp ); + $new .= substr( $line, $len2, $len1-$len2); + $new .= "\r\n"; + + return $new; +} + +sub validate_flags { + +my $flags = shift; +my $newflags; +my %standard_flags = ( + '\\Seen', 1, '\\Deleted', 1, '\\Draft', 1, + '\\Answered', 1, '\\Flagged', 1, '\\Recent', 1, + '\\SEEN', 1, '\\DELETED', 1, '\\DRAFT', 1, + '\\ANSWERED', 1, '\\FLAGGED', 1, '\\RECENT', 1 ); + + # Remove any flags not supported by the destination mailbox + + foreach my $flag ( split(/\s+/, $flags ) ) { + $flag = uc( $flag ); + next unless $standard_flags{$flag}; + $newflags .= "$flag "; + } + chop $newflags; + + return $newflags; + +} + +sub summarize { + + my $summary; + foreach $_ ( @summary ) { + ($user,$results) = split(/:/, $_, 2); + $USERS{"$user"}++ if $user; + $summary .= "$user\n" if $user ne $previous; + $previous = $user; + $summary .= " $results\n"; + } + + $users = keys %USERS; + $header = "$users users synchronized\n----------------------------------------------------\n"; + $summary = $header . $summary; + + Log("\nSynchronization summary:\n$summary"); +} + +sub move_msg { + +my $uid = shift; +my $mbx = shift; +my $conn = shift; + + # Move a message from the current mailbox to another one. + + # Use the new dst connection if we had to disconnect/reconnect because of Exchange + # 10-error limit. + $conn = $NEW{$conn} if $NEW{$conn}; + + sendCommand ($conn, "1 UID MOVE $uid $mbx" ); + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected MOVE response: $response"); + exit; + } + $last if $loops++ > 99; + } + +} + +sub get_wrapped_msgid { + +my $response = shift; +my $i = shift; +my $msgid; + + # The Message-ID is not on the same line as the Message-ID: keyword + # Get it from the next line or lines (if it continues onto succeeding lines) + + $$response[$i+1] =~ s/^\s+//; + $msgid = $$response[$i+1]; + $msgid =~ s/\s+$//g; + + my $j = 1; + while ( 1 ) { + if ( $msgid =~ /\>$/ ) { + # We've got all of it + last; + } + $j++; + # The msgid continues onto the next line + $$response[$i+$j] =~ s/^\s+//; + $msgid .= $$response[$i+$j]; + if ( $msgid =~ /Message-ID:/i ) { + ($start,$msgid) = split(/Message-ID:/, $msgid ); + } + + last if $j > 99; + } + + return $msgid; + +} + +sub exchange_workaround { + + # Because Exchange terminates an IMAP connection after 10 errors have occurred + # we have to start a new session before we can continue + + Log("The maximum number of errors ($errors) permitted by Exchange have occurred, disconnecting from Exchange server."); + $errors = 0; + + $old_dst = $dst; + logout( $dst ); + connectToHost( $destHost, \$dst ); + + # Log back into Exchange + + if ( $destUser =~ /(.+):(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + Log("PLAIN login") if $debug; + return 0 unless login_plain( $destUser, $dst ); + } else { + # Otherwise do an ordinary login + unless ( login( $destUser,$destPwd, $dst ) ) { + logout( $src ); + return 0; + } + } + selectMbx( $dstmbx, $dst, 'SELECT' ); + + # Map the old dst connection to the new one + $NEW{$old_dst} = $dst; + +} + diff --git a/S/imap_tools.V1.333/license.txt b/S/imap_tools.V1.333/license.txt new file mode 100644 index 0000000..f316d85 --- /dev/null +++ b/S/imap_tools.V1.333/license.txt @@ -0,0 +1,21 @@ + +############################################################################ +# Copyright (c) 2012 Rick Sanders # +# # +# Permission to use, copy, and modify this software for any purpose # +# is hereby granted, provided that the above copyright notice and this # +# permission notice appear in all copies. # +# # +# This software is not assignable and may not be resold without the # +# express written permission of the author. The sofware can be hosted # +# on any or all of the license holder's servers and sites. # +# # +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # +############################################################################ + diff --git a/S/imap_tools.V1.333/list_account_sizes.pl b/S/imap_tools.V1.333/list_account_sizes.pl new file mode 100755 index 0000000..ff7a4a0 --- /dev/null +++ b/S/imap_tools.V1.333/list_account_sizes.pl @@ -0,0 +1,1183 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/list_account_sizes.pl,v 1.12 2014/11/19 21:51:25 rick Exp $ + +################################################################################## +# list_account_sizes.pl is called like this: # +# ./list_account_sizes.pl -S -u [-A admin:password] # +# # +# If you supply the name and password for an administrator who can log into a # +# user's account then the user list is just account names; otherwise you must # +# supply the users's passwords in the list: # +# john:mypass # +# mary:herpassword # +# etc # +# # +# The output is written to list_account_sizes.report. For example: # +# # +# SIZE (MB) USER # +# ================================================== # +# 1,583.27 jessi # +# 1,429.61 tom # +# 1,260.20 john # +# 691.07 jane # +# 45.18 bob # +# # +# Totals # +# ================= # +# Users 5 # +# Bytes 5,009.33 MB # +################################################################################## + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use MIME::Base64 qw(decode_base64 encode_base64); + +init(); + +@users = get_user_list(); +foreach $sourceUser ( @users ) { + $sourceUser =~ s/oauth2:/oauth2---/g; + ($user) = split(/:/, $sourceUser); + $users++; + $total_size=$total_msgcount=0; + ($sourceHost) = split(/\//, $sourceHost); + connectToHost($sourceHost, \$src) or exit; + + if ( $administrator ) { + $sourceUser = "$sourceUser:$administrator"; + login_plain( $sourceUser, $src ) or next; + } else { + ($sourceUser,$sourcePwd) = split(/:/,$sourceUser); + login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) or next; + } + + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + + if ( !$quota_extension ) { + # See if the server support the QUOTA extension + $quota_extension = capability( $src ); + if ( $quota_extension eq 'not enabled' ) { + print "The server does not support the QUOTA extension\n\n"; + print "The size of each user's account will have to be determined the\n"; + print "hard way (by examining each message individually). That will take\n"; + print "a LOT longer.\n\n"; + print "Do you want to continue? [Y or N] "; + chomp( $ans = <> ); + $ans = uc( $ans ); + if ( substr($ans, 0 , 1 ) ne 'Y' ) { + exit; + } + } + } + + if ( !$dont_use_quota ) { + $quota = get_quota( $src ); + } + + if ( $quota ) { + push( @results, "$quota|$sourceUser|$total_msgcount" ); + } else { + @mbxs = getMailboxList( $srcPrefix, $src ); + @mbxs = sort @mbxs; + + ($user) = split(/:/, $sourceUser); + foreach $mbx ( @mbxs ) { + ($msgcount,$size) = count_msgs( $mbx, $src ); + $total_msgcount += $msgcount; + $total_size += $size; + $mbx =~ s/^$srcPrefix//; + $mbx =~ s/[$srcDelim]/\//g; + } + + ($sourceUser) = split(/:/, $sourceUser); + push( @results, "$total_size|$sourceUser|$total_msgcount" ); + } + + logout( $src ); +} + +if ( $brief ) { + $line = pop( @results ); + ($size) = split(/\|/, $line); + print STDERR "$size MB\n"; + exit; +} + +open(OUT, ">list_account_sizes.report"); + +$line = pack("A18 A10", ' SIZE (MB)', 'USER'); +print "$line\n"; +print "==================================================\n"; +print OUT "$line\n"; +print OUT "==================================================\n"; +@results = reverse sort {$a<=>$b} @results; +foreach $_ ( @results ) { + ($size,$user,$msgcount) = split(/\|/, $_ ); + $grand_total_bytes+= $size; + $grand_total_msgs += $msgcount; + ($user) = split(/:/, $user); + $count = $msgcount; + commafy( \$count ); + + commafy( \$size ); + + $size = sprintf("%10s", $size); + + $line = pack("A18", "$size"); + $line .= $user; + print STDOUT "$line\n"; + print OUT "$line\n"; +} + +commafy( \$grand_total_msgs ); +commafy( \$grand_total_bytes ); + +print "\n\n"; +print "Totals\n"; +print "=================\n"; +print "Users $users\n"; +print "Bytes $grand_total_bytes MB\n"; +print OUT "Totals\n"; +print OUT "=================\n"; +print OUT "Users $users\n"; +print OUT "Bytes $grand_total_bytes MB\n"; +close OUT; + +print STDOUT "\nThe report was written to list_account_sizes.report\n"; + +exit; + + +sub init { + + $os = $ENV{'OS'}; + + processArgs(); + + if ($timeout eq '') { $timeout = 60; } + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + exit; + } + select(LOG); $| = 1; + } + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + $utf = 1; + eval 'use Unicode::IMAPUtf7'; + if ( $@ ) { + $utf = 0; + } + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + Log( $cmd ) if $showIMAP; + +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log( $response ) if $showIMAP; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + my ($user,$admin,$pwd) = split(/:/, $user, 3); + if ( $debug ) { + Log("Doing an AUTHENTICATE = PLAIN"); + Log( "user $user"); + Log( "admin $admin"); + Log( "pwd $pwd"); + } + + my $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + my $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $host = shift; +my $conn = shift; +my $method = shift; + + if ( uc( $method ) eq 'CRAM-MD5' ) { + # A CRAM-MD5 login is requested + my $rc = login_cram_md5( $user, $pwd, $conn ); + return $rc; + } + + if ( $pwd =~ /^oauth2---(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + # Otherwise do a ordinary login + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + print STDERR "$response\n"; + return 0; + } + } + + return 1; +} + + +sub login_cram_md5 { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + + $response = cram_md5( $challenge, $user, $pwd ); + + sendCommand ($conn, $response); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + return 0; + } + } + + return 1; +} + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $prefix = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes",2) if $debugMode; + + if ( $mbxList ) { + foreach $mbx ( split(/,/, $mbxList) ) { + $mbx = $prefix . $mbx if $prefix; + if ( $opt_R ) { + # Get all submailboxes under the ones specified + $mbx .= '*'; + @mailboxes = listMailboxes( $mbx, $conn); + push( @mbxs, @mailboxes ); + } else { + push( @mbxs, $mbx ); + } + } + } else { + # Get all mailboxes + @mbxs = listMailboxes( '*', $conn); + } + + return @mbxs; +} + +# listMailboxes +# +# Get a list of the user's mailboxes +# +sub listMailboxes { + +my $mbx = shift; +my $conn = shift; + + sendCommand ($conn, "1 LIST \"\" \"$mbx\""); + undef @response; + while ( 1 ) { + &readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + &Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +sub processArgs { + + if ( !getopts( "dS:L:O:u:hHsU:T:A:IBN" ) ) { + usage(); + } + $sourceHost = $opt_S; + $showIMAP = 1 if $opt_I; + $timeout = 45 unless $timeout; + $output_file = $opt_O; + $user_list = $opt_u; + $administrator = $opt_A; + $brief = 1 if $opt_B; + $dont_use_quota = 1 if $opt_N; + + if ( $opt_h or $opt_H ) { + usage(); + } + + ($host,$user,$pwd) = split(/\//, $opt_S, 3); + if ( $user and $pwd ) { + # User wants info about a single user + } elsif( !-e $user_list or !$sourceHost ) { + usage(); + } + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; +my $substChar = '_'; + + if ( $public_mbxs ) { + my ($public_src,$public_dst) = split(/:/, $public_mbxs ); + # If the mailbox starts with the public mailbox prefix then + # map it to the public mailbox destination prefix + + if ( $srcmbx =~ /^$public_src/ ) { + Log("src: $srcmbx is a public mailbox") if $debug; + $dstmbx = $srcmbx; + $dstmbx =~ s/$public_src/$public_dst/; + Log("dst: $dstmbx") if $debug; + return $dstmbx; + } + } + + # Change the mailbox name if the user has supplied mapping rules. + + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + $srcmbx =~ s/^$srcPrefix//; + $srcmbx =~ s/\\$srcDelim/\//g; + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + # $dstmbx = $srcmbx; + if ( lc( $srcmbx ) eq 'inbox' ) { + $dstmbx = $srcmbx; + } else { + $dstmbx = $srcPrefix . $srcmbx; + } + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + +# Reconnect to the servers after a timeout error. +# +sub reconnect { + +my $checkpoint = shift; +my $conn = shift; + + Log("Attempting to reconnect"); + + my ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint); + + close $src; + close $dst; + + connectToHost($shost,\$src); + login($suser,$spwd,$shost,$src); + + connectToHost($dhost,\$dst); + login($duser,$dpwd,$dhost,$dst); + + selectMbx( $mbx, $src ); + createMbx( $mbx, $dst ); # Just in case + +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } + Log("Resuming"); +} + +sub fixup_date { + +my $date = shift; + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + my $hrs = $2; + + return if length( $hrs ) == 2; + + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + +} + +sub count_msgs { + +my $mbx = shift; +my $conn = shift; +my @msgs; + + # Get the msg count and size + + getMsgList( $mbx, \@msgs, $conn, 'SELECT' ); + my $msgcount = $#msgs + 1; + + my $total = 0; + foreach my $size ( @msgs ) { + $total += $size; + } + $total = sprintf("%.2f", $total/1000000); + $total .= ' MB'; + my $count = scalar @msgs; + + return ($count,$total); + +} + +sub cram_md5 { + +my $challenge = shift; +my $user = shift; +my $password = shift; + +eval 'use Digest::HMAC_MD5 qw(hmac_md5_hex)'; +use MIME::Base64 qw(decode_base64 encode_base64); + + # Adapated from script by Paul Makepeace , 2002-10-12 + # Takes user, key, and base-64 encoded challenge and returns base-64 + # encoded CRAM. See, + # IMAP/POP AUTHorize Extension for Simple Challenge/Response: + # RFC 2195 http://www.faqs.org/rfcs/rfc2195.html + # SMTP Service Extension for Authentication: + # RFC 2554 http://www.faqs.org/rfcs/rfc2554.html + # Args: tim tanstaaftanstaaf PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+ + # should yield: dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw + + my $challenge_data = decode_base64($challenge); + my $hmac_digest = hmac_md5_hex($challenge_data, $password); + my $response = encode_base64("$user $hmac_digest"); + chomp $response; + + if ( $debug ) { + Log("Challenge: $challenge_data"); + Log("HMAC digest: $hmac_digest"); + Log("CRAM Base64: $response"); + } + + return $response; +} + +sub validate_date { + +my $date = shift; +my $invalid; + + # Make sure the "after" date is in DD-MMM-YYYY format + + my ($day,$month,$year) = split(/-/, $date); + $invalid = 1 unless ( $day > 0 and $day < 32 ); + $invalid = 1 unless $month =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i; + $invalid = 1 unless $year > 1900 and $year < 2999; + if ( $invalid ) { + Log("The 'Sent after' date $date must be in DD-MMM-YYYY format"); + exit; + } +} + +sub commafy { + +my $number = shift; + + $_ = $$number; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + + $$number = $_; + +} + +sub usage { + + print STDERR "Usage: $0 -S // [-O ]\n"; + print STDERR " [-u \n"; + print STDERR " [-A \n"; + print STDERR " [-I] log IMAP commands and responses\n"; + print STDERR " [-t ] time out a session (default is 45 seconds)\n"; + print STDERR " [-B brief summary]\n"; + print STDERR " [-N] don't use QUOTA command\n"; + exit; + +} + +sub Log { + +my $str = shift; + + print STDERR "$str\n"; + +} + +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $mode = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $msgid; + + @$msgs = (); + $mode = 'EXAMINE' unless $mode; + sendCommand ($conn, "1 $mode \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + return (0, 0) if $empty; + + my $start = 1; + my $end = '*'; + $start = $start_fetch if $start_fetch; + $end = $end_fetch if $end_fetch; + + sendCommand ( $conn, "1 FETCH $start:$end (RFC822.SIZE)"); + + @response = (); + while ( 1 ) { + readResponse ( $conn ); + + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response"); + exit; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $response = $response[$i]; + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response[$i]"); + Log("msgnum $msgnum"); + exit; + } + + if ( $response[$i] =~ /INTERNALDATE (.+) RFC822\.SIZE/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /\(RFC822\.SIZE (.+)\)/i) { + $size = $1; + + if ( $report_large_msgs == 1 ) { + push( @large_msgs, "$size $mailbox") if $size > $large_msg_threshold; + } + } + + if ( $size ) { + push (@$msgs,$size); + $size = ''; + } + } + + return 1; + +} + +sub get_user_list { + +my @users; + + ($host,$user,$pwd) = split(/\//, $opt_S, 3); + if ( $user and $pwd ) { + # User wants info about a single account + push( @users, "$user:$pwd" ); + return @users; + } + + # Read the list of users + + if ( !open(F, "<$user_list") ) { + print STDERR "Fatal error opening user_list $user_list: $!\n"; + exit; + } + while( ) { + chomp; + s/^\s+//g; + next if /^#/; # Skip comments + push( @users, $_ ); + } + close F; + + return @users; + +} + +sub capability { + +my $conn = shift; +my @response; +my $capability; +my $quota_ext = 'not enabled'; + + sendCommand ($conn, "1 CAPABILITY"); + while (1) { + readResponse ( $conn ); + $capability = $response if $response =~ /\* CAPABILITY/i; + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD/i) { + print "Unexpected response: $response\n"; + return 0; + } + } + + $quota_ext = 'enabled' if $capability =~ / QUOTA\s*/i; +print STDERR "$capability\n"; + + return $quota_ext; +print STDERR "quota $quota\n"; + +} + +sub get_quota { + +my $conn = shift; + + # sendCommand ($conn, "1 getQuotaroot index"); + sendCommand ($conn, "1 getquotaroot \"Inbox\""); + while (1) { + readResponse ( $conn ); + if ( $response =~ /\(STORAGE (.+) (.+)\)/i ) { + $quota = $1; + } + if ( $response =~ /^1 OK no quota|OK GETQUOTAROOT Ok/i ) { + # QUOTA is supported but quotas are not set + $quota = ''; + } + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD/i) { + print "Unexpected response: $response\n"; + return 0; + } + } + + # Normalize to MB + if ( $quota ) { + $quota = sprintf( "%.2f", $quota/1000 ); + } + + return $quota; +} diff --git a/S/imap_tools.V1.333/list_imap_folders.pl b/S/imap_tools.V1.333/list_imap_folders.pl new file mode 100755 index 0000000..3ca72d9 --- /dev/null +++ b/S/imap_tools.V1.333/list_imap_folders.pl @@ -0,0 +1,1150 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/list_imap_folders.pl,v 1.25 2015/02/16 23:02:51 rick Exp $ + +####################################################################### +# list_imap_folders.pl is called like this: # +# ./list_folders.pl -S host/user/password [-O ] # +# # +# If you have mailboxes with non-ASCII characters then to render # +# them from the IMAP UTF-7 encoding you must install the Perl Module # +# Encode::IMAPUTF7. It's available from the CPAN web site. # +####################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use Encode qw/encode decode/; +use MIME::Base64 qw(encode_base64 decode_base64); + +################################################################# +################################################################# + +init(); + +get_user_list( $user_list, \@users ); + +if ( $output_file ) { + open(OUT, ">$output_file") or die "Can't open output file $output_file: $!"; +} + +if ( $report_large_msgs ) { + Log("Large messages will be written to large_msg_report.list"); + if ( !open(L, ">large_msg_report.list") ) { + Log("Error creating ./large_msg_report.list: $!"); + exit; + } + Log("Created ./large_msg_report.list") if $debug; + print L "Large message report \n"; +} + +$total_size=$total_msgs=0; +@large_msgs = (); +foreach $sourceUser ( @users ) { + ($User) = split(/:/, $sourceUser); + print STDOUT "======================================\n"; + print STDOUT "$User\n"; + print OUT "======================================\n"; + print OUT "$User\n"; + print L "======================================\n"; + print L "$User\n"; + + connectToHost($sourceHost, \$src) or next; + if ( !login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) ) { + print OUT "Login failed for $sourceUser\n"; + print STDOUT "Login failed for $sourceUser\n"; + next; + } + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + @mbxs = getMailboxList( $srcPrefix, $src ); + + @mbxs = sort @mbxs; + + $prefix = 'NONE' if !$srcPrefix; + print OUT "Mailbox delimiter = $srcDelim\n"; + print OUT "Mailbox prefix = $prefix\n"; + print STDOUT "Mailbox delimiter = $srcDelim\n"; + print STDOUT "Mailbox prefix = $prefix\n\n"; + + foreach $mbx ( @mbxs ) { + if ( $src_uwash_imap ) { + $mailbox = 'Mail/' . $mbx unless uc( $mbx ) eq 'INBOX'; + ($msgcount,$size) = count_msgs( $mailbox, $src ) if $stats; + } else { + ($msgcount,$size) = count_msgs( $mbx, $src ) if $stats; + } + $total_size += $size; + $total_msgs += $msgcount; + $mbx =~ s/^$srcPrefix//; + $mbx =~ s/[$srcDelim]/\//g; + if ( $utf ) { + $mbx = decode( 'IMAP-UTF-7', $mbx ); + } + if ( $output_file ) { + if ( $stats ) { + print OUT "$mbx ($msgcount msgs, $size)\n"; + } else { + print OUT "$mbx\n"; + } + } else { + if ( $stats ) { + print STDOUT "$mbx ($msgcount msgs, $size)\n"; + } else { + print STDOUT "$mbx\n"; + } + } + } + + if ( $stats ) { + $total_size = sprintf("%.2f", $total_size/1000 ); + print STDOUT "\nTotal bytes $total_size GB\n"; + print STDOUT "Total msgs $total_msgs\n"; + print OUT "\nTotal bytes $total_size GB\n"; + print OUT "Total msgs $total_msgs\n"; + close OUT; + print STDOUT "Wrote list of mailboxes to $output_file\n" if $output_file; + } + + print STDOUT "======================================\n"; + print OUT "======================================\n"; + logout( $src ); + + if ( $debug ) { + Log("Writing the list of large messages to large_msg_report.list") if $debug; + $n = scalar @large_msgs; + Log("There are $n lines in the list of large messages"); + } + + if ( @large_msgs ) { + @large_msgs = reverse sort { $a <=> $b } @large_msgs; + foreach $_ ( @large_msgs ) { + ($size,$mbx,$subject) = split(/\s+/, $_, 3); + if ( $utf ) { + $mbx = decode( 'IMAP-UTF-7', $mbx ); + } + $size = sprintf("%.1f", $size/1000000) . ' MB'; + Log("Writing $mbx ($size) $subject to large_msg_report.list") if $debug; + print L "$mbx ($size) $subject\n"; + } + Log("\nLarge message report has been written to large_msg_report.list"); + } + +} + +close OUT; +close L; +exit; + + +sub init { + + $os = $ENV{'OS'}; + + processArgs(); + + if ($timeout eq '') { $timeout = 60; } + + # Open the logFile + # + $logfile = "list_imap_folders.log"; + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + exit; + } + select(LOG); $| = 1; + } + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + + use MIME::Base64 qw(encode_base64); + $utf = 1; + eval 'use Encode::IMAPUTF7 qw/decode/'; + if ( $@ ) { + $utf = 0; + } + no warnings 'utf8'; + +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + Log( $cmd ) if $showIMAP; + +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log( $response ) if $showIMAP; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $host = shift; +my $conn = shift; +my $method = shift; + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + if ( $user =~ /:/ ) { + ($user,$pwd) = split(/:/, $user); + $rc = login_plain( $user, $user, $pwd, $conn ); + return $rc; + } + + if ( $admin_user ) { + ($admin,$pwd) = split(/:/, $admin_user); + $rc = login_plain( $user, $admin, $pwd, $conn ) or exit; + return $rc; + } + + if ( uc( $method ) eq 'CRAM-MD5' ) { + # A CRAM-MD5 login is requested + my $rc = login_cram_md5( $user, $pwd, $conn ); + return $rc; + } + + # Otherwise do a ordinary login + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + return 0; + } + } + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +sub login_cram_md5 { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + + $response = cram_md5( $challenge, $user, $pwd ); + + sendCommand ($conn, $response); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + return 0; + } + } + + return 1; +} + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $prefix = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes",2) if $debugMode; + + if ( $mbxList ) { + foreach $mbx ( split(/,/, $mbxList) ) { + $mbx = $prefix . $mbx if $prefix; + if ( $opt_R ) { + # Get all submailboxes under the ones specified + $mbx .= '*'; + @mailboxes = listMailboxes( $mbx, $conn); + push( @mbxs, @mailboxes ); + } else { + push( @mbxs, $mbx ); + } + } + } else { + # Get all mailboxes + @mbxs = listMailboxes( '*', $conn); + } + + if ( $src_uwash_imap ) { + my @temp; + foreach $_ ( @mbxs ) { + next if /^\./; # Skip if starting with a dot + s/^Mail\///; + push( @temp, $_); + } + @mbxs = @temp; + @temp = (); + } + + return @mbxs; +} + +# listMailboxes +# +# Get a list of the user's mailboxes +# +sub listMailboxes { + +my $prefix = shift; +my $conn = shift; + + sendCommand ($conn, "1 LIST \"\" \"$prefix\""); + undef @response; + while ( 1 ) { + &readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + &Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + next; + } + + next if $mbx =~ /\[Gmail\]\/All Mail/; + + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +sub processArgs { + + if ( !getopts( "dS:L:O:uhHsU:IA:l:d" ) ) { + usage(); + exit; + } + if ( $opt_S =~ /\\/ ) { + ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\\/, $opt_S); + } else { + ($sourceHost, $sourceUser, $sourcePwd,$srcMethod) = split(/\//, $opt_S); + } + $showIMAP = 1 if $opt_I; + $utf = 1 if $opt_u; + $timeout = 45 unless $timeout; + $output_file = $opt_O; + $large_msg_threshold = $opt_U; + $stats = 1 if $opt_s; + $admin_user = $opt_A; + $user_list = $opt_l; + $debug = 1 if $opt_d; + + $report_large_msgs = 1 if $large_msg_threshold > 0; + + if ( $opt_h or $opt_H ) { + usage(); + exit; + } + + unless( $sourceHost ) { + usage(); + exit; + } + if ( !$sourceUser and !$user_list ) { + usage(); + exit; + } +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + # $src_uwash_imap = 1 if ?\("\#mh/"?; + $src_uwash_imap = 1 if /"\#mh\/"/; + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } + +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; +my $substChar = '_'; + + if ( $public_mbxs ) { + my ($public_src,$public_dst) = split(/:/, $public_mbxs ); + # If the mailbox starts with the public mailbox prefix then + # map it to the public mailbox destination prefix + + if ( $srcmbx =~ /^$public_src/ ) { + Log("src: $srcmbx is a public mailbox") if $debug; + $dstmbx = $srcmbx; + $dstmbx =~ s/$public_src/$public_dst/; + Log("dst: $dstmbx") if $debug; + return $dstmbx; + } + } + + # Change the mailbox name if the user has supplied mapping rules. + + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + $srcmbx =~ s/^$srcPrefix//; + $srcmbx =~ s/\\$srcDelim/\//g; + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + # $dstmbx = $srcmbx; + if ( lc( $srcmbx ) eq 'inbox' ) { + $dstmbx = $srcmbx; + } else { + $dstmbx = $srcPrefix . $srcmbx; + } + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + +# Reconnect to the servers after a timeout error. +# +sub reconnect { + +my $checkpoint = shift; +my $conn = shift; + + Log("Attempting to reconnect"); + + my ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint); + + close $src; + close $dst; + + connectToHost($shost,\$src); + login($suser,$spwd,$shost,$src); + + connectToHost($dhost,\$dst); + login($duser,$dpwd,$dhost,$dst); + + selectMbx( $mbx, $src ); + createMbx( $mbx, $dst ); # Just in case + +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } + Log("Resuming"); +} + +sub fixup_date { + +my $date = shift; + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + my $hrs = $2; + + return if length( $hrs ) == 2; + + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + +} + +sub count_msgs { + +my $mbx = shift; +my $conn = shift; +my @msgs; + + # Get the msg count and size + + getMsgList( $mbx, \@msgs, $conn, 'SELECT' ); + my $msgcount = $#msgs + 1; + + my $total = 0; + foreach my $size ( @msgs ) { + $total += $size; + } + $total = sprintf("%.2f", $total/1000000); + $total .= ' MB'; + my $count = scalar @msgs; + + return ($count,$total); + +} + +sub cram_md5 { + +my $challenge = shift; +my $user = shift; +my $password = shift; + +eval 'use Digest::HMAC_MD5 qw(hmac_md5_hex)'; +use MIME::Base64 qw(decode_base64 encode_base64); + + # Adapated from script by Paul Makepeace , 2002-10-12 + # Takes user, key, and base-64 encoded challenge and returns base-64 + # encoded CRAM. See, + # IMAP/POP AUTHorize Extension for Simple Challenge/Response: + # RFC 2195 http://www.faqs.org/rfcs/rfc2195.html + # SMTP Service Extension for Authentication: + # RFC 2554 http://www.faqs.org/rfcs/rfc2554.html + # Args: tim tanstaaftanstaaf PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+ + # should yield: dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw + + my $challenge_data = decode_base64($challenge); + my $hmac_digest = hmac_md5_hex($challenge_data, $password); + my $response = encode_base64("$user $hmac_digest"); + chomp $response; + + if ( $debug ) { + Log("Challenge: $challenge_data"); + Log("HMAC digest: $hmac_digest"); + Log("CRAM Base64: $response"); + } + + return $response; +} + +sub validate_date { + +my $date = shift; +my $invalid; + + # Make sure the "after" date is in DD-MMM-YYYY format + + my ($day,$month,$year) = split(/-/, $date); + $invalid = 1 unless ( $day > 0 and $day < 32 ); + $invalid = 1 unless $month =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i; + $invalid = 1 unless $year > 1900 and $year < 2999; + if ( $invalid ) { + Log("The 'Sent after' date $date must be in DD-MMM-YYYY format"); + exit; + } +} + +sub commafy { + +my $number = shift; + + $_ = $$number; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + + $$number = $_; + +} + +sub usage { + + print STDERR "Usage: list_imap_folders.pl -S // [-O ]\n"; + print STDERR " [-A ]\n"; + print STDERR " [-s] Include count of messages and bytes for each mailbox\n"; + print STDERR " [-U ] Write large_msg_report.list with each msg exceeding threshold\n"; + +} + +sub Log { + +my $str = shift; + + print STDERR "$str\n"; + print LOG "$str\n"; + +} + +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $mode = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $msgid; + + Log("large_msg_threshold $large_msg_threshold") if $debug; + @$msgs = (); + $mode = 'EXAMINE' unless $mode; + sendCommand ($conn, "1 $mode \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + return (0, 0) if $empty; + + my $start = 1; + my $end = '*'; + $start = $start_fetch if $start_fetch; + $end = $end_fetch if $end_fetch; + + sendCommand ( $conn, "1 FETCH $start:$end (RFC822.SIZE body.peek[header.fields (Subject)])"); + + @response = (); + while ( 1 ) { + readResponse ( $conn ); + + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response"); + exit; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $response = $response[$i]; + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ( $response =~ /^\* BYE/ ) { + Log("The server terminated our connection: $response[$i]"); + Log("msgnum $msgnum"); + exit; + } + + if ( $response[$i] =~ /Subject:\s*(.+)/i ) { + $subject = $1; + } + + if ( $response[$i] =~ /INTERNALDATE (.+) RFC822\.SIZE/i ) { + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /\(RFC822\.SIZE (.+)\)/i) { + ($size) = split(/\s+/, $1); + Log("msg size $size") if $debug; + if ( $report_large_msgs == 1 and $size > $large_msg_threshold) { + Log("Added msg size $size to large_msg_report") if $debug; + push( @large_msgs, "$size $mailbox $subject"); + $subject = ''; + } + } + + if ( $size ) { + push (@$msgs,$size); + $size = ''; + } + } + + return 1; + +} + +sub get_user_list { + +my $file = shift; +my $list = shift; + + # Build a list of the users to be checked + + if ( $sourceUser ) { + push( @$list, $sourceUser ); + return; + } + + if ( !open(F, "<$file") ) { + print STDERR "Error opening $file: $!\n"; + exit; + } + while( ) { + chomp; + s/^\s#//; + next if /^#/; + push( @$list, $_ ) if $_; + } + close F; + +} + diff --git a/S/imap_tools.V1.333/load_msgs.pl b/S/imap_tools.V1.333/load_msgs.pl new file mode 100644 index 0000000..7d489e3 --- /dev/null +++ b/S/imap_tools.V1.333/load_msgs.pl @@ -0,0 +1,1221 @@ +#!/usr/bin/perl + +# $Header$ + +####################################################################### +# +####################################################################### + +use Socket; +use IO::Socket; +use FileHandle; +use File::Find; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw(decode_base64 encode_base64); + +init(); +@dirs = split(/,/, $dir); +my @msg_list; + +foreach $dir ( @dirs ) { + $copied=0; + Log("Looking for $extension messages in $dir"); + get_messages( $dir, \@msgs ); + $n = scalar @msgs; +} +Log("There are $n msgs"); +Log("Reading msg headers"); +foreach $msgfn ( @msgs ) { + $read++; + Log("Read $read headers") if $read/1000 == int($read/1000); + next unless $msgfn; + next unless -e $msgfn; + Log("Reading $msgfn") if $debug; + + ($from,$to,$cc,$date,$msgid) = read_header( $msgfn ); + update_msglist( $from, $to, $cc, $msgfn, $date, $msgid, \@msglist ); +} + +$n = scalar @msglist; +Log("There are $n messages to load"); + +@msglist = sort @msglist; +foreach $_ ( @msglist ) { + ($user,$date,$folder,$msgid,$msgfn) = split(/\|/, $_); + + if ( $msgfn eq '' ) { + Log("null msgfn"); + exit; + } + + if ( $last_user ne $user ) { + logout( $conn ) if $conn; + $sent_created = $inbox_created = 0; + connectToHost($imapHost, \$conn); + login_plain( $user, $admin_user, $admin_pwd, $conn ) or next; + create_mailbox( $sent_mbx, $conn ) unless $sent_created; + create_mailbox( $inbox_mbx, $conn ) unless $inbox_created; + $sent_created = $inbox_created = 1; + Log("Loading msgs for $user"); + $last_user = $user; + + if ( $update ) { + # Get list of messages in the user's inbox and sent folders so we + # won't copy msgs that already exist + %MSGIDS = (); + getMsgIdList( $inbox_mbx, \%MSGIDS, $conn ); + getMsgIdList( $sent_mbx, \%MSGIDS, $conn ); + } + } + + if ( !$namespace ) { + if ( $opt_y ) { + # User-supplied mbx delimiter and prefix + ($mbx_delim,$prefix) = split(/\s+/, $opt_y ); + } else { + namespace( $conn, \$prefix, \$mbx_delim ); + } + $namespace = 1; + } + + $msgid = read_msg( $msgfn, \$msg ); + + if ( $update ) { + next if $MSGIDS{"$folder $msgid"}; + } + + Log("Need to add $msgid") if $debug; + + $USERS{"$user"}++; + $copied++ if insertMsg($folder, \$msg, $flags, $date, $conn); + Log("Copied $copied total msgs") if $copied/100 == int($copied/100); + +} + +Log("Done. $copied messages were copied."); +Log("Summary of per-user copied messages"); +foreach $user ( sort keys %USERS ) { + $copied = $USERS{"$user"}; + commafy( \$copied ); + $copied = pack("A10", $copied); + Log("$copied $user"); +} +exit; + + +sub init { + + if ( !getopts('m:L:i:dD:Ix:XRA:l:y:t:S:M:u:U') ) { + usage(); + } + + $dir = $opt_D; + $logfile = $opt_L; + $extension = $opt_x; + $admin_user = $opt_A; + $msg_limit = $opt_l; + $imapHost = $opt_i; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $update = 1 if $opt_U; + $sent_mbx = $opt_S; + $inbox_mbx = $opt_M; + $our_domains = $opt_m; + $users = $opt_u; + + $sent_mbx = 'Sent' unless $sent_mbx; + $inbox_mbx = 'INBOX' unless $inbox_mbx; + $logfile = 'load_msgs.log' unless $logfile; + $msg_limit = 999999999 unless $msg_limit; + $extension = 'EML' unless $extension; + + foreach $user ( split(/\s*,\s*/, $users ) ) { + # Only certain user msgs are to be loaded + $user =~ s/^\s+|\s+$//g; + chomp $user; + $user = lc( $user ); + $USER{"$user"} = 1; + $filter_users = 1; + } + + if ( $logfile ) { + if ( ! open (LOG, ">> $logfile") ) { + print "Can't open logfile $logfile: $!\n"; + $logfile = ''; + } + } + Log("Starting"); + + eval 'use MIME::Parser'; + if ( $@ ) { + Log("The Perl module MIME::Parser must be installed to use this program."); + exit; + } + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + ($admin_user,$admin_pwd) = split(/\s*:\s*/, $admin_user); + + if ( !$admin_user or !$admin_pwd ) { + print STDERR "\nYou must supply the admin username and password\n\n"; + usage(); + } + + if ( !$imapHost or !$dir or !$our_domains ) { + print STDERR "\nYou must supply the hostname, backup directory, and domain names\n\n"; + exit; + } + + Log("Our domain is $our_domains"); + foreach $domain ( split(/,/, $our_domains ) ) { + $domain = lc( $domain ); + $our_domains{"$domain"} = 1; + } + + if ( $users ) { + Log("Only messages for $users will be loaded"); + } +} + +sub usage { + + print "Usage: $0\n"; + print " -D \n"; + print " -i server\n"; + print " -A admin_user:admin_pwd \n"; + print " -m local domains\n"; + print " [-S ]\n"; + print " [-M ]\n"; + print " [-x ] Import only files with this extension\n"; + print " [-L ]\n"; + print " [-d] debug]\n"; + print " [-I] log IMAP commands/responses]\n"; + print " [-U] update mode, don't copy msg if it already exists\n"; + print " [-t ] Used to load all messages into a test account for review\n"; + print " [-l ] Used to limit the number of messages being copied\n"; + + exit; + +} + +sub get_messages { + +my $dir = shift; +my $msgs = shift; + + # Get a list of the message files + + Log("Get list of messages in $dir") if $debug; + + opendir D, $dir; + my @files = readdir( D ); + closedir D; + foreach $_ ( @files ) { + next if /^\./; + if ( $extension ) { + next unless /$extension$/i; + } + Log(" $dir/$_") if $debug; + + if ( $loaded++ < $msg_limit ) { + push( @$msgs, "$dir/$_"); + } + } +} + +# Print a message to STDOUT and to the logfile if +# the opt_L option is present. +# + +sub Log { + +my $line = shift; +my $msg; + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time); + $msg = sprintf ("%.2d-%.2d-%.4d.%.2d:%.2d:%.2d %s", + $mon + 1, $mday, $year + 1900, $hour, $min, $sec, $line); + + if ( $logfile ) { + print LOG "$msg\n"; + } + print STDOUT "$line\n"; + +} + +# connectToHost +# +# Make an IMAP connection to a host +# +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + $sockaddr = 'S n a4 x8'; + ($name, $aliases, $proto) = getprotobyname('tcp'); + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + if ($host eq "") { + Log ("no remote host defined"); + close LOG; + exit (1); + } + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + + select( $$conn ); $| = 1; + return 1; +} + +# +# login in at the IMAP host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$authpwd) = split(/:/, $admin_user ); + login_plain( $user, $authuser, $authpwd, $conn ) or exit; + return 1; + } + + Log("Logging in as $user") if $debug; + $rsn = 1; + sendCommand ($conn, "$rsn LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + if ($response =~ /^$rsn OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + $user = $opt_t if $opt_t; # For testing + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log(">>$response") if $showIMAP; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + Log(">>$cmd") if $showIMAP; +} + +# +# insertMsg +# +# Append a message to an IMAP mailbox +# + +sub insertMsg { + +my $mbx = shift; +my $message = shift; +my $flags = shift; +my $date = shift; +my $conn = shift; +my ($lsn,$lenx); + + Log(" Inserting message") if $debug; + $lenx = length($$message); + + # Log("$$message"); + + ($date) = split(/\s*\(/, $date); + if ( $date =~ /,/ ) { + $date =~ /(.+),\s+(.+)\s+(.+)\s+(.+)\s+(.+)\s+(.+)/; + $date = "$2-$3-$4 $5 $6"; + } else { + $date =~ s/\s/-/; + $date =~ s/\s/-/; + } + + $destMbxs{"$mbx"} = '1'; + + if ( $date ) { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + } else { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \{$lenx\}"); + } + readResponse ($conn); + if ( $response !~ /^\+/ ) { + Log ("1 unexpected APPEND response to $cmd"); + return 0; + } + + if ( $opt_X ) { + print $conn "$$message\n"; + } else { + print $conn "$$message\r\n"; + } + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + return 0; + } + } + + return 1; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the IMAP host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + Log("Getting list of msgs in $mailbox") if $debug; + trim( *mailbox ); + sendCommand ($conn, "$rsn EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^$rsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + sendCommand ( $conn, "$rsn FETCH 1:* (uid flags internaldate body[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^$rsn OK/i ) { + last; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID / ) { + $response[$i] =~ /\* ([^FETCH \(UID]*)/; + $msgnum = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//i; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + ### $response[$i] =~ /INTERNALDATE (.+) ([^BODY]*)/i; + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Message-Id:/i ) { + ($label,$msgid) = split(/: /, $response[$i]); + push (@$msgs,$msgid); + } + } +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +sub get_mbx_list { + +my $dir = shift; +my $mbxs = shift; +my %MBXS; + + if ( $mbx_list ) { + # The user has supplied a list of mailboxes. + @$mbxs = split(/,/, $mbx_list ); + return; + } + + @dirs = (); + push( @dirs, $dir ); + @messages = (); + find( \&findMsgs, @dirs ); # Returns @messages + foreach $fn ( @messages ) { + Log("fn = $fn") if $debug; + $fn =~ s/$dir//; + Log("fn = $fn") if $debug; + $i = rindex($fn,'/'); + Log("find rightmost slash, i = $i") if $debug; + if ( $fn =~ /^\// ) { + $mbx = substr($fn,1,$i); + } else { + $mbx = substr($fn,0,$i); + } + Log("mbx = $mbx") if $debug; + $mbx =~ s/\/$//; + Log("mbx = >$mbx<") if $debug; + push( @$mbxs, $mbx ) if !$MBXS{"$mbx"}; + Log("Add >$mbx< to the list of mailboxes") if $debug; + $MBXS{"$mbx"} = 1; + } +} + +sub findMsgs { + + return if not -f; + + my $fn = $File::Find::name; + push( @messages, $fn ) if $fn =~ /\.$extension$/i; + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + Log("Cannot determine the mailbox delimiter and prefix. Use -y '' to supply it"); + exit; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; +my $substChar = '_'; + + if ( $public_mbxs ) { + my ($public_src,$public_dst) = split(/:/, $public_mbxs ); + # If the mailbox starts with the public mailbox prefix then + # map it to the public mailbox destination prefix + + if ( $srcmbx =~ /^$public_src/ ) { + Log("src: $srcmbx is a public mailbox") if $debug; + $dstmbx = $srcmbx; + $dstmbx =~ s/$public_src/$public_dst/; + Log("dst: $dstmbx") if $debug; + return $dstmbx; + } + } + + # Change the mailbox name if the user has supplied mapping rules. + + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + $srcmbx =~ s/^$srcPrefix//; + $srcmbx =~ s/\\$srcDelim/\//g; + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + # $dstmbx = $srcmbx; + if ( lc( $srcmbx ) eq 'inbox' ) { + $dstmbx = $srcmbx; + } else { + $dstmbx = $srcPrefix . $srcmbx; + } + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + +sub read_header { + +my $msgfn = shift; +my ($msg,$from,$to,$cc,$date,$msgid); + + # Open the message and collect the From, To, CC addresses, Msgid and + # the date. + + Log("Opening $msgfn") if $debug; + unless ( open(F, "<$msgfn") ) { + Log("Error opening $msgfn: $!"); + return ($from,$to,$cc,$date,$msgid); + } + + while( ) { + $msg .= $_; + chomp; + s/\r//g; + last if $_ eq ''; + } + close F; + + my $parser = new MIME::Parser; + $entity = $parser->parse_data( $msg ); + my $header = $entity->head(); + + chomp( $from = $header->get('From') ); + chomp( $to = $header->get('To') ); + chomp( $cc = $header->get('Cc') ); + chomp( $date = $header->get('Date') ); + chomp( $msgid = $header->get('Message-Id') ); + + $from =~ s/^\s+|\r|\t|\n//g; + $to =~ s/^\s+|\r|\t|\n//g; + $cc =~ s/^\s+|\r|\t|\n//g; + $date =~ s/^\s+|\r|\t|\n//g; + + if ( $debug ) { + Log("From $from"); + Log("To $to"); + Log("Cc $cc"); + Log("date $date"); + Log("msgid $msgid"); + } + + return ($from,$to,$cc,$date,$msgid); + +} + + +sub OLDread_header { + +my $msgfn = shift; +my ($from,$to,$cc,$date); + + # Open the message and collect the From, To, and CC addresses + + Log("Opening $msgfn") if $debug; + unless ( open(F, "<$msgfn") ) { + Log("Error opening $msgfn: $!"); + return ($from,$to,$cc,$date); + } + + Log("Opened $msgfn successfully") if $debug; + while( ) { + # Log("Reading line $_") if $debug; + if ( /^Date: (.+)/ ) { + $date = $1; + $date =~ s/\r$|\m$//g; + chomp $date; + } + if ( /^From:\s+(.+)/i ) { + $from = $1; + # $from =~ s/\r|\m//g; + chomp $from; + } + if ( /^To:\s+(.+)/i ) { + $to = $1; + # $to =~ s/\r|\m//g; + chomp $to; + } + if ( /^CC:\s+(.+)/i ) { + $cc = $1; + # $cc =~ s/\r|\m//g; + chomp $cc; + } + + last if $_ eq ''; + } + close F; + + return ($from,$to,$cc,$date); + +} + +sub update_msglist { + +my $from = shift; +my $to = shift; +my $cc = shift; +my $msgfn = shift; +my $date = shift; +my $msgid = shift; +my $list = shift; + + # Sort through the addresses and add them to the + # list if they are local users (meaning we need to + # put a copy of the message in their mailboxes. + + if ( $debug ) { + Log("update_msglist"); + Log("From $from"); + Log("To $to"); + Log("CC $cc"); + Log("Msgid $msgid"); + } + + foreach $_ ( split(/,/, $to ) ) { + Log("to $_") if $debug; + $addr = extract_addr( $_ ); + $addr =~ /(.+)\@(.+)/; + $domain = lc( $2 ); + if ( %USER ) { + if ( $USER{"$addr"} ) { + # Only certain users are to be loaded and this one is on the list + push( @$list, "$addr|$date|$inbox_mbx|$msgid|$msgfn") if $our_domains{$domain}; + } + } else { + # Copy messages for everyone + push( @$list, "$addr|$date|$inbox_mbx|$msgid|$msgfn") if $our_domains{$domain}; + } + } + + foreach $_ ( split(/,/, $cc ) ) { + Log("cc $_") if $debug; + $addr = extract_addr( $_ ); + $addr =~ /(.+)\@(.+)/; + $domain = lc( $2 ); + + if ( %USER ) { + if ( $USER{"$addr"} ) { + # Only certain users are to be loaded and this one is on the list + push( @$list, "$addr|$date|$inbox_mbx|$msgid|$msgfn") if $our_domains{$domain}; + } + } else { + # Copy messages for everyone + push( @$list, "$addr|$date|$inbox_mbx|$msgid|$msgfn") if $our_domains{$domain}; + } + } + + $addr = extract_addr( $from ); + $addr =~ /(.+)\@(.+)/; + $domain = lc( $2 ); + Log("from $from") if $debug; + + if ( %USER ) { + if ( $USER{"$addr"} ) { + # Only certain users are to be loaded and this one is on the list + push( @$list, "$addr|$date|$sent_mbx|$msgid|$msgfn") if $our_domains{$domain}; + } + } else { + # Copy messages for everyone + push( @$list, "$addr|$date|$sent_mbx|$msgid|$msgfn") if $our_domains{$domain}; + } + +} + +sub extract_addr { + +my $addr = shift; + + # Get the address from the value supplied (which may be enclosed + # in angled brackets + + if ( $addr =~ /\<(.+)\>/ ) { + $addr = $1; + } + $addr =~ s/\r$//g; + $addr = lc( $addr ); + $addr =~ s/^\s+|\s+$//g; + + return $addr; + +} + +sub create_mailbox { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if necessary + + return 1 if uc( $mbx ) eq 'INBOX'; # Don't need to create an Inbox; it always exists + + my $status = 1; + sendCommand ($conn, "1 CREATE \"$mbx\""); + my $loops; + while ( 1 ) { + readResponse ($conn); + last if $loops++ > 99; + last if $response =~ /^1 OK/i; + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + Log ("Error creating $mbx: $response"); + $status = 0; + last; + } + } + + return $status; +} + +sub read_msg { + +my $msgfn = shift; +my $msg = shift; + + # Read the message and return its contents in $msg + + Log("Opening $msgfn") if $debug; + unless ( open(MSG, "<$msgfn") ) { + Log("Error opening $msgfn: $!"); + return 0; + } + Log("Opened $msgfn successfully") if $debug; + + $$msg = $msgid = ''; + while( ) { + # Log("Reading line $_") if $debug; + + if ( /^Message-ID:\s*(.+)/i ) { + $msgid = $1 if !$msgid; + $msgid =~ s/\r$//; + } + + s/\r+$//g; + $$msg .= $_; + chomp $$msg; + $$msg .= "\r\n"; + + } + close MSG; + + return $msgid; + +} + +sub commafy { + +my $number = shift; + + $_ = $$number; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + $$number = $_; + +} + +# getMsgIdList +# +# Get a list of the user's messages in a mailbox +# +sub getMsgIdList { + +my $mailbox = shift; +my $msgids = shift; +my $conn = shift; +my $empty; +my $msgid; + + sendCommand ($conn, "1 SELECT \"$mailbox\""); + @response = (); + my $loops; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + last if $loops++ > 10; + } + + if ( $empty ) { + return; + } + + Log("Fetch the header info") if $debug; + + sendCommand ( $conn, "1 FETCH 1:* (body.peek[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $_ = $response[$i]; + last if /OK FETCH complete/; + + if ($response[$i] =~ /Message-ID:/i) { + $response[$i] =~ /Message-Id: (.+)/i; + $msgid = $1; + trim(*msgid); + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = $response[$i+1]; + trim(*msgid); + } + $$msgids{"$mailbox $msgid"} = 1; + $msgid = ''; + } + + # last if $response[$i] =~ /^\)/; + } +} + diff --git a/S/imap_tools.V1.333/maildir_to_imap.pl b/S/imap_tools.V1.333/maildir_to_imap.pl new file mode 100755 index 0000000..88caf15 --- /dev/null +++ b/S/imap_tools.V1.333/maildir_to_imap.pl @@ -0,0 +1,1328 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/maildir_to_imap.pl,v 1.9 2014/10/31 21:33:39 rick Exp $ + +########################################################################## +# Program name maildir_to_imap.pl # +# Written by Rick Sanders # +# # +# Description # +# # +# maildir_to_imap is used to copy the messages in a maildir to a # +# user's IMAP mailbox. maildir_to_imap is executed like this: # +# # +# ./maildir_to_imap.pl -i -D # +# # +# The user list is a file with one or more entries containing the # +# location of the user's maildir and his IMAP username and password. # +# # +# For example: # +# /mhub4/maildirs/rwilson@abc.net,rich.wilson,welcome # +# /mhub4/maildirs/jane.eyre@abc.net,jane.eyre,mypass # +# # +# See usage() for a list of arguments # +########################################################################## + +init(); +get_user_list( \@users ); +migrate_user_list( \@users ); + +exit; + + +sub migrate_user_list { + +my $users = shift; + + # Migrate a set of users + + foreach $userinfo ( @$users ) { + $userinfo =~ s/oauth2:/oauth2---/g; +Log("userinfo $userinfo"); + $usercount++; + ($user) = split(/\s*,\s*/, $userinfo); + Log("migrate $user"); + + # Start the migration. Unless maxChildren has been set to 1 + # fork off child processes to do the migration in parallel. + + if ($maxChildren == 1) { + migrate ($userinfo, $imaphost); + } else { + Log("There are $children running") if $debug; + if ( $children < $maxChildren ) { + Log(" Forking to migrate $user") if $debug; + if ( $pid = fork ) { # Parent + Log (" Parent $$ forked $pid") if $debug; + } elsif (defined $pid) { # Child + Log (" Child process $$ processing $sourceUser") if $debug; + migrate($userinfo, $imaphost); + Log(" $user is done"); + exit 0; + } else { + Log("Error forking child to migrate $user"); + next; + } + $children++; + $children{$pid} = $user; + } + + Log ("I'm PID $$") if $debug; + while ( $children >= $maxChildren ) { + Log(" $$ - Max children running. Waiting...") if $debug; + $foundPid = wait; # Wait for a child to terminate + if ($? != 0) { + Log ("ERROR: PID $foundPid exited with status $?"); + } + delete $children{$foundPid}; + $children--; + } + Log("OK to launch another user migration") if $debug; + } + +} +} + +sub xxxx { + + if ($maxChildren > 1) { + Log("All children have been launched, waiting for them to finish"); + foreach $pid ( keys(%children) ) { + $user = $children{$pid}; + Log("Waiting on process $pid ($user) to finish"); + waitpid($pid, 0); + if ($? != 0) { + Log ("ERROR: PID $pid exited with status $?"); + } + } + } +} + + +sub sum { +summarize(); +$elapsed = sprintf("%.2f", (time()-$start)/3600); +Log("Elapsed time $elapsed hours"); +Log("Migration completed"); +exit; +} + +sub migrate { + +my $userinfo = shift; +my $imaphost = shift; + + my ($user,$pwd,$userpath) = split(/,/, $userinfo); + + return unless connectToHost($imaphost, \$dst); + return unless login($user,$pwd, $dst); + + get_maildir_folders( $userpath, \%folders ); + + my $messages; + foreach $maildir_folder ( keys %folders ) { + $maildir_folder =~ s/\&/&-/; # Encode the '&' char + $maildir_folder =~ s/\s+$//; + $folder_path = $folders{"$maildir_folder"}; + + if ( $MAP{uc("$maildir_folder")} ) { + # The user wants a different name for the IMAP folder + Log("Messages from the $maildir_folder folder will be written to $MAP{uc(\"$maildir_folder\")} "); + $maildir_folder = $MAP{uc("$maildir_folder")}; + } + createMbx( $maildir_folder, $dst ) unless mbxExists( $maildir_folder, $dst ); + + get_maildir_msgs( $folder_path, \@msgs ); + my $msgcount = $#msgs + 1; + Log(" $maildir_folder ($msgcount msgs) $folder_path"); + + next if !@msgs; + + $inserted=0; + foreach $msgfn ( @msgs ) { + $inserted++ if insert_msg( $msgfn, $maildir_folder, $dst ); + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $inserted == $msgs_per_folder; + } + } + Log(" Inserted $inserted messages into $maildir_folder\n"); + } + + $conn_timed_out=0; + +} + +sub init { + +use Getopt::Std; +use Fcntl; +use Socket; +use IO::Socket; +use sigtrap; +use FileHandle; +# require "ctime.pl"; +use MIME::Base64 qw( encode_base64 decode_base64 ); + + $start = time(); + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + + getopts('H:i:L:n:ht:M:SLdD:Um:IA:F:M:'); + + # usage() if $opt_h; + # usage(); + + $userlist = $opt_i; + $logfile = $opt_L; + $maxChildren = $opt_n; + $usage = $opt_h; + $timeout = $opt_t; + $imaphost = $opt_H; + $imaphost = $opt_D; + $mbxList = $opt_m; + $debug=1 if $opt_d; + $showIMAP=1 if $opt_I; + $admin_user = $opt_A; + $mailbox_map = $opt_M; + $msgs_per_folder = $opt_F; + + $timeout = 45 unless $timeout; + $maxChildren = 1 unless $maxChildren; + $hostname = `hostname`; + + foreach $map ( split(/\s*,\s*/, $mailbox_map ) ) { + ($maildir_folder,$imap_mbx) = split(/:/, $map ); + $MAP{uc("$maildir_folder")} = $imap_mbx; + } + + $logfile = "maildir_to_imap.log" unless $logfile; + open (LOG, ">>$logfile"); + select LOG; + $| = 1; + Log("$0 starting"); + + # $date = ctime(time); + # chomp($date); + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + +} + +sub usage { + + print "\nUsage: maildir_to_imap.pl -i -D imapHost\n\n"; + print "Optional arguments:\n\n"; + print " -i \n"; + print "-A \n"; + print " -n \n"; + print " -m eg Inbox,Drafts,Sent\n"; + print " -M \n"; + print " -L \n"; + print " -t \n"; + print " -d debug mode\n"; + print " -I record IMAP protocol exchanges\n\n"; + exit; + +} + + +sub Log { + +my $line = shift; + + if ( LOG ) { + my @f = localtime( time ); + my $timestamp = sprintf( "%02d-%02d-%04d.%02d:%02d:%02d", + (1 + $f[ 4 ]), $f[ 3 ], (1900 + $f[ 5 ]), + @f[ 2,1,0 ] ); + printf LOG "%s %s: %s\n", $timestamp, $$, $line; + } + # print STDERR "$line\n"; +} + +# Make a connection to an IMAP host + +sub format_bytes { + +my $bytes = shift; + + # Format the number nicely + + if ( length($bytes) >= 10 ) { + $bytes = $bytes/1000000000; + $tag = 'GB'; + } elsif ( length($bytes) >= 7 ) { + $bytes = $bytes/1000000; + $tag = 'MB'; + } else { + $bytes = $bytes/1000; + $tag = 'KB'; + } + + # commafy + $_ = $bytes; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + $bytes = sprintf("%.2f", $_) . " $tag"; + + return $bytes; +} + + +sub commafy { + +my $number = shift; + + $_ = $number; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + $number = $_; + + return $number; +} + +# Reconnect to a server after a timeout error. +# +sub reconnect { + +my $checkpoint = shift; +my $conn = shift; + + Log("This is reconnect, conn is $conn") if $debug; + logout( $conn ); + close $conn; + sleep 5; + ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint); + if ( $conn eq $src ) { + $host = $shost; + $user = $suser; + $pwd = $spwd; + } else { + $host = $dhost; + $user = $duser; + $pwd = $dpwd; + } + connectToHost($host,$conn); + login($user,$pwd,$conn); + selectMbx( $mbx, $conn ); + createMbx( $mbx, $dst ); # Just in case + Log("leaving reconnect"); +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } +} + +# Get the total message count and bytes and write +# it to the log. + +sub summarize { + + # Each child appends its totals to /tmp/migrateEmail.sum so + # we read the lines and add up the grand totals. + + $totalUsers=$totalMsgs=$totalBytes=0; + open(SUM, " ) { + chomp; + ($msgs,$bytes) = split(/\|/, $_); + $totalUsers++; + $totalMsgs += $msgs; + $totalBytes += $bytes; + } + + $_ = $totalMsgs; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; # Commafy the message total + $totalMsgs = $_; + $totalBytes = formatBytes( $totalBytes ); + + Log("Summary of migration"); + Log("Migrated $totalUsers users, $totalMsgs messages, $totalBytes."); + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub fix_ts { + +my $date = shift; + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + my $hrs = $2; + + return if length( $hrs ) == 2; + + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + +} + +sub stats { + + print "\n"; + print "Users migrated $users\n"; + print "Total messages $total_msgs\n"; + print "Total bytes $total_bytes\n"; + + $elapsed = time() - $start; + $minutes = $elapsed/60; + print "Elapsed time $minutes minutes\n"; + +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logfile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$str); + print LOG "$line"; + } + print STDOUT "$str\n" unless $quiet_mode; + +} + + +sub usage { + + print STDOUT "usage:\n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "" ) ) { + usage(); + } +} + + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + $conn_timed_out = 1; + } else { + Log("Caught a SIG$sig signal, shutting down"); + exit; + } + Log("Resuming"); +} + +sub insert_msg { + +my $msgfn = shift; +my $folder = shift; +my $dst = shift; + + # Put a message in the user's folder + + my $flag = 'Unseen'; + if ( $msgfn =~ /,/ ) { + $flag = '\\Seen' if $msgfn =~ /,S$/; + } + + if ( !open(MESSAGE, "<$msgfn")) { + Log( " Can't open message fn $msgfn: $!" ); + return 0; + } + my ($date,$message,$msgid); + while( ) { + chomp; + # print STDERR "message line $_\n"; + if ( /^Date: (.+)/ and !$date ) { + $date = $1; + } + if ( /^Message-Id: (.+)/i and !$msgid ) { + $msgid = $1; + Log("msgid $msgid") if $debug; + } + $message .= "$_\r\n"; + } + close MESSAGE; + + fix_date( \$date ); + + $status = insert_imap_msg( $dst, $folder, \$message, $flag, $date ); + + return $status; + +} + +sub entry_exists { + +my $mail = shift; +my $ldap = shift; +my $pwd = shift; +my $dn; +my $i; + + my $attrs = [ 'mailpassword' ]; + my $base = 'o=site'; + my $filter = "mail=$mail"; + + my $result = $ldap->search( + base => $base, + filter => $filter, + scope => "subtree", + attrs => $attrs + ); + + if ( $result->code ) { + my $error = $result->code; + my $errtxt = ldap_error_name( $result->code ); + Log("Error searching for $filter: $errtxt"); + exit; + } + + my @entries = $result->entries; + my $i = $#entries + 1; + + $entry = $entries[0]; + $$pwd = $entry->get_value( 'mailpassword' ); + + return $i; +} + +sub get_user_list { + +my $users = shift; + + # Build a list of the users and their maildirs + + open(F, "<$userlist") or die "Can't open user list $userlist: $!"; + while( ) { + chomp; + s/^\s+//; + next if /^#/; + next unless $_; + my( $maildir,$user,$pwd) = split(/,/, $_); + push( @$users, "$user,$pwd,$maildir" ); + } + close F; + +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host"); + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# login +# +# login in at the IMAP host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + # Do an AUTH PLAIN login + ($admin_user,$admin_pwd) = split(/:/, $admin_user); + login_plain( $user, $admin_user, $admin_pwd, $conn ) or return 0; + return 1; + } + + if ( $pwd =~ /^oauth2---(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + $status = login_xoauth2( $user, $token, $conn ); + return $status; + } + + sendCommand ($conn, "1 LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /^1 NO|^1 BAD/) { + Log ("$user login failed: unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + exit unless defined $fd; + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< *** Connection timeout ***") if $conn_timed_out; + Log ("<< $response") if $showIMAP; +} + +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# +sub sendCommand { + +local($fd) = shift @_; +local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + Log (">> $cmd") if $showIMAP; +} + +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + next if $response =~ /APPEND complete/i; # Ignore strays + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response !~ /^\*/ ) { + Log("unexpected logout response $response"); + last; + } + } + close $conn; + return; +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; + + sendCommand( $conn, "1 SUBSCRIBE \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + Log("Mailbox $mbx has been subscribed") if $debug; + last; + } elsif ( $response =~ /^1 NO|^1 BAD|\^* BYE/i ) { + Log("Unexpected response to subscribe $mbx command: $response"); + last; + } + } + sendCommand ($conn, "1 SELECT \"$mbx\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create a mailbox + + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK|already exists /i; + if ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|reserved mailbox name/i)) { + # Log ("WARNING: $response"); + } + last; + } + } +} + +sub getMailboxList { + +my $user = shift; +my $conn = shift; +my @mbxs; +my @mailboxes; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + foreach $mbx ( @mbxs ) { + trim( *mbx ); + push( @mailboxes, $mbx ); + } + return @mailboxes; + } + + if ($debug) { Log("Get list of user's mailboxes",2); } + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + undef @mbxs; + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + if ($debug) { Log("$mbx is set NOSELECT,skip it",2); } + next; + } + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # those + @mbxs = split(/,/, $mbxList); + } + + return @mbxs; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; + + @$msgs = (); + trim( *mailbox ); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + if ( $empty ) { + Log("$mailbox is empty"); + return; + } + + Log("Fetch the header info") if $debug; + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/; + # $response[$i] =~ /INTERNALDATE "(.+)" BODY/; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $msgnum && $date ) { + if ( $unseen ) { + push (@$msgs,"$msgnum|$date|$flags") unless $flags =~ /Seen/i; + } else { + push (@$msgs,"$msgnum|$date|$flags"); + } + $msgnum = $date = ''; + } + } + +} + +# insert_imap_msg +# +# This routine inserts an RFC822 message into a user's folder +# +sub insert_imap_msg { + +my $conn = shift; +my $mbx = shift; +my $message = shift; +my $flags = shift; +my $date = shift; +my ($lsn,$lenx); + + $lenx = length($$message); + Log(" Inserting message") if $debug; + Log("message size $lenx bytes") if $debug; + + $date =~ s/\((.+)\)//; + $date =~ s/\s+$//g; + + $totalBytes = $totalBytes + $lenx; + $totalMsgs++; + + # Create the mailbox unless we have already done so + # if ($destMbxs{"$mbx"} eq '') { + # createMbx( $mbx, $conn ); + # } + # $destMbxs{"$mbx"} = '1'; + + $flags =~ s/\\Recent//i; + $flags =~ s/Unseen//i; + + if ( $date ) { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + } else { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \{$lenx\}"); + } + + readResponse ($conn); + if ($conn_timed_out) { + Log ("unexpected response timeout appending message"); + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: >$response<"); + # next; + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$$message\r\n"; + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("Unexpected APPEND response: >$response<"); + # next; + return 0; + } + } + + return 1; +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub get_maildir_folders { + +my $userpath = shift; +my $folders = shift; + + # Get a list of the user's folders + + %$folders = (); + + if ( $mbxList ) { + # The user has supplied a list of mailboxes + foreach $mbx ( split(/,/, $mbxList ) ) { + $$folders{"$mbx"} = $userpath . '/.' . $mbx; + } + return; + } + + opendir D, $userpath; + my @files = readdir( D ); + closedir D; + + $$folders{'INBOX'} = $userpath; + foreach $fn ( @files ) { + next if $fn eq '.'; + next if $fn eq '..'; + next unless $fn =~ /^\./; + my $fname = $fn; + $fname =~ s/\./\//; + $fname =~ s/^\///; + $$folders{"$fname"} = "$userpath/$fn"; + } + +} + +sub get_maildir_msgs { + +my $path = shift; +my $msgs = shift; +my @subdirs = qw( tmp cur new ); + + @$msgs = (); + foreach $subdir ( @subdirs ) { + opendir D, "$path/$subdir"; + my @files = readdir( D ); + closedir D; + + foreach $fn ( @files ) { + next if $fn =~ /^\./; + my $msgfn = "$path/$subdir/$fn"; + push( @$msgs, $msgfn ); + } + } + +} + +sub imap_message_exists { + +my $msgid = shift; +my $conn = shift; +my $msgnum; +my $loops; + + # Search a mailbox on the server for a message by its msgid. + + Log(" Search for $msgid") if $debug; + sendCommand ( $conn, "1 SEARCH header Message-Id \"$msgid\""); + while (1) { + readResponse ($conn); + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msgnum) = split(/\* SEARCH /i, $response); + ($msgnum) = split(/ /, $msgnum); + } + + last if $response =~ /^1 OK|^1 NO|^1 BAD/; + last if $response =~ /complete/i; + + last if $loops++ > 10; + } + + if ( $debug ) { + Log("$msgid was not found") unless $msgnum; + } + + return $msgnum; +} + +sub fix_date { + +my $date = shift; + + # Try to make the date acceptable to IMAP + + return if $$date eq ''; + fix_ts( $date ); + + $$date =~ s/\((.+)\)$//; + $$date =~ s/\s+$//g; + + if ( $$date =~ /\s*,\s*/ ) { + ($dow,$$date) = split(/\s*,\s*/, $$date); + } + $$date =~ s/ /-/; + $$date =~ s/ /-/; + + return; + + my @terms = split(/\s+/, $$date); + + if ( $terms[0] =~ /(.+),/ ) { + my $dow = $1; + if ( length( $dow ) > 3 ) { + # Day of week can't be more than 3 chars + my $DOW = substr($dow,0,3); + $$date =~ s/$dow/$DOW/; + } + } + + if ( $terms[1] =~ /jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec/i ) { + # The month and day are swapped. + my $temp = $terms[1]; + $terms[1] = $terms[2]; + $terms[2] = $temp; + } + + if ( $terms[5] =~ /\((.+)\)/ ) { + # The date is missing the TZ offset + $terms[5] = "+0000 ($1)"; + } + + if ( $terms[5] =~ /"(.+)"/ ) { + # The TZ code has quotes instead of parens + $terms[5] =~ s/"/\(/; + $terms[5] =~ s/"/\)/; + $terms[5] = "+0000 $terms[5]"; + } + + if ( $terms[5] =~ /-[0-9]-[0-9][0-9]/ ) { + # Lots of dates are like '-0-500' + $terms[5] =~ s/-//g; + $terms[5] = '-' . $terms[5]; + } + + if ( $terms[5] eq '-0-100' ) { + # Don't know what this is supposed to mean + $terms[5] = "+0000"; + } + + if ( $terms[5] eq '00800' ) { + $terms[5] = "+0800"; + } + + if ( $terms[5] eq '-' ) { + $terms[5] .= $terms[6]; + $terms[5] =~ s/\s+//g; + $terms[6] = ''; + } + if ( $terms[4] =~ /\./ ) { + $terms[4] =~ s/\./:/g; + } + + if ( $terms[5] =~ /[a-zA-Z]/ ) { + $terms[5] = "-0000 ($terms[5])" unless $terms[5] eq 'UT'; + } + + $$date = join( " ", @terms ); + +} + diff --git a/S/imap_tools.V1.333/mbxIMAPsync.pl b/S/imap_tools.V1.333/mbxIMAPsync.pl new file mode 100755 index 0000000..49c62e8 --- /dev/null +++ b/S/imap_tools.V1.333/mbxIMAPsync.pl @@ -0,0 +1,749 @@ +#!/usr/bin/perl + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw(encode_base64 decode_base64); + + ###################################################################### + # Program name mbxIMAPsync.pl # + # Written by Rick Sanders # + # Date 12 Feb 2004 # + # # + # Description # + # # + # mbxIMAPsync is used to synchronize the contents of a Unix # + # mailfiles with an IMAP mailbox. The user supplies the location # + # & name of the Unix mailbox (eg /var/mail/rfs) and the hostname, # + # username, & password of the IMAP account along with the name # + # of the IMAP mailbox. For example: # + # # + # ./mbxIMAPsync.pl -f /var/mail/rfs -i imapsrv/rfs/mypass -m INBOX # + # # + # mbxIMAPsync compares the messages in the mailfile with those in # + # the IMAP mailbox by Message-Id and adds the ones in the mailfile # + # which are not in the IMAP mailbox. Then it looks for messages # + # in the IMAP mailbox which are not in the mailfile and removes # + # them from the IMAP mailbox. # + # # + # See the Usage() for available options. # + ###################################################################### + + init(); + + connectToHost($imapHost, \$conn ); + login($imapUser,$imapPwd, $conn ); + + # Get list of msgs in the mailfile by Message-Id + + $added=$purged=0; + print STDOUT "Processing $mailfile\n"; + print STDOUT "Checking for messages to add\n"; + @msgs = readMbox( $mailfile ); + foreach $msg ( @msgs ) { + @msgid = grep( /^Message-ID:/i, @$msg ); + ($label,$msgid) = split(/:/, $msgid[0]); + chomp $msgid; + trim( *msgid ); + $mailfileMsgs{"$msgid"} = '1'; + push( @sourceMsgs, $msgid ); + + if ( !findMsg( $msgid, $mbx, $conn ) ) { + # print STDOUT "Need to add msgid >$msgid<\n"; + my $message; + + foreach $_ ( @$msg ) { chop $_; $message .= "$_\r\n"; } + + if ( insertMsg($mbx, \$message, $flags, $date, $conn ) ) { + $added++; + print STDOUT " Added $msgid\n"; + } + } + } + + # Remove any messages from the IMAP mailbox that no longer + # exist in the mailfile + + print STDOUT "Checking for messages to purge\n"; + getMsgList( $mbx, \@imapMsgs, $conn ); + foreach $msgid ( @imapMsgs ) { + if ( $mailfileMsgs{"$msgid"} eq '' ) { + if ( deleteMsg($msgid, $mbx, $conn ) ) { + Log(" Marked $msgid for deletion"); + print STDOUT " Marked msgid $msgid for deletion\n"; + $deleted++; + } + } + } + + if ( $deleted ) { + # Need to purge the deleted messages + $purged = expungeMbx( $mbx, $conn ); + } + + Log("Done"); + Log("Added $added messages to IMAP mailbox $mbx"); + Log("Purged $purged messages from IMAP mailbox $mbx"); + + print STDOUT "\nAdded $added messages to IMAP mailbox $mbx\n"; + print STDOUT "Purged $purged messages from IMAP mailbox $mbx\n"; + + exit; + + +sub init { + + if ( ! getopts('f:m:i:L:dxA:F:I') ) { + usage(); + exit; + } + + ($imapHost,$imapUser,$imapPwd) = split(/\//, $opt_i); + $mailfile = $opt_f; + $mbx = $opt_m; + $logfile = $opt_L; + $admin_user = $opt_A; + $msgs_per_folder = $opt_F; + $debug = 1 if $opt_d; + $showIMAP = 1; + + if ( $logfile ) { + if ( ! open (LOG, ">> $logfile") ) { + print "Can't open logfile $logfile: $!\n"; + $logfile = ''; + } + } + Log("\nThis is mbxIMAPsync\n"); + + if ( !-e $mailfile ) { + Log("$mailfile does not exist"); + exit; + } + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } +} + +sub usage { + + print "Usage: mbxIMAPsync.pl\n"; + print " -f \n"; + print " -i imapHost/imapUser/imapPassword\n"; + print " -m \n"; + print " [-L ]\n"; + print " [-d debug]\n"; + +} + +sub readMbox { + +my $file = shift; +my @mail = (); +my $mail = []; +my $blank = 1; +local *FH; +local $_; + + Log("Reading the mailfile") if $debug; + open(FH,"< $file") or die "Can't open $file"; + + while() { + if($blank && /\AFrom .*\d{4}/) { + push(@mail, $mail) if scalar(@{$mail}); + $mail = [ $_ ]; + $blank = 0; + } + else { + $blank = m#\A\Z#o ? 1 : 0; + push(@{$mail}, $_); + } + } + + push(@mail, $mail) if scalar(@{$mail}); + close(FH); + + return wantarray ? @mail : \@mail; +} + +sub Log { + +my $line = shift; +my $msg; + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time); + $msg = sprintf ("%.2d-%.2d-%.4d.%.2d:%.2d:%.2d %s", + $mon + 1, $mday, $year + 1900, $hour, $min, $sec, $line); + + if ( $logfile ) { + print LOG "$msg\n"; + } + print STDERR "$line\n"; + +} + +# Make a connection to a IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + # Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + ($admin_user,$admin_pwd) = split(/:/, $admin_user); + login_plain( $user, $admin_user, $admin_pwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + Log("Logging in as $user") if $debug; + sendCommand ($conn, "1 LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< $response",2) if $showIMAP; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +sub insertMsg { + +my $mbx = shift; +my $message = shift; +my $flags = shift; +my $date = shift; +my $conn = shift; +my ($lsn,$lenx); + + Log(" Inserting message into mailbox $mbx") if $debug; + $lenx = length($$message); + + # Create the mailbox unless we have already done so + ++$lsn; + if ($destMbxs{"$mbx"} eq '') { + Log("creating mailbox $mbx") if $debug; + sendCommand (IMAP, "$lsn CREATE \"$mbx\""); + while ( 1 ) { + readResponse (IMAP); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|reserved mailbox name/i)) { + Log ("WARNING: $response"); + } + last; + } + } + } + + $destMbxs{"$mbx"} = '1'; + + ++$lsn; + $flags =~ s/\\Recent//i; + + # &sendCommand (IMAP, "$lsn APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + sendCommand (IMAP, "$lsn APPEND \"$mbx\" \{$lenx\}"); + readResponse (IMAP); + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: $response"); + # next; + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print IMAP "$$message\r\n"; + + undef @response; + while ( 1 ) { + readResponse (IMAP); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + # next; + return 0; + } + } + + return 1; +} + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the IMAP host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + Log("Getting list of msgs in $mailbox") if $debug; + trim( *mailbox ); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $XDXDXD ) { + Log ("unexpected response: $response"); + Log ("Unable to get list of messages in this mailbox"); + push(@errors,"Error getting list of $user's msgs"); + return 0; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID / ) { + $response[$i] =~ /\* ([^FETCH \(UID]*)/; + $msgnum = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//i; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + ### $response[$i] =~ /INTERNALDATE (.+) ([^BODY]*)/i; + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Message-Id:/i ) { + ($label,$msgid) = split(/: /, $response[$i]); + push (@$msgs,$msgid); + } + } +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +sub findMsg { + +my $msgid = shift; +my $mbx = shift; +my $conn = shift; +my $msgnum; +my $noSuchMbx; + + Log("Searching for $msgid in $mbx") if $debug; + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 NO/ ) { + $noSuchMbx = 1; + last; + } + last if $response =~ /^1 OK/; + } + return '' if $noSuchMbx; + + Log("Search for $msgid") if $debug; + sendCommand ( $conn, "1 SEARCH header Message-Id \"$msgid\""); + while (1) { + readResponse ($conn); + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msgnum) = split(/\* SEARCH /i, $response); + ($msgnum) = split(/ /, $msgnum); + } + + last if $response =~ /^1 OK/; + last if $response =~ /complete/i; + } + + if ( $msgnum ) { + Log("Message exists") if $debug; + } else { + Log("Message does not exist") if $debug; + } + + return $msgnum; +} + +sub deleteMsg { + +my $msgid = shift; +my $mbx = shift; +my $conn = shift; +my $rc; + + Log("Deleting message $msgid") if $debug; + $msgnum = findMsg( $msgid, $mbx, $conn ); + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked $msgid for delete"); + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; +my $purged=0; + + Log("Purging $mbx") if $debug; + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Error selecting mailbox $mbx: $response"); + last; + } + } + + sendCommand ( $conn, "1 EXPUNGE"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + $purged++ if $response =~ /EXPUNGE/i; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + print STDOUT "Error expunging messages: $response\n"; + last; + } + } + + return $purged; + +} + diff --git a/S/imap_tools.V1.333/migrateIMAP.pl b/S/imap_tools.V1.333/migrateIMAP.pl new file mode 100644 index 0000000..1773a88 --- /dev/null +++ b/S/imap_tools.V1.333/migrateIMAP.pl @@ -0,0 +1,2467 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/migrateIMAP.pl,v 1.65 2015/06/24 13:38:39 rick Exp $ + +#************************************************************************* +# * +# Program name migrateIMAP * +# Written by Rick Sanders * +# Date 6 May 2008 * +# * +# Description * +# * +# This script is used to migrate the e-mail on one IMAP Server * +# another. Each users's messages are copied from the "source" * +# server to the "destination" server using the IMAP protocol. You * +# supply a file with the user's names & passwords. For example: * +# * +# ./migrateIMAP.pl -S source -D destination -i * +# * +# Use the -h argument to see the complete list of arguments. * +#************************************************************************* + +init(); + +# Get the list of usernames and passwords + +@users = getUserList( $userlist ); + +$i=$totalUsers=$children=0; +for ($index = 0; $index <= $#users; $index++) { + $userinfo = $users[$index]; + $userinfo =~ s/oauth2:/oauth2---/g; + + ($user) = split(/\s*:\s*/, $userinfo); + Log("user $user"); + + # Start the migration. Unless maxChildren has been set to 1 + # fork off child processes to do the migration in parallel. + + if ($maxChildren == 1) { + migrate ($userinfo); + } else { + Log("There are $children running") if $debug; + if ( $children < $maxChildren ) { + Log(" Forking to migrate $user"); + if ( $pid = fork ) { # Parent + Log (" Parent $$ forked $pid"); + } elsif (defined $pid) { # Child + Log (" Child process $$ processing $sourceUser"); + migrate($userinfo); + Log(" $user is done"); + exit 0; + } else { + Log("Error forking child to migrate $user"); + next; + } + $children++; + $children{$pid} = $user; + } + + Log ("I'm PID $$") if $debug; + while ( $children >= $maxChildren ) { + Log(" $$ - Max children running. Waiting..."); + $foundPid = wait; # Wait for a child to terminate + if ($? != 0) { + Log ("ERROR: PID $foundPid exited with status $?"); + } + delete $children{$foundPid}; + $children--; + } + Log("OK to launch another user migration") if $debug; + } + +} + +if ($maxChildren > 1) { + Log("All children have been launched, waiting for them to finish"); + foreach $pid ( keys(%children) ) { + $user = $children{$pid}; + Log("Waiting on process $pid ($user) to finish"); + waitpid($pid, 0); + if ($? != 0) { + Log ("ERROR: PID $pid exited with status $?"); + } + } +} + +summarize(); +$elapsed = sprintf("%.2f", (time()-$start)/3600); +Log("Elapsed time $elapsed hours"); +Log("Migration completed"); +exit; + +sub migrate { + +my $user = shift; +my $mbxs_created = 0; + + ($sourceUser,$sourcePwd,$destUser,$destPwd) = split(/\s*:\s*/, $user); + $userinfo = $user; + + Log("Starting migration of $sourceUser"); + if ( $debug ) { + Log( " sourceUser $sourceUser"); + Log( " destUser $destUser"); + Log( " sourcePwd $sourcePwd"); + Log( " destPwd $destPwd"); + Log( " src_admin_user $src_admin_user"); + Log( " dst_admin_user $dst_admin_user"); + } + + $conn_timed_out=0; + return 0 unless connectToHost($sourceHost, \$src); + return 0 unless login_source( $user, $src ); + + return 0 unless connectToHost($destHost, \$dst); + return 0 unless login_dest( $user, $dst ); + + namespace( $src, \$srcPrefix, \$srcDelim, $opt_x ); + namespace( $dst, \$dstPrefix, \$dstDelim, $opt_y ); + + $totalUsers++; + @mbxs = getMailboxList($sourceUser, $src); + getMailboxes( \%DST_MBXS, $dst ); + + # Exclude certain mbxs if that's what the user wants + if ( $excludeMbxs ) { + exclude_mbxs( \@mbxs ); + } + + $longest_name = mailbox_names( \@mbxs ); + + map_mbx_names( \%mbx_map, $srcDelim, $dstDelim ); + + $total = 0; + foreach $mbx ( @mbxs ) { + $dstmbx = mailboxName( $mbx,$srcPrefix,$srcDelim,$dstPrefix,$dstDelim ); + $checkpoint = "$mbx|$sourceHost|$sourceUser|$sourcePwd|"; + $checkpoint .= "$destHost|$destUser|$destPwd"; + + createMbx( $dstmbx, $dst ) if !$DST_MBXS{"$dstmbx"}; + + # Mbxs marked NOSELECT don't hold any messages so after creating them + # we don't need to do anything else. + next if $nosel_mbxs{"$mbx"}; + + get_supported_flags( $dstmbx, $dst, \%SUPPORTED_FLAGS ); + + if ( $sent_after or $sent_before ) { + getDatedMsgList( $mbx, $sent_before, $sent_after, \@msgs, $src ); + } else { + getMsgList( $mbx, \@msgs, $src ); + } + + if ( $debug ) { + $n = $#msgs + 1; + Log(" $mbx has $n messages"); + foreach $m ( @msgs ) { Log("$m"); } + } + + if ( $#msgs == -1 ) { + # Create an empty mailbox + $line = pack("A$longest_name A13 A18", $mbx, '', "(0 messages)"); + Log(" Copied $line"); + next; + } + + if ( $update ) { + + # Get a list of messages on the dest. Use the message id + # as the key unless the user has specified MD5 hashes + # so we can avoid copying ones already on the dest + + %DST_MSGS = %SRC_MGS = (); + if ( $md5_hash ) { + Log("Using md5 hash of msg body as the key") if $debug; + getMsgList( $mbx, \@dstmsgs, $dst ); + foreach $msg ( @dstmsgs ) { + ($msgnum,$msgid,$subject,$date) = split(/\|/, $msg); + fetch_msg_body( $msgnum, $dst, \$message ); + $key = hash( \$message ); + Log(" msgnum:$msgnum hash $key") if $debug; + $DST_MSGS{"$key"} = 1; + } + } else { + getMsgIdList( $dstmbx, \%DST_MSGS, $dst ); + } + } + + $added=0; + selectMbx( $dstmbx, 'SELECT', $dst ); + + my $msgcount = scalar @msgs; + my ($u) = split(/:/, $sourceUser); + Log("$u: There are $msgcount messages in the $mbx folder to be migrated"); + + foreach $_ ( @msgs ) { + ($msgnum,$date,$flags,$msgid,$header_date) = split(/\|/, $_); + $flags = validate_flags( $flags, \%SUPPORTED_FLAGS ); + + if ( $update ) { + # If we are in 'update' mode then don't copy + # a message if it already exists on the dest + if ( $md5_hash ) { + # Use the md5 hash + fetch_msg_body( $msgnum, $src, \$message ); + $key = hash( \$message ); + next if $DST_MSGS{"$key"}; + } else { + # Use the msgid + if ( $DST_MSGS{"$msgid"} ) { + # Msg is already on the destinatoin + Log(" $msgid is already on the destination") if $debug; + next; + } + } + } + + alarm $timeout; + fetchMsg( $msgnum, $mbx, \$message, $src ); + alarm 0; + + $size = length( $message ); + + if ( $copy_this_size_only ) { + if ( $size == $copy_this_size_only ) { + Log("COPYING MSGNUM $msgnum TO THE DESTINATION"); + } else { + Log("SKIPPING MSGNUM $msgnum"); + next; + } + } + + my $mb = $size/1000000; + if ( $max_size and $mb > $max_size ) { + commafy( \$size ); + Log(" Skipping message $msgnum because its size ($size) exceeds the $max_size MB limit"); + next; + } + + if ( $throttle ) { + # Gmail is throttling us. Sleep a bit to lower our access rate + Log("Gmail is throttling our connection. Sleeping for 30 seconds"); + sleep 30; + $throttle = 0; + } + + next if length( $message ) == 0; + + if ( $conn_timed_out ) { + Log("source host $srcHost timed out"); + reconnect( $checkpoint, $src ); + $conn_timed_out = 0; + next; + } + + if ( $wrap_long_lines ) { + $new_message = ''; + foreach $_ ( split(/\r\n/, $message ) ) { + if ( length( $_ ) < 1000 ) { + $new_message .= "$_\r\n"; + next; + } + $len = length( $_ ); + Log(" Need to wrap this line: length = $len") if $debug; + # Wrap the line in chunks of 1,000 chars + $line = wrap_long_line( $_ ); + $new_message .= $line; + } + $message = $new_message; + } + + insertMsg( $dst, $dstmbx, *message, $flags, $date ); + if ( $conn_timed_out ) { + Log("destination host $destHost timed out"); + reconnect( $checkpoint, $dst ); + $conn_timed_out = 0; + next; + } + $added++; + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $added == $msgs_per_folder; + } + } + $total += $added; + $line = pack("A$longest_name A13 A18", $mbx, '', "($added messages)"); + Log(" Copied $line"); + + if ( $update and $del_from_dest ) { + %DST_MSGS = %SRC_MGS = (); + Log("Get msgids on the destination") if $debug; + selectMbx( $dstmbx, 'SELECT', $dst ); + getMsgIdList( $dstmbx, \%DST_MSGS, $dst ); + + selectMbx( $mbx, 'EXAMINE', $src ); + Log("Get msgids on the source") if $debug; + getMsgIdList( $mbx, \%SRC_MSGS, $src ); + + my $dst_count = keys %DST_MSGS; + my $src_count = keys %SRC_MSGS; + $s = keys %SRC_MSGS; + $d = keys %DST_MSGS; + Log("There are $s msgs on the src and $d on the dest for $dstmbx") if $debug; + Log("Remove msgs from the destination which aren't on the source") if $debug; + + $expunge = 0; + selectMbx( $dstmbx, 'SELECT', $dst ); + foreach $msgid ( keys %DST_MSGS ) { + next if $SRC_MSGS{"$msgid"}; + + # This message no longer exists on the source. Delete it from the dest + Log("$msgid is not on the source, delete it from the dest") if $debug; + $dst_msgnum = $DST_MSGS{"$msgid"}; + deleteMsg( $dst, $dst_msgnum ) if $dst_msgnum; + $expunge = 1; + } + expungeMbx( $dst, $dstmbx ) if $expunge; + } + } + + # Update the summary file with the totals for this user + open(SUM, ">>/tmp/migrateIMAP.sum"); + print SUM "$total|$totalBytes\n"; + close SUM; + $totalBytes = formatBytes( $totalBytes ); + Log(" Copied $total messages $totalBytes"); + logout( $src ); + logout( $dst ); + +} + +sub init { + + use Getopt::Std; + use Fcntl; + use Socket; + use IO::Socket; + use sigtrap; + use FileHandle; + use MIME::Base64 qw(decode_base64 encode_base64); + + $start = time(); + + # Set up signal handling + $SIG{'ALRM'} = 'signalHandler'; + $SIG{'HUP'} = 'signalHandler'; + $SIG{'INT'} = 'signalHandler'; + $SIG{'TERM'} = 'signalHandler'; + $SIG{'URG'} = 'signalHandler'; + + getopts('S:D:L:i:b:t:n:M:m:hIdux:y:a:b:UHr:e:f:E:R:Xp:wF:os:GJPQA:C:WZ:'); + + usage() if $opt_h; + unless ($opt_S and $opt_D ) { + usage(); + } + $sourceHost = $opt_S; + $destHost = $opt_D; + $userlist = $opt_i; + $logfile = $opt_L; + $maxChildren = $opt_n; + $usage = $opt_h; + $timeout = $opt_t; + $unseen = $opt_u; + $seen_only = $opt_o; + $sent_after = $opt_a; + $sent_before = $opt_b; + $mbx_map_fn = $opt_M; + $mbxList = $opt_m; + $root_mbx = $opt_p; + $excludeMbxs = $opt_E; + $excludeMbxs_regex = $opt_R; + $range = $opt_r; + $showIMAP=1 if $opt_I; + $debug=1 if $opt_d; + $update=1 if $opt_U; + $del_from_dest = 1 if $opt_X; + $md5_hash=1 if $opt_H; + $src_admin_user = $opt_e; + $dst_admin_user = $opt_f; + $exchange = 1 if $opt_w; + $msgs_per_folder = $opt_F; + $max_size = $opt_s; + $src_xoauth2_tokens = 1 if $opt_G; + $dst_xoauth2_tokens = 1 if $opt_J; + $src_plain = 1 if $opt_P; + $dst_plain = 1 if $opt_Q; + $kerio_src_master_pwd = $opt_A; + $kerio_dst_master_pwd = $opt_C; + $wrap_long_lines = 1 if $opt_W; + + $copy_this_size_only = $opt_Z; + + $timeout = 300 unless $timeout; + $maxChildren = 2 unless $maxChildren; + $hostname = `hostname`; + + if ( $md5_hash ) { + use Digest::MD5 qw(md5_hex); + } + + $logfile = "migrateIMAP.log" unless $logfile; + if ( -e $logfile ) { + # Rename the existing logfile + $line = `head -n 1 $logfile`; + $ts = substr($line,0,16); + rename($logfile, "$logfile.$ts"); + } + open (LOG, ">>$logfile"); + select LOG; + $| = 1; + unlink '/tmp/migrateIMAP.sum' if -e '/tmp/migrateIMAP.sum'; + Log("$0 starting"); + + if ( $ENV{OS} =~ /Windows/i ) { + Log("Running on a Windows system."); + Log("A single migration process will be used since Windows does not support fork()"); + $maxChildren = 1; + } + if ( $update ) { + if ( $md5_hash ) { + Log("Running in update/md5_hash mode"); + } else { + Log("Running in update mode"); + Log("Messages on the dest which are not on the source will be deleted") if $del_from_dest; + } + } + + Log("Renamed old logfile to $logfile.$ts") if $ts; + + # Validate the arguments and call usage() if necessary + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + no warnings 'utf8'; + +} + +sub usage { + + print "\nUsage: migrateIMAP.pl -S sourceHost -D destinationHost\n\n"; + print "Optional arguments:\n\n"; + print " -i \n"; + print " -n \n"; + print " -L \n"; + print " -t \n"; + print " -u \n"; + print " -o \n"; + print " -M mailbox map file. Maps src mbxs to dst mbxs.\n"; + print " -p put all folders under this mailbox (except inbox)\n"; + print " -m List of mailboxes to migrate.\n"; + print " -E List of mailboxes to exclude.\n"; + print " -R List of mailboxes to exclude using regular expressions.\n"; + print " -d debug mode\n"; + print " -I record IMAP protocol exchanges\n"; + print " -x source (eg, -x '. INBOX.'\n"; + print " -y destination\n"; + print " -a copy only messages after this date\n"; + print " -b copy only messages before this date\n"; + print " -U update mode, don't copy messages that already exist at the destination\n"; + print " -X In update mode delete messages from the destination which don't exist on the source\n"; + print " -H use an MD5 hash of the message body to determine uniqueness\n"; + print " -T copy custom flags (eg, \$Label1,\$MDNSent,etc)\n"; + print " -e Source administrator user and password\n"; + print " -f Destination administrator user and password\n"; + print " -w destination is Exchange server\n"; + print " -G passwords are XOAUTH2 tokens\n"; + print " -s . Don't copy messages larger than this size.\n"; + print " -A \n"; + print " -C \n"; + print " -W wrap long lines at 1,000 characters\n"; + exit; + +} + + +sub Log { + +my $line = shift; + +if ( 0 ) { + if ( $line =~ /^\>\> 1 LOGIN (.+) "(.+)"/ ) { + # Obscure the password for security's sake + # $line =~ s/$2/XXXX/; + $line = ">> LOGIN $1 \"XXXX\""; + } +} + + if ( LOG ) { + my @f = localtime( time ); + my $timestamp = sprintf( "%02d-%02d-%04d.%02d:%02d:%02d", + (1 + $f[ 4 ]), $f[ 3 ], (1900 + $f[ 5 ]), + @f[ 2,1,0 ] ); + printf LOG "%s %s: %s\n", $timestamp, $$, $line; + } + print STDERR "$line\n"; +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# login_source +# +sub login_source { + +my $user = shift; +my $src = shift; + + ($sourceUser,$sourcePwd,$destUser,$destPwd) = split(/\s*:\s*/, $user); + + if ( $src_plain ) { + Log("Do a PLAIN login on the source"); + $sourceUser = "$sourceUser:$sourceUser:$sourcePwd"; + } elsif ( $src_admin_user and !$sourcePwd ) { + Log("Doing AUTH PLAIN to the source") if $debug; + # Do an admin login using AUTHENTICATION = PLAIN + $sourceUser .= ":$src_admin_user"; + $src_admin_user =~ /(.+)\s*:\s*(.+)/; + $src_admin_pwd = $2; + } + + unless ( $sourcePwd or $src_admin_user or $kerio_src_master_pwd ) { + Log("Password not found for $sourceUser, messages will not be migrated"); + return 0; + } + + if ( $kerio_src_master_pwd ) { + return 0 unless kerio_master_login( $kerio_src_master_pwd, $sourceUser, $src ); + } elsif ( $src_xoauth2_tokens ) { + # Passwords are OAUTH2 tokens + login_xoauth2( $sourceUser, $sourcePwd, $src); + } elsif ( $sourcePwd =~ /^oauth2---(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + $status = login_xoauth2( $sourceUser, $token, $src ); + return $status; + } elsif ( $sourceUser =~ /(.+):(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + Log("PLAIN login") if $debug; + return 0 unless login_plain( $sourceUser, $src ); + } else { + # Otherwise do an ordinary login + Log("ORDINARY login"); + return 0 unless login($sourceUser,$sourcePwd, $src); + } + +} + +sub login_dest { + +my $user = shift; +my $dst = shift; + + ($sourceUser,$sourcePwd,$destUser,$destPwd) = split(/\s*:\s*/, $user); + + if ( $dst_plain ) { + Log("Do a PLAIN login on the dest"); + $destUser = "$destUser:$destUser:$destPwd"; + } elsif ( $dst_admin_user and !$destPwd ) { + # Do an admin login using AUTHENTICATION = PLAIN + Log("Doing AUTH PLAIN to the dest"); + $destUser .= ":$dst_admin_user"; + $dst_admin_user =~ /(.+)\s*:\s*(.+)/; + $dst_admin_pwd = $2; + } + + unless ( $destPwd or $dst_admin_user or $kerio_dst_master_pwd ) { + Log("Password not found for $destUser, messages will not be migrated"); + return 0; + } + + if ( $kerio_dst_master_pwd ) { + return 0 unless kerio_master_login( $kerio_dst_master_pwd, $destUser, $dst ); + } elsif ( $dst_xoauth2_tokens ) { + # Passwords are OAUTH2 tokens + login_xoauth2( $destUser, $destPwd, $dst); + } elsif ( $destPwd =~ /^oauth2---(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + $status = login_xoauth2( $destUser, $token, $dst ); + return $status; + } elsif ( $destUser =~ /(.+):(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + Log("PLAIN login") if $debug; + return 0 unless login_plain( $destUser, $dst ); + } else { + # Otherwise do an ordinary login + Log("ORDINARY login"); + return 0 unless login($destUser,$destPwd, $dst); + } + +} + +# login +# +# login in at the host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + sendCommand ($conn, "1 LOGIN $user \"$pwd\""); + while (1) { + readResponse ( $conn ); + $gmail = 1 if $response =~ /OK Gimap ready for requests/; + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /^1 NO|^1 BAD/) { + Log ("$user login failed: unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + my ($user,$admin,$pwd) = split(/:/, $user, 3); + if ( $debug ) { + Log("Doing an AUTHENTICATE = PLAIN"); + Log( "user $user"); + Log( "admin $admin"); + Log( "pwd $pwd"); + } + + my $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + my $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE PLAIN {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + $gmail = 1 if $response =~ /OK Gimap ready for requests/; + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + exit; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +sub kerio_master_login { + +my $pwd = shift; +my $user = shift; +my $conn = shift; + + sendCommand ($conn, "1 X-MASTERAUTH"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + my ($challenge) = $response =~ /^\+ (.+)/; + my $string = $challenge . $pwd; + my $challenge_response = md5_hex( $string ); + + if ( $debug ) { + Log("challenge $challenge"); + Log("pwd $pwd"); + Log("sending $challenge_response"); + } + + sendCommand ($conn, $challenge_response); + my $loops; + while (1) { + last if $loops++ > 9; + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("Failed to login as Kerio Master: unexpected LOGIN response: $response"); + exit; + } + } + + # Select the user + + Log("Selecting user $user") if $debug; + sendCommand ($conn, "1 X-SETUSER \"$user\"" ); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + + Log("$user has been selected") if $debug; + + return 1; +} + + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $user = shift; +my $conn = shift; +my @mbxs; +my @mailboxes; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + foreach $mbx ( @mbxs ) { + trim( *mbx ); + push( @mailboxes, $mbx ); + } + return @mailboxes; + } + + if ($debug) { Log("Get list of user's mailboxes",2); } + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /\{(.+)\}$/ ) { + # The next response contains a nested mbx + readResponse ($conn); + next; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + %nosel_mbxs = (); + undef @mbxs; + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\{(.+)\}$/ ) { + # Domino workaround for submailbox appearing on next line + $mbx = $response[$i+1]; + } elsif ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + + if ( $mbx eq '[Gmail]/All Mail' ) { + # The Gmail 'All Mail' folder is where all msgs in Gmail are stored. + # Gmail uses pointers to group the messages into folders. We don't + # need to copy the contents of the All Mail folders because we'll + # get them from the other 'folders'. + Log("Skipping $mbx"); + next; + } + + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # those + @mbxs = split(/,/, $mbxList); + } + + return @mbxs; +} + +# getDatedMsgList +# +# Get a list of the user's messages in a mailbox on +# the host in the specified range of dates +# + +sub getDatedMsgList { + +my $mailbox = shift; +my $sent_before = shift; +my $sent_after = shift; +my $msgs = shift; +my $conn = shift; +my ($seen, $empty, @list,$msgid); + + # Get a list of messages sent in the range specified by $sent_before + # and $sent_after + + if ( $sent_before and $sent_after ) { + $search = "(SINCE $sent_after) (BEFORE $sent_before)"; + } elsif ( $sent_after ) { + $search = "SINCE $sent_after"; + } elsif ( $sent_before ) { + $search = "BEFORE $sent_before"; + } + + Log("Searching for messsages $search"); + + @list = (); + @$msgs = (); + + sendCommand ($conn, "1 SELECT \"$mailbox\""); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ / EXISTS/i) { + $response =~ /\* ([^EXISTS]*)/; + } elsif ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO/i ) { + Log ("unexpected response: $response"); + return 0; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + my ($date,$ts) = split(/\s+/, $cutoff_date); + + # + # Get list of messages sent before/after the reference date + # + Log("Get messages sent $operator $date") if $debug; + $nums = ""; + sendCommand ($conn, "1 SEARCH $search"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response =~ /^\*\s+SEARCH/i ) { + ($nums) = ($response =~ /^\*\s+SEARCH\s+(.*)/i); + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected SEARCH response: $response"); + return; + } + } + Log("$nums") if $debug; + if ( $nums eq "" ) { + Log (" $mailbox has no messages $search") if $debug; + return; + } + my @number = split(/\s+/, $nums); + $n = $#number + 1; + + $nums =~ s/\s+/ /g; + @msgList = (); + @msgList = split(/ /, $nums); + + if ($#msgList == -1) { + # No msgs in this mailbox + return 1; + } + +@$msgs = (); +for $num (@msgList) { + + # sendCommand ( $conn, "1 FETCH $num (uid flags internaldate body[header.fields (Message-Id Date)])"); + sendCommand ( $conn, "1 FETCH $num (uid flags internaldate RFC822.SIZE body.peek[header.fields (Message-Id Date)])"); + + @response = (); + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } + last if $response =~ /^1 NO|^1 BAD|^\* BYE/; + } + + $flags = ''; + my $msgid; + foreach $_ ( @response ) { + last if /^1 OK FETCH complete/i; + if ( /FLAGS/ ) { + # Get the list of flags + /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( /Message-ID:\s*(.*)/i ) { + $msgid = $1; + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + if ( /INTERNALDATE/i) { + # /INTERNALDATE (.+) BODY/i; + # /INTERNALDATE (.+) RFC822\.SIZE/i; + /INTERNALDATE (.+) [RFC822\.SIZE|BODY|FLAGS]/i; + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + #### next if check_cutoff_date( $date, $cutoff_date ); + } + + if ( /RFC822\.SIZE/i) { + /RFC822\.SIZE ([0-9]+) BODY/i; + $size = $1; + } + + if ( /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( /^\)/ or /\)\)$/ ) { + push (@$msgs,"$msgnum|$date|$flags|$msgid|$size"); + $msgnum=$msgid=$date=$flags=$size=''; + } + + } + } + + foreach $_ ( @$msgs ) { + Log("getDated found $_") if $debug; + } + + return 1; +} + + +# getMsgList +# +# Get a list of the user's messages in the indicated mailbox on +# the source host +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; +my $header_date; + + @$msgs = (); + trim( *mailbox ); + + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + return if $empty; + + Log("Fetch the header info") if $debug; + + if ( $range ) { + $fetch_range = $range; + } else { + $fetch_range = '1:*'; + } + + sendCommand ( $conn, "1 FETCH $fetch_range (uid flags internaldate body[header.fields (From Subject Date Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return; + } elsif ( $response =~ /^\* BYE/i ) { + Log("The server terminated our session with a BYE command: $response"); + exit; + } + } + + read_response( \@response, $msgs ); + +} + + +sub fetchMsg { + +my $msgnum = shift; +my $mbx = shift; +my $message = shift; +my $conn = shift; + + Log(" Fetching msg $msgnum...") if $debug; + $$mesage = ''; + + $item = 'BODY[]'; + sendCommand( $conn, "1 FETCH $msgnum ($item)"); + @a = (); + while (1) { + readResponse ($conn); + Log ("Unable to fetch message - connection timeout") if ($conn_timed_out); + + if ( $response =~ /THROTTLE/i and $gmail ) { + # Gmail is throttling our connection + $throttle = 1; + } + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Error fetching msgnum $msgnum: $response"); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it"); + push(@errors,"Message could not be processed, skipping it"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{[0-9]+\}/i) { + $item =~ s/BODY\[\]/BODY\\[\\]/ if $response =~ /BODY/; + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*$item\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + # Log ("Already read $cc bytes of $len - waiting on " . ($len - $cc)) if $debug; + $n = 0; + $n = read ($conn, $segment, $len - $cc); + # $n = read ($conn, $segment, ($len - $cc > 4096 ? 4096 : $len-$cc)); + # Log ("Read $n bytes") if $debug; + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + exit unless defined $fd; + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< *** Connection timeout ***") if $conn_timed_out; + Log ("<< $response") if $showIMAP; +} + +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# +sub sendCommand { + +local($fd) = shift @_; +local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + Log (">> $cmd") if $showIMAP; +} + +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + next if $response =~ /APPEND complete/i; # Ignore strays + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response !~ /^\*/ ) { + Log("unexpected logout response $response"); + last; + } + } + close $conn; + return; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + +# insertMsg +# +# This routine inserts an RFC822 messages into a user's folder +# +sub insertMsg { + +local ($conn, $mbx, *message, $flags, $date) = @_; +local ($lsn,$lenx); + + Log(" Inserting message") if $debug; + $lenx = length($message); + $totalBytes = $totalBytes + $lenx; + $totalMsgs++; + + $flags = flags( $flags ); + fixup_date( \$date ); + + $flags =~ s/\\Recent//i; + + alarm ( $timeout ); + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + readResponse ($conn); + alarm( 0 ); + if ($conn_timed_out) { + Log ("unexpected response timeout appending message"); + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + if ( $response =~ /\* BYE/ ) { + Log("The destination server has closed our session"); + exit; + } + + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: >$response<"); + # next; + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + alarm $timeout; + print $conn "$message\r\n"; + alarm 0; + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("Unexpected APPEND response: >$response<"); + # next; + return 0; + } + } + + return; +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create a mailbox + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK|already exists /i; + if ( $response !~ /^\*/ ) { + if (!($response =~ /already exists|reserved mailbox name/i)) { + # Log ("WARNING: $response"); + } + last; + } + } +} + +sub formatBytes { + +my $bytes = shift; + + # Format the number nicely + + if ( length($bytes) >= 10 ) { + $bytes = $bytes/1000000000; + $tag = 'GB'; + } elsif ( length($bytes) >= 7 ) { + $bytes = $bytes/1000000; + $tag = 'MB'; + } else { + $bytes = $bytes/1000; + $tag = 'KB'; + } + + # commafy + $_ = $bytes; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + $bytes = sprintf("%.2f", $_) . " $tag"; + + return $bytes; +} + +sub getUserList { + +my $fn = shift; + + @users = (); + unless ( -e $fn ) { + Log("Fatal error reading $fn: $!"); + exit; + } + open(L, "<$fn") or die $!; + while ( ) { + chomp; + s/\r$//; + s/^\s+//; + next if /^#/; + push( @users, $_ ); + } + close L; + + return @users; + +} + +sub selectMbx { + +my $mbx = shift; +my $mode = shift; +my $conn = shift; + + $mode = 'EXAMINE' unless $mode eq 'SELECT'; + + Log("selecting mbx $mbx") if $debug; + sendCommand ($conn, "1 $mode \"$mbx\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + +} + +# Reconnect to a server after a timeout error. +# +sub reconnect { + +my $checkpoint = shift; +my $conn = shift; + + logout( $src ); + logout( $dst ); + + ($user) = split(/\s*:\s*/, $userinfo); + connectToHost($sourceHost, \$src); + login_source( $userinfo, $src ); + + connectToHost($destHost, \$dst); + login_dest( $userinfo, $dst ); + + selectMbx( $mbx, 'SELECT', $src ); + + return; +} + +# Handle signals + +sub signalHandler { + +my $sig = shift; + + if ( $sig eq 'ALRM' ) { + Log("Caught a SIG$sig signal, timeout error"); + reconnect( $checkpoint, \$dst ); + $conn_timed_out = 1; + } else { + Log("eaught a SIG$sig signal, shutting down"); + exit; + } +} + +# Get the total message count and bytes and write +# it to the log. + +sub summarize { + + # Each child appends its totals to /tmp/migrateEmail.sum so + # we read the lines and add up the grand totals. + + $totalUsers=$totalMsgs=$totalBytes=0; + open(SUM, " ) { + chomp; + ($msgs,$bytes) = split(/\|/, $_); + $totalUsers++; + $totalMsgs += $msgs; + $totalBytes += $bytes; + } + + $_ = $totalMsgs; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; # Commafy the message total + $totalMsgs = $_; + $totalBytes = formatBytes( $totalBytes ); + + Log("Summary of migration"); + Log("Migrated $totalUsers users, $totalMsgs messages, $totalBytes."); + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim") if $debug; + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^1 NO|^1 BAD/; + } + + if ( $debug ) { + Log("prefix $$prefix"); + Log("delim $$delimiter"); + } + +} +sub mailboxName { + +my $srcmbx = shift; +my $srcPrefix = shift; +my $srcDelim = shift; +my $dstPrefix = shift; +my $dstDelim = shift; +my $dstmbx; + + # Adjust the mailbox name if the source and destination server + # have different mailbox prefixes or hierarchy delimiters. + + if ( $srcmbx =~ /[$dstDelim]/ and $srcDelim ne $dstDelim ) { + # The mailbox name has a character that is used on the destination + # as a mailbox hierarchy delimiter. We have to replace it. + $srcmbx =~ s^[$dstDelim]^$substChar^g; + } + + if ( $debug ) { + Log("src mbx $srcmbx"); + Log("src prefix $srcPrefix"); + Log("src delim $srcDelim"); + Log("dst prefix $dstPrefix"); + Log("dst delim $dstDelim"); + } + + # Change the mailbox name if the user has supplied mapping rules. + if ( $mbx_map{"$srcmbx"} ) { + $srcmbx = $mbx_map{"$srcmbx"} + } + + if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) { + # No adjustments necessary + $dstmbx = $srcmbx; + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstmbx =~ s/^$dstPrefix//; + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + + $dstmbx = 'Trash' if lc( $dstmbx) eq "inbox/trash"; + $dstmbx = 'Sent' if lc( $dstmbx) eq "inbox/sent"; + + $dstmbx =~ s/\\//g; + } + return $dstmbx; + } + + $srcmbx =~ s#^$srcPrefix##; + $dstmbx = $srcmbx; + + if ( $srcDelim ne $dstDelim ) { + # Need to substitute the dst's hierarchy delimiter for the src's one + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $dstDelim = "\\" . $dstDelim if $dstDelim eq '.'; + $dstmbx =~ s#$srcDelim#$dstDelim#g; + $dstmbx =~ s/\\//g; + } + if ( $srcPrefix ne $dstPrefix ) { + # Replace the source prefix with the dest prefix + $dstmbx =~ s#^$srcPrefix## if $srcPrefix; + if ( $dstPrefix ) { + $dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX'; + } + $dstDelim = "\\$dstDelim" if $dstDelim eq '.'; + $dstmbx =~ s#^$dstDelim##; + } + + if ( $root_mbx ) { + # Put folders under a 'root' folder on the dst + $dstDelim =~ s/\./\\./g; + $dstmbx =~ s/^$dstPrefix//; + $dstmbx =~ s/^$dstDelim//; + $dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx; + if ( uc($srcmbx) eq 'INBOX' ) { + # Special case for the INBOX + $dstmbx =~ s/INBOX$//i; + $dstmbx =~ s/$dstDelim$//; + } + $dstmbx =~ s/\\//g; + } + + return $dstmbx; +} + +sub map_mbx_names { + +my $mbx_map = shift; +my $srcDelim = shift; +my $dstDelim = shift; + + # The -M argument causes migrateIMAP to read the + # contents of a file with mappings between source and + # destination mailbox names. This permits the user to + # to change the name of a mailbox when copying messages. + # + # The lines in the file should be formatted as: + # : + # For example: + # Drafts/2008/Save: Draft_Messages/2008/Save + # Action Items: Inbox + # + # Note that if the names contain non-ASCII characters such + # as accents or diacritical marks then the Perl module + # Encode::IMAPUTF7 module must be installed. + + return unless $mbx_map_fn; + + unless ( open(MAP, "<$mbx_map_fn") ) { + Log("Error opening mbx map file $mbx_map_fn: $!"); + exit; + } + $use_utf7 = 0; + while( ) { + chomp; + s/^\s+//; + next if /^#/; + next unless $_; + ($srcmbx,$dstmbx) = split(/\s*:\s*/, $_); + + # Unless the mailbox name is entirely ASCII we'll have to use + # the Modified UTF-7 character set. + $use_utf7 = 1 unless isAscii( $srcmbx ); + $use_utf7 = 1 unless isAscii( $dstmbx ); + + $srcmbx =~ s/\//$srcDelim/g; + $dstmbx =~ s/\//$dstDelim/g; + + $$mbx_map{"$srcmbx"} = $dstmbx; + + } + close MAP; + + if ( $use_utf7 ) { + eval 'use Encode::IMAPUTF7 qw/decode/'; + if ( $@ ) { + Log("At least one mailbox map contains non-ASCII characters. This means you"); + Log("have to install the Perl Encode::IMAPUTF7 module in order to map mailbox "); + Log("names between the source and destination servers."); + print "At least one mailbox map contains non-ASCII characters. This means you\n"; + print "have to install the Perl Encode::IMAPUTF7 module in order to map mailbox\n"; + print "names between the source and destination servers.\n"; + exit; + } + } + + my %temp; + foreach $srcmbx ( keys %$mbx_map ) { + $dstmbx = $$mbx_map{"$srcmbx"}; + Log("Mapping src:$srcmbx to dst:$dstmbx"); + if ( $use_utf7 ){ + # Encode the name in Modified UTF-7 charset + $dstsrc = Encode::IMAPUTF7::encode( 'IMAP-UTF-7', $srcmbx ); + $dstmbx = Encode::IMAPUTF7::encode( 'IMAP-UTF-7', $dstmbx ); + } + $temp{"$srcmbx"} = $dstmbx; + } + %$mbx_map = %temp; + %temp = (); + +} + +sub isAscii { + +my $str = shift; +my $ascii = 1; + + # Determine whether a string contains non-ASCII characters + + my $test = $str; + $test=~s/\P{IsASCII}/?/g; + $ascii = 0 unless $test eq $str; + + return $ascii; + +} + +sub fixup_date { + +my $date = shift; + + # Make sure the hrs part of the date is 2 digits. At least + # one IMAP server expects this. + + $$date =~ s/^\s+//; + $$date =~ /(.+) (.+):(.+):(.+) (.+)/; + my $hrs = $2; + + return if length( $hrs ) == 2; + + my $newhrs = '0' . $hrs if length( $hrs ) == 1; + $$date =~ s/ $hrs/ $newhrs/; + +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +# getMsgIdList +# +# Get a list of the user's messages in a mailbox +# +sub getMsgIdList { + +my $mailbox = shift; +my $msgids = shift; +my $conn = shift; +my $empty; +my $msgnum; +my $from; + + %$msgids = (); + sendCommand ($conn, "1 EXAMINE \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + if ( $empty ) { + Log("$mailbox is empty"); + return; + } + + Log("Fetch the header info") if $debug; + + sendCommand ( $conn, "1 FETCH 1:* (body[header.fields (Date From Subject Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /Message-ID:\s*(.*)/i ) { + $msgid = $1; + # Line-wrap, get it from the next line + if ( $msgid eq '' ) { + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + if ( $response[$i] =~ /Subject:\s*(.+)/i ) { + $subject = $1; + } + + if ( $response[$i] =~ /Date:\s*(.+)/i ) { + $header_date = $1; + } + + if ( $response[$i] =~ /From:\s*(.+)/i ) { + $from = $1; + } + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) { + # End of header + + if ( $msgid eq '' ) { + # The message lacks a message-id so construct one. + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)//g; + Log("msgnum $msgnum has no msgid, built one as $msgid") if $debug; + } + + $$msgids{"$msgid"} = $msgnum; + $msgid=$msgnum=$from=$subject=$header_date=''; + } + } + +} + +sub read_response { + +my $response = shift; +my $msgs = shift; +my ($msgid,$date,$flags,$msgnum); + + # Read the response to our FETCH command and grab + # the items we want (msgnum,date,flags, and msgid). + + @$msgs = (); + for $i (0 .. $#$response) { + $seen=0; + $_ = $response[$i]; + + if ( /THROTTLE/i and $gmail ) { + # Gmail is throttling us. Sleep a bit to lower our access rate + Log("Gmail is throttling our connection. Sleeping for 30 seconds"); + sleep 30; + $throttle = 0; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE/i ) { + $response[$i] =~ /INTERNALDATE (.+) BODY/i; + $date = $1; + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + if ( $response[$i] =~ /^Message-Id:\s*(.*)/i ) { + $msgid = $1; + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = get_wrapped_msgid( \@response, $i ); + } + } + + if ( $response[$i] =~ /From:\s*(.+)/i) { + $from = $1; + } + + if ( $response[$i] =~ /Subject:\s*(.+)/i) { + $subject = $1; + } + + if ( $response[$i] =~ /Date:\s*(.+)/i) { + $header_date = $1; + } + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $_ =~ /^\)/ or ( $_ =~ /\)\)$/ ) ) { + # End of header + + if ( $msgid eq '' ) { + # The message lacks a message-id so construct one. + $header_date =~ s/\W//g; + $subject =~ s/\W//g; + $msgid = "$header_date$subject$from"; + $msgid =~ s/\s+//g; + $msgid =~ s/\+|\<|\>|\?|\*|"|'|\(|\)//g; + Log("msgnum $msgnum has no msgid, built one as $msgid") if $debug; + } + + if ( $unseen ) { + push (@$msgs,"$msgnum|$date|$flags|$msgid|$header_date") unless $flags =~ /Seen/i; + } elsif ( $seen_only ) { + push (@$msgs,"$msgnum|$date|$flags|$msgid|$header_date") if $flags =~ /Seen/i; + } else { + push (@$msgs,"$msgnum|$date|$flags|$msgid|$header_date"); + } + $msgnum=$date=$flags=$msgid=$header_date=$from=$subject=''; + } + } + +} + +sub get_supported_flags { + +my $mbx = shift; +my $conn = shift; +my $FLAGS = shift; + + # Determine which flags are supported by the mailbox + + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + last; + } elsif ( $response =~ /^\* FLAGS \((.+)\)/i ) { + %$FLAGS = (); + foreach my $flag ( split(/\s+/, $1) ) { + $flag = uc( $flag ); + $$FLAGS{$flag} = 1; + } + } + } + +} + +sub validate_flags { + +my $flags = shift; +my $valid_flags = shift; +my $newflags; + + # Remove any flags not supported by the destination mailbox + + foreach my $flag ( split(/\s+/, $flags ) ) { + $flag = uc( $flag ); + next unless $$valid_flags{$flag}; + $newflags .= "$flag "; + } + chop $newflags; + + return $newflags; + +} + +sub hash { + +my $body = shift; + + # Generate an MD5 hash of the message body + + my $md5 = md5_hex($$body); + Log(" md5 hash $md5") if $debug; + + return $md5; +} + +sub fetch_msg_body { + +my $msgnum = shift; +my $conn = shift; +my $message = shift; + + # Fetch the body of the message less the headers + + Log(" Fetching msg $msgnum...") if $debug; + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Error fetching msgnum $msgnum: $response"); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $$message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $$message .= $segment; + $cc += $n; + } + } + } + +} + +sub mailbox_names { + +my $mbxs = shift; + + # Figure out what the longest mbx name is so we + # can nicely format the running totals + + my $longest; + foreach $_ ( @$mbxs ) { + my $length = length( $_ ); + $longest = $length if $length > $longest; + } + + $longest += 2; + return $longest; + +} + +sub flags { + +my $flags = shift; +my @newflags; +my $newflags; +my %standard_flags = ( '\\Seen', 1, '\\Deleted', 1, '\\Draft', 1, + '\\Answered', 1, '\\Flagged', 1, '\\Recent', 1 ); + + # Make sure the flags list contains standard + # IMAP flags and optionally custom tags + + return unless $flags; + + $flags =~ s/\\Recent//i; + foreach $_ ( split(/\s+/, $flags) ) { + # push( @newflags, $_ ) if substr($_,0,1) eq '\\'; + if ( substr($_,0,1) eq '\\' ) { + # Should be a standard flag. Make sure it is. + $_ = lc( $_ ); + s/^\\//; + $_ = ucfirst( $_ ); + $_ = '\\' . $_; + push( @newflags, $_ ) if $standard_flags{$_}; + } + if ( $opt_T ) { + # Include user-defined flags + push( @newflags, $_ ) if substr($_,0,1) eq '$'; + } + } + + $newflags = join( ' ', @newflags ); + + $newflags =~ s/\\Deleted//ig if $opt_r; + $newflags =~ s/^\s+|\s+$//g; + + return $newflags; +} + +sub exclude_mbxs { + +my $mbxs = shift; +my @new_list; +my %exclude; +my (@regex_excludes,@final_list); + + # Do the exact matches first + if ( $excludeMbxs ) { + foreach my $exclude ( split(/,/, $excludeMbxs ) ) { + $exclude{"$exclude"} = 1; + } + foreach my $mbx ( @$mbxs ) { + next if $exclude{"$mbx"}; + push( @new_list, $mbx ); + } + @$mbxs = @new_list; + } + + # Next do the regular expressions if any + my %excludes; + @new_list = (); + if ( $excludeMbxs_regex ) { + my @regex_excludes; + foreach $_ ( split(/,/, $excludeMbxs_regex ) ) { + push( @regex_excludes, $_ ); + } + foreach my $mbx ( @$mbxs ) { + foreach $_ ( @regex_excludes ) { + if ( $mbx =~ /$_/ ) { + $excludes{"$mbx"} = 1; + } + } + } + foreach my $mbx ( @$mbxs ) { + push( @new_list, $mbx ) unless $excludes{"$mbx"}; + } + @$mbxs = @new_list; + } + + @new_list = (); + +} + +sub findMsg { + +my $msgid = shift; +my $conn = shift; +my $msgnum; + + # Search a mailbox on the server for a message by its msgid. + + Log(" Search for $msgid") if $verbose; + sendCommand ( $conn, "1 SEARCH header Message-Id \"$msgid\""); + while (1) { + readResponse ($conn); + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $msgnum) = split(/\* SEARCH /i, $response); + ($msgnum) = split(/ /, $msgnum); + } + + last if $response =~ /^1 OK|^1 NO|^1 BAD/; + last if $response =~ /complete/i; + } + + if ( $verbose ) { + Log("$msgid was not found") unless $msgnum; + } + + return $msgnum; +} + +sub deleteMsg { + +my $conn = shift; +my $msgnum = shift; +my $rc; + + # Mark a message for deletion by setting \Deleted flag + + Log(" msgnum is $msgnum") if $verbose; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked $msgid for delete") if $verbose; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $conn = shift; +my $mbx = shift; +my $status; +my $loops; +my $expunged=0; + + # Remove the messages from a mailbox + + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/ ) { + $status = 1; + last; + } + + if ( $response =~ /^1 NO|^1 BAD/i ) { + Log("Error selecting mailbox $mbx: $response"); + last; + } + if ( $loops++ > 100 ) { + Log("No response to SELECT command, skipping this mailbox"); + last; + } + } + + return unless $status; + + sendCommand ( $conn, "1 EXPUNGE"); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + + if ( $response =~ /\* (.+) EXPUNGE/ ) { + $expunged++; + } + if ( $response =~ /^1 BAD|^1 NO/i ) { + print "Error expunging messages: $response\n"; + last; + } + } + + Log(" $expunged messages purged from $mbx"); + +} + +sub exchange_workaround { + + # Because Exchange limits the number of mailboxes you can create + # during a single IMAP session we have to get a new session before + # we can continue. + + Log("Disconnecting and reconnecting to Exchange server"); + logout( $dst ); + connectToHost( $destHost, \$dst ); + + # Log back into Exchange + + if ( $destUser =~ /(.+):(.+):(.+)/ ) { + # An AUTHENTICATE = PLAIN login has been requested + Log("PLAIN login") if $debug; + return 0 unless login_plain( $destUser, $dst ); + } elsif ( $xoauth2_tokens ) { + # Passwords are XOAUTH2 tokens + login_xoauth2( $destUser, $destPwd, $dst); + } else { + # Otherwise do an ordinary login + unless ( login_ordinary( $destUser,$destPwd, $dst ) ) { + logout( $src ); + return 0; + } + } + + return; + +} + +# getDestMailboxList +# +# get a list of the user's mailboxes on the destination host +# +sub getMailboxes { + +my $MBXS = shift; +my $conn = shift; + + # Get a list of the user's mailboxes + # + + Log("Get list of user's mailboxes on the destination") if $debug; + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /\{(.+)\}$/ ) { + # The nested mailbox is on the next line + readResponse ($conn); + next; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + %$MBXS = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\{(.+)\}$/ ) { + # Domino workaround for submailbox appearing on next line + $mbx = $response[$i+1]; + } elsif ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + $$MBXS{"$mbx"} = 1; + } + +} + +sub commafy { + +my $number = shift; + + $_ = $$number; + 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; + + $$number = $_; + +} + +sub get_wrapped_msgid { + +my $response = shift; +my $i = shift; +my $msgid; + + # The Message-ID is not on the same line as the Message-ID: keyword + # Get it from the next line or lines (if it continues onto succeeding lines) + + $$response[$i+1] =~ s/^\s+//; + $msgid = $$response[$i+1]; + $msgid =~ s/\s+$//g; + + my $j = 1; + while ( 1 ) { + if ( $msgid =~ /\>$/ ) { + # We've got all of it + last; + } + $j++; + # The msgid continues onto the next line + $$response[$i+$j] =~ s/^\s+//; + $msgid .= $$response[$i+$j]; + if ( $msgid =~ /Message-ID:/i ) { + ($start,$msgid) = split(/Message-ID:/, $msgid ); + } + + last if $j > 99; + } + + return $msgid; + +} + +sub wrap_long_line { + +my $line = shift; + + # Wrap lines too long to be accepted by an IMAP server (Office365 doesn't + # seem to like very long lines). We'll wrap at 1000 characters since + # that seems to be acceptable to Office365. + + my $len1 = length( $line ); + my @output = (); + @output = ( $line =~ m/.{1000}/g ); + my $new; + $new .= "$_\r\n" foreach (@output ); + + # Pick up the trailing chars + + my $temp = $new; + $temp =~ s/\r|\n//g; + my $len2 = length( $temp ); + $new .= substr( $line, $len2, $len1-$len2); + $new .= "\r\n"; + + return $new; +} + diff --git a/S/imap_tools.V1.333/pop3toimap.pl b/S/imap_tools.V1.333/pop3toimap.pl new file mode 100755 index 0000000..9a2ee90 --- /dev/null +++ b/S/imap_tools.V1.333/pop3toimap.pl @@ -0,0 +1,1080 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/pop3toimap.pl,v 1.10 2014/10/16 01:06:22 rick Exp $ + +######################################################################## +# # +# Program Name pop3toimap.pl # +# Written by Rick Sanders # +# Date 28 April 2008 # +# # +# Description # +# # +# pop3toimap.pl is a tool for copying a user's messages from a POP3 # +# server to an IMAP4 server. pop3toimap.pl makes a POP3 connection # +# to the POP3 host and logs in with the user's name and password. # +# It makes an IMAP connection to the IMAP host and logs in with the # +# user's IMAP username and password. pop3toimap.pl then fetches # +# each message from the user's POP3 account and copies it to the # +# user's IMAP account. # +# # +# If you supply 993 for the IMAP port then the connection will be # +# made over SSL. Similarily for POP if you specify port 995. Note # +# you must have the IO::Socket::SSL Perl module installed as well # +# as openSSL. # +# # +# The usernames and passwords are supplied via a text file specified # +# by the -u argument. The format of the file of users is: # +# # +######################################################################## + +use Getopt::Std; +use Socket; +use IO::Socket; +use MIME::Base64 qw( encode_base64 decode_base64 ); + + init(); + + if ( $usersFile ) { + $imapHost = $opt_i; + $popHost = $opt_p; + getUsersList( $usersFile, \@users ); + } else { + # Single user + ($imapHost,$imapUser,$imapPwd) = split(/\//, $opt_i); + ($popHost,$popUser,$popPwd) = split(/\//, $opt_p); + push( @users, "$popUser $popPwd $imapUser $imapPwd" ); + } + ($imapHost,$imapPort) = split(/:/, $imapHost); + ($popHost,$popPort) = split(/:/, $popHost); + $imapPort = 143 unless $imapPort; + $popPort = 110 unless $popPort; + + foreach $line ( @users ) { + $line =~ s/\s+/ /g; + ($popUser,$popPwd,$imapUser,$imapPwd) = split(/ /, $line); + + # Connect to the POP server and login + connectToHost($popHost, $popPort, \$p_conn); + next unless loginPOP( $popUser, $popPwd, $p_conn ); + + # Connect to the IMAP server and login + connectToHost($imapHost, $imapPort, \$i_conn); + next unless loginIMAP( $imapUser, $imapPwd, $i_conn ); + + namespace( $i_conn, \$prefix, \$delim, $opt_x ); + + $mailbox = mailboxName( $mailbox,$prefix,$delim ); + createMbx( $mailbox, $i_conn ) unless mbxExists( $mailbox, $i_conn); + migrate( $p_conn, $i_conn ); + logoutPOP( $p_conn ); + logoutIMAP( $i_conn ); + } + + summary(); + exit; + + +# +# migrate +# +# Get a list of messages in the POP user's account, retrieve each one from +# the POP server, and insert each one into the IMAP user's account. Delete +# the message from the POP server if the "delete" flag is set. +# +sub migrate { + +my $p_conn = shift; +my $i_conn = shift; +my $copied; + + if ( $range ) { + ($lower,$upper) = split(/-/, $range); + Log("Migrating POP message numbers between $lower and $upper"); + } + + @popMsgList = getPOPMsgList( $p_conn ); + + if ( $debug ) { + Log("List the POP msgs by message number"); + foreach $msg ( @popMsgList ) { + Log("$msg"); + } + } + + $count = $#popMsgList + 1; + Log("Migrating $popUser on $popHost to $imapUser on $imapHost ($count messages)"); + + foreach $msgnum ( @popMsgList ) { + if ( $range ) { + Log("msgnum $msgnum") if $debug; + next if $msgnum < $lower; + next if $msgnum > $upper; + } + Log("Fetching POP message $msgnum") if $debug; + $msg = getPOPMsg( $msgnum, $p_conn ); + + getFlag( \$msg, \$flag ); + getDate( \$msg, \$date ); + + next if $msg eq ''; + + $mailbox = 'INBOX' unless $mailbox; + selectMbx( $mailbox, $i_conn ); + + if ( insertMsg(*msg, $mailbox, $date, $flag, $i_conn ) ) { + $copied++; + $grandTotal++; + Log("$copied messages migrated") if $copied/100 == int($copied/100); + + # Delete the message from the POP server if the delete flag is set + deletePOPMsg( $msgnum, $p_conn ) if $delete; + + } + } + + $usersMigrated++; +} + + +sub init { + + $version = "1.3"; + + getopts( "Ip:L:i:u:n:drhR:t:m:A:" ); + + $usersFile = $opt_u; + $logFile = $opt_L; + $notify = $opt_n; + $range = $opt_R; + $timeout = $opt_t; + $mailbox = $opt_m; + $admin_user = $opt_A; + $delete = 1 if $opt_r; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + + usage() if $opt_h; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + $logFile = "pop3toimap.log" unless $logFile; + if (!open(LOG, ">> $logFile")) { + print STDERR "Can't open logfile $logFile\n"; + exit; + } + select(LOG); $| = 1; + Log("pop3toimap $version starting"); + + $timeout = $opt_t; + $timeout = 45 unless $timeout; + + if ( $opt_m ) { + $mailbox = $opt_m; + } else { + $mailbox = 'INBOX'; + } + +} + +sub getUsersList { + +my $usersFile = shift; +my $users = shift; + + # Get the list of users to be migrated + # + unless ( -e $usersFile ) { + print STDERR "$usersFile does not exist\n"; + exit; + } + + if ( !open(USERS, "<$usersFile")) { + print STDERR "pop3toimap, Can't open $usersFile for input\n"; + Log("Can't open $usersFile for input"); + exit 0; + } + while () { + chomp; + next if /^\#/; + push (@$users, $_) if $_; + } + close USERS; + $totalUsers = $#users + 1; + Log("There are $totalUsers users to be migrated"); +} + +sub procArgs { + + + +} + +# Make a connection to a host + +sub connectToHost { + +my $host = shift; +my $port = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + # We know whether to use SSL for the well-known ports (143,993,110,995) but + # for any others we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 or $port == 110 ) { + # Standard non-SSL ports + return ''; + } elsif ( $port == 993 or $port == 995 ) { + # Standard SSL ports + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +# loginPOP +# +# login in at the POP host with the user's name and password +# +sub loginPOP { + +my $user = shift; +my $pwd = shift; +my $conn = shift; +my $rc; + + Log("Authenticating to POP server as $user, password $pwd") if $debug; + + sendCommand ($conn, "USER $user" ); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^-ERR/i ) { + Log("Error logging into the POP server as $popUser: $response"); + $rc = 0; + last; + } + last if $response =~ /^(.+)OK Pass required/i; + last if $response =~ /^(.+)OK /i; + } + + Log("Send the password") if $debug; + sendCommand ($conn, "PASS $pwd" ); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^-ERR/i ) { + Log("Error logging into the POP server as $popUser: $response"); + $rc = 0; + last; + } + if ( $response =~ /^\+OK/i ) { + $rc = 1; + Log("Logged in as $popUser") if $debug; + last; + } + } + + return $rc; + +} + +# loginIMAP +# +# login in to the IMAP server +# +sub loginIMAP { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + +Log("imap user $user"); +Log("pwd $pwd"); + + if ( $admin_user ) { + # An AUTHENTICATE = PLAIN login has been requested + ($authuser,$pwd) = split(/:/, $admin_user); + ($user) = split(/:/, $user); + my $status = login_plain( $user, $authuser, $pwd, $conn ); + return $status; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + $status = login_xoauth2( $user, $token, $conn ); + return $status; + } + + sendCommand ($conn, "1 LOGIN $user $pwd"); + while (1) { + readResponse ($conn); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response !~ /^\*/) { + Log ("Error logging into the IMAP server as $user: $response"); + return 0; + } + } + Log("Logged in at $imapHost as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +# +# getPOPMsgList +# +# Get a list of the messages in the POP user's account. +# +sub getPOPMsgList { + +my $conn = shift; +my @msgList; + + sendCommand ($conn, "LIST" ); + while ( 1 ) { + readResponse ($conn); + + next if $response =~ /^\+OK/i; + if ( $response =~ /^\-ERR/i ) { + Log("Error getting list of POP messages: $response"); + } + elsif ( $response eq '.' ) { + last; + } + else { + ($msgnum, $uid) = split(/ /, $response); + push(@msgList, $msgnum); + } + } + + return @msgList; +} + + +# +# getPOPMsg +# +# Fetch a message from the user's account on the POP server + +sub getPOPMsg { + +my $msgnum = shift; +my $conn = shift; +my $msg; + + sendCommand ($conn, "RETR $msgnum" ); + while ( 1 ) { + readResponse ($conn); + # Log("$response"); + + next if $response =~ /^\+OK/i; + + if ( $response =~ /^\-ERR/i ) { + Log("Error getting POP message $msg: $response"); + $msg = ''; + last; + } + elsif ( $response eq '.' ) { + last; + } + else { + $msg .= "$response\r\n"; + } + } + + return $msg; + +} + + +# +# deletePOPMsg +# +# Delete a message from the POP server + +sub deletePOPMsg { + +my $msgnum = shift; +my $conn = shift; +my $msg; + + sendCommand ($conn, "DELE $msgnum" ); + while ( 1 ) { + readResponse ($conn); + Log("$response") if $debug; + + last if $response =~ /^\+OK/i; + + if ( $response =~ /^\-ERR/i ) { + Log("Error marking POP message $msg for delete: $response"); + last; + } + } + return; + +} + + +# readResponse +# +# Read the response from the server on the designated socket. +# +sub readResponse { + +my $fd = shift; + + @response = (); + alarmSet ($timeout); + $response = <$fd>; + alarmSet (0); + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log ("<< $response") if $showIMAP; + + return $response; +} + +# +# alarmHandler +# +# This subroutine catches response timeouts and attempts to reconnect +# to the host so that processing can continue +# + +sub alarmHandler { + Log ("Timeout - no response from server after $timeout seconds"); + Log("Reconnect to server and continue"); + + connectToPOP( $popHost ); + loginPOP( $popUser, $popPwd, $p_conn ); + + connectToIMAP( $imapHost, $i_conn ); + loginIMAP( $imapUser, $imapPwd, $i_conn ); + + return; +} + + +# insertMsg +# +# This routine inserts a messages into a user's IMAP INBOX +# +sub insertMsg { + +local (*message, $mbx, $date, $flag, $conn) = @_; +local ($rsn,$lenx); + + $lenx = length($message); + $totalBytes = $totalBytes + $lenx; + $totalMsgs++; + + if ( $date ) { + ($date,$time,$offset) = split(/\s+/, $date); + ($hr,$min,$sec) = split(/:/, $time); + $hr = '0' . $hr if length($hr) == 1; + $date = "$date $hr:$min:$sec $offset"; + $cmd = "1 APPEND \"$mbx\" $flag \"$date\" \{$lenx\}"; + } else { + $cmd = "1 APPEND \"$mbx\" $flag \{$lenx\}"; + } + $cmd =~ s/\s+/ /g; + sendCommand ($conn, "$cmd"); + readResponse ($conn); + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: $response"); + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + print $conn "$message\r\n"; + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + # next; + return 0; + } + } + + return 1; +} + +# alarmSet +# +# This subroutine sets an alarm +# + +sub alarmSet { + local ($timeout) = @_; + + if ( $nt ) { + alarm $timeout; + } +} + +# Log +# +# This subroutine formats and writes a log message to STDOUT and to the +# logfile. +# +sub Log { + +my $str = shift; +my $line; + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + + print LOG "$line"; + print STDOUT "$str\n"; + + if ( !$start ) { + $start = sprintf ("%.2d-%.2d-%d %.2d:%.2d", + $mon + 1, $mday, $year + $yr, $hour, $min); + } +} + +# sendCommand +# +# This subroutine formats and sends a command on the designated +# socket +# +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + Log (">> $cmd") if $debug; +} + +# logoutIMAP +# +# log out from the IMAP host +# +sub logoutIMAP { + +my $conn = shift; + + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + + return; + +} + +# logoutPOP +# +# log out from the POP host +# +sub logoutPOP { + +my $conn = shift; + + sendCommand ($conn, "QUIT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^\+OK/i ) { + last; + } + else { + Log ("unexpected POP QUIT response: $response"); + last; + } + } + close $conn; + +} + +sub summary { + + $line = "\n Summary of POP3 -> IMAP migration\n\n"; + $line .= "Users migrated $usersMigrated\n"; + $line .= "Total messages $totalMsgs\n"; + $line .= "Total bytes $totalBytes\n"; + + Log($line); + notify($notify,$line) if $notify; +} + +sub usage { + + print "\n"; + print "pop3toimap.pl usage:\n"; + print " -p \n"; + print " -i \n"; + print " -u \n"; + print " -A \n"; + print " -d debug mode\n"; + print " -n \n"; + print " -m Default is INBOX. Format is mbx1/mbx2/mbx3\n"; + print " -r delete POP3 message after migrating to IMAP\n"; + print " -t \n"; + print " -L \n"; + print " -I show IMAP protocol exchanges\n"; + print " -h print this message\n\n"; + print "\nYou can migrate a single user with -p POPhost/user/pwd -i IMAPhost/user/pwd\n"; + print "or a list of users with -i POPhost -i IMAPhost -u .\n"; + print "The format of the input file is:\n\n"; + print " \n\n"; + + exit; +} + +# +# Send an e-mail with the results of the migration +# +sub notify { + +my $to = shift; +my $text = shift; + + Log("Notifying $to") if $debug; + + $end = sprintf ("%.2d-%.2d-%d %.2d:%.2d\n", + $mon + 1, $mday, $year + $yr, $hour, $min); + + $msgFn = "/tmp/msg.tmp.$$"; + open (MSG, ">$msgFn"); + print MSG "To: $to\n"; + print MSG "From: pop3toimap.migration\n"; + print MSG "Subject: pop3toimap migration has completed $end\n"; + print MSG "\n"; + print MSG "$line\n\n"; + print MSG "Start $start\n"; + print MSG "End $end\n"; + close MSG; + + $status = system("/usr/lib/sendmail -t < $msgFn")/256; + if ($status != 0) { + print "Error sending report to $notify: $status\n"; + } + unlink $msgFn; + +} + +sub getFlag { + +my $msg = shift; +my $flag = shift; + + # The POP3 protocol does not indicate whether a message is SEEN or + # UNSEEN so we will look in the message itself for a Status: line. + $$flag = ''; + foreach $_ ( split(/\n/, $$msg) ) { + chomp; + last unless $_; + if ( /Status/i ) { + $$flag = '(\\SEEN)' if /^Status:\s*R/i; + last; + } + } + +} + +sub getDate { + +my $msg = shift; +my $Date = shift; +my $letter; +my $newdate; + + $$Date = ''; + foreach $line ( split(/\n/, $$msg) ) { + next unless $line =~ /^Date: (.+)/i; + chomp( $date = $1 ); + $date =~ s/\n|\r//g; + ($day,$date) = split(/,\s*/, $date); + + my $changed; + for $i ( 0 .. length($date) ) { + $letter = substr($date, $i, 1); + if ( substr($date, $i, 1) eq ' ') { + $letter = "-" unless $changed > 1; + $changed++; + } + $newdate .= $letter; + } + last; + } + $newdate =~ s/EDT|EST|CDT|CST|PDT|PST|\(|\)/+0000/g; + $newdate =~ s/\s+$//; + unless ( $newdate =~ /\-(.+)\s*$/ ) { + $newdate .= " -0000"; + } + + $newdate = '' if $newdate eq " -0000"; + + $$Date = $newdate; + +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if necessary + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + Log ("Error creating $mbx: $response"); + last; + } + + } + +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; +my @response; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + push( @namespace, $response ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @namespace ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailboxName { + +my $mailbox = shift; +my $prefix = shift; +my $delim = shift; +my $substChar = '_'; + + # Apply the prefix and mailbox delimiter to the + # mailbox name + + if ( $prefix ) { + $mailbox = $prefix . $mailbox; + } + if ( $delim ) { + $mailbox =~ s/\//$delim/g; + } + + return $mailbox; + +} + +sub getDelimiter { + +my $conn = shift; +my $delimiter; + + # Issue a 'LIST "" ""' command to find out what the + # mailbox hierarchy delimiter is. + + sendCommand ($conn, '1 LIST "" ""'); + @response = ''; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) { + $delimiter = $2; + } + } + + return $delimiter; +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub selectMbx { + +my $mbx = shift; +my $conn = shift; + + # Some IMAP clients such as Outlook and Netscape) do not automatically list + # all mailboxes. The user must manually subscribe to them. This routine + # does that for the user by marking the mailbox as 'subscribed'. + + sendCommand( $conn, "1 SUBSCRIBE \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + Log("Mailbox $mbx has been subscribed") if $debug; + last; + } elsif ( $response =~ /^1 NO|^1 BAD|\^* BYE/i ) { + Log("Unexpected response to subscribe $mbx command: $response"); + last; + } + } + + # Now select the mailbox + sendCommand( $conn, "1 SELECT \"$mbx\""); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to SELECT $mbx command: $response"); + last; + } + } + +} + diff --git a/S/imap_tools.V1.333/purgeMbx.pl b/S/imap_tools.V1.333/purgeMbx.pl new file mode 100755 index 0000000..a659351 --- /dev/null +++ b/S/imap_tools.V1.333/purgeMbx.pl @@ -0,0 +1,797 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/purgeMbx.pl,v 1.7 2015/06/05 11:32:25 rick Exp $ + +############################################################################ +# Program name purgeMbx.pl # +# Written by Rick Sanders # +# Date 5/24/2008 # +# # +# Description # +# # +# This script deletes all of the messages in a user's IMAP # +# mailbox. # +# # +# purgeMbx.pl is called like this: # +# ./purgeMbx.pl -s host/user/password -m # +# # +# Note that the mailbox name is case-sensitive. # +# # +# Optional arguments: # +# -d debug # +# -L # +############################################################################ + +############################################################################ +# Copyright (c) 2008 Rick Sanders # +# # +# Permission to use, copy, modify, and distribute this software for any # +# purpose with or without fee is hereby granted, provided that the above # +# copyright notice and this permission notice appear in all copies. # +# # +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # +############################################################################ + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use IO::Socket; +use MIME::Base64 qw(encode_base64 decode_base64 ); + +################################################################# +# Main program. # +################################################################# + +init(); + +sigprc(); + +# Get list of all messages on the source host by Message-Id +# +connectToHost($host, \$conn); +login($user,$pwd, $conn) or exit; + +if ( $mbx eq '*' ) { + @mailboxes = listMailboxes( '*', $conn); +} else { + push( @mailboxes, $mbx ); +} + +foreach $mbx ( @mailboxes ) { + Log("Purging the \"$mbx\" mailbox"); + @sourceMsgs = (); + getMsgList( $mbx, \@msgs, $conn ); + Log("$mbx mailbox is empty") unless @msgs; + foreach $msgnum ( @msgs ) { + $total++; + deleteMsg( $msgnum, $conn ); + } + expungeMbx( $mbx, $conn ) if @msgs; + + Log("$total messages were deleted from \"$mbx\" mailbox"); +} + +logout( $conn ); + +exit; + + +sub init { + + $version = 'V1.0.1'; + $os = $ENV{'OS'}; + + processArgs(); + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + $timeout = 60 unless $timeout; + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("\n$0 starting"); + $total=0; + +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } + print STDOUT "$str\n"; + +} + +# Make a connection to an IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + ($admin_user,$admin_pwd) = split(/:/, $admin_user); + login_plain( $user, $admin_user, $admin_pwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + sendCommand ($conn, "1 LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + if ($response =~ /1 OK/i) { + last; + } + if ($response =~ /^(.+) NO|^(.+) BAD/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + ++$lsn; + undef @response; + sendCommand ($conn, "$lsn LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^$lsn OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + + +# getMsgList +# +# Get a list of messages in a mailbox +# +sub getMsgList { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; +my $from; +my $flags; + + trim( *mailbox ); + sendCommand ($conn, "1 SELECT \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + last if $response =~ /^1 NO|^1 BAD/; + } + + @msgs = (); + $flags = ''; + for $i (0 .. $#response) { + last if $response[$i] =~ /^1 OK FETCH complete/i; + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $flags =~ s/\\Recent//; + } + + if ( $response[$i] =~ /INTERNALDATE/) { + $response[$i] =~ /INTERNALDATE (.+) BODY/; + # $response[$i] =~ /INTERNALDATE "(.+)" BODY/; + $date = $1; + + $date =~ /"(.+)"/; + $date = $1; + $date =~ s/"//g; + } + + # if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) { + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ( $msgnum && $date ) { + push (@$msgs, $msgnum); + $msgnum = $date = ''; + } + } + + +} + +sub fetchMsg { + +my $msgnum = shift; +my $mbx = shift; +my $conn = shift; +my $message; + + Log(" Fetching msg $msgnum...") if $debug; + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /1 OK/i ); + } + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " purgeMbx.pl -S host/user/pwd -m \n"; + print STDOUT " Optional arguments:\n"; + print STDOUT " -d debug\n"; + print STDOUT " -L \n"; + print STDOUT " -A \n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dIs:L:m:hA:" ) ) { + usage(); + } + + ($host,$user,$pwd) = split(/\//, $opt_s); + + $mbx = $opt_m; + $admin_user = $opt_A; + $logfile = $opt_L; + $debug = $showIMAP = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + usage() if $opt_h; + +} + +sub deleteMsg { + +my $msgnum = shift; +my $conn = shift; +my $rc; + + sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $rc = 1; + Log(" Marked msg number $msgnum for delete") if $debug; + last; + } + + if ( $response =~ /^1 BAD|^1 NO/i ) { + Log("Error setting \Deleted flag for msg $msgnum: $response"); + $rc = 0; + last; + } + } + + return $rc; + +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; + + print STDOUT "Purging mailbox $mbx..." if $debug; + + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /1 OK/i ); + } + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + print STDOUT "Error purging messages: $response\n"; + last; + } + } + + $totalExpunged += $expunged; + + # print STDOUT "$expunged messages purged\n" if $debug; + +} + +sub dieright { + local($sig) = @_; + print STDOUT "caught signal $sig\n"; + logout( $conn ); + exit(-1); +} + +sub sigprc { + + $SIG{'HUP'} = 'dieright'; + $SIG{'INT'} = 'dieright'; + $SIG{'QUIT'} = 'dieright'; + $SIG{'ILL'} = 'dieright'; + $SIG{'TRAP'} = 'dieright'; + $SIG{'IOT'} = 'dieright'; + $SIG{'EMT'} = 'dieright'; + $SIG{'FPE'} = 'dieright'; + $SIG{'BUS'} = 'dieright'; + $SIG{'SEGV'} = 'dieright'; + $SIG{'SYS'} = 'dieright'; + $SIG{'PIPE'} = 'dieright'; + $SIG{'ALRM'} = 'dieright'; + $SIG{'TERM'} = 'dieright'; + $SIG{'URG'} = 'dieright'; +} + +# getMailboxList +# +# get a list of the user's mailboxes +# +sub getMailboxList { + +my $conn = shift; +my @mbxs; +my $mbx; + + # Get a list of the user's mailboxes + # + Log("Get list of user's mailboxes") if $debug; + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + undef @mbxs; + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + ($dmy,$mbx) = split(/"\/"/,$response[$i]); + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + $mbx =~ s/"//g; + + if ($response[$i] =~ /NOSELECT/i) { + if ($debugMode) { Log("$mbx is set NOSELECT,skip it",2); } + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + +# listMailboxes +# +# Get a list of the user's mailboxes +# +sub listMailboxes { + +my $mbx = shift; +my $conn = shift; +my @mbxs; + + sendCommand ($conn, "1 LIST \"\" \"$mbx\""); + undef @response; + while ( 1 ) { + &readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + &Log ("unexpected response: $response"); + return 0; + } + } + + @mbxs = (); + for $i (0 .. $#response) { + $response[$i] =~ s/\s+/ /; + if ( $response[$i] =~ /"$/ ) { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i; + $mbx = $3; + } elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) { + $mbx = $2; + } else { + $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i; + $mbx = $3; + } + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + return @mbxs; +} + diff --git a/S/imap_tools.V1.333/release_notes_1.291.txt b/S/imap_tools.V1.333/release_notes_1.291.txt new file mode 100644 index 0000000..a3a7c17 --- /dev/null +++ b/S/imap_tools.V1.333/release_notes_1.291.txt @@ -0,0 +1,76 @@ +Release notes for IMAP-Tools version 1.291. +Changes since 2014/06/12: + +dumptoIMAP.pl 1.12 2014/06/21 + Fix handling of delimter and prefix when server does not supply NAMESPACE via -y argument. + +dumptoIMAP.pl 1.11 2014/06/20 + Fix problem in get_mbx_list caused by the path not being as expected and causing the filespec to not have a leading '/' + +imap_audit.pl 1.6 2014/07/24 + Added support for "before date" and "after date" audits. Also added building of "dummy" msgids for messages lacking them. + +imapcopy.pl 1.138 2014/07/21 + Added -O argument to tell imapcopy that both servers are Dovecot using the brain-dead mbox format where mailboxes can have messages or submailboxes but not both. + +imapcopy.pl 1.136 2014/07/21 + Added -o to permit all messages to be copied to a single "archive" mailbox on the destination (and not to the regular mailboxes.) + Prompt the user for source/dest user password if the password = PROMPT + +imapcopy.pl 1.129 2014/07/02 + When building dummy msgids use the Date in the header rather than the INTERNALDATE. It seems that a server may adjust the internaldate according to its timezone. + +imapcopy.pl 1.128 2014/07/02 + Tweak detection of message size because gmail doesn't send it the way most servers do. + +imapcopy.pl 1.127 2014/06/27 + Two changes: If a message does not have a Message-ID then build one for it from the Sender, Subject, and INTERNALDATE fields. So the same for the source and destination servers. If -l is set (dont_copy_source_dups) then duplicates on the source will not be copied. + +imapcopy.pl 1.126 2014/06/16 + Add a 'special date' search function for a customer whose SEARCH command seems to be unreliable. This routine manually compares the INTERNALDATES with the value of -J 'SINCE|BEFORE ' argument. + +imapcopy.pl 1.125 2014/06/13 + Notify msg to dest user with Subject of messages excluded because they exceed the maximum size argument + +imapcopy.pl 1.123 2014/06/13 + Removed 'from the dest' from sub expunge() since the -r option can be used to purge messages on the source that have been copied. + +imapsync.pl 1.62 2014/07/19 + Add support for backslash as delimiter for -S and -D host/user/pwd + +imapsync.pl 1.60 2014/07/05 + Fix the getDatedMsg subroutine for built msgids. + +imapsync.pl 1.58 2014/07/05 + Include the subject in the constructed msgid. + +imapsync.pl 1.56 2014/07/05 + Build msgid from date,subject,sender if msgid is missing. + +migrateIMAP.pl 1.54 2014/07/11 + Use from+header_date+subject for msgid if message lacks one. + +pop3toimap.pl 1.8 2014/07/06 + Fix problem reading users file on Windows (last character was chopped off). + +thunderbird_to_imap.pl 1.12 2014/07/09 + Added a range selector to deal with out-of-memory errors + +thunderbird_to_imap.pl 1.11 2014/07/09 + Fix the way Tbird status codes are interpreted + +thunderbird_to_imap.pl 1.10 2014/07/07 + Fixed problem with CRLF on some Windows boxes, added complete set of Thunderbird Mozilla status flags. + +thunderbird_to_imap.pl 1.9 2014/07/01 + Don't print 'running in update mode' unless -U is set. + +thunderbird_to_imap.pl 1.8 2014/07/01 + Tweak the end-of-message check because some Thunderbird folders have just "From " instead of "From xxxxxxxx" + +thunderbird_to_imap.pl 1.6 2014/06/29 + Enhance the date-formatting code. + +thunderbird_to_imap.pl 1.5 2014/06/28 + Fix opt_x which was used for two purposes; add opt_X (CRLF control) in its place. + diff --git a/S/imap_tools.V1.333/release_notes_1.298.txt b/S/imap_tools.V1.333/release_notes_1.298.txt new file mode 100644 index 0000000..e5ccdf2 --- /dev/null +++ b/S/imap_tools.V1.333/release_notes_1.298.txt @@ -0,0 +1,30 @@ +Release notes for IMAP-Tools version 1.298. +Changes since 2014/07/25: + +The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes + +imap_audit.pl 1.15 2014/08/25 + Added -n argument to compare only the message counts on src and dest. + Add more loop detection code + Open mbxs in RO mode + +imap_audit.pl 1.12 2014/07/27 + Strip off timezone offset when building dummy msgid + +imap_audit.pl 1.11 2014/07/26 + Added -g argument to force use of dummy msgids for all messages + +imap_audit.pl 1.10 2014/07/26 + If Message-ID line is wrapped get it from following line + +imapcopy.cgi 1.9 2014/08/18 + Make the 'Cannot redirect to STDERR' error message more informative. + +imapfilter.pl 1.46 2014/09/01 + Fixed 'test' mode counters. + Add support for numeric date offsets instead of fixed dates in ISEARCH rules + Fix issue with chunking of messages. Add -X argument for emptying the Trash folder at the end of the run. + +imapsync.pl 1.63 2014/08/26 + Added -t (dry run) feature. + diff --git a/S/imap_tools.V1.333/release_notes_1.300.txt b/S/imap_tools.V1.333/release_notes_1.300.txt new file mode 100644 index 0000000..b5680e6 --- /dev/null +++ b/S/imap_tools.V1.333/release_notes_1.300.txt @@ -0,0 +1,95 @@ +Release notes for IMAP-Tools version 1.300. +Changes since 2014/09/03: + +The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes + +IMAPtoMbox.pl 1.11 2014/10/15 + Added support for oauth2 logins + +MboxtoIMAP.pl 1.21 2014/10/15 + Add 'use decode_base64' for OAUTH2 login error message + +MboxtoIMAP.pl 1.20 2014/10/15 + Added support for OAUTH2 logins + +delIMAPdups.pl 1.26 2014/10/15 + Added support for oauth2 logins + +delete_imap_mailboxes.pl 1.7 2014/10/17 + Mark INBOX messages for delete with single 1:* command instead of individually + +delete_imap_mailboxes.pl 1.6 2014/10/15 + Added support for oauth2 logins + +delete_imap_mailboxes.pl 1.5 2014/10/15 + Drop -i argument for purging the INBOX and make it automatic. + +delete_imap_mailboxes.pl 1.4 2014/10/14 + Added -i argument to purge the inbox. + +dumptoIMAP.pl 1.13 2014/10/15 + Added support for oauth2 logins + +imapCapability.pl 1.9 2014/10/15 + Added support for oauth2 logins + +imap_audit.pl 1.16 2014/10/15 + Added support for oauth2 logins + +imap_search.pl 1.3 2014/10/17 + Added support for oauth2 logins + +imap_to_maildir.pl 1.5 2014/10/15 + Added support for oauth2 logins + +imapcopy.pl 1.141 2014/10/14 + Added support for Gmail oauth2 tokens. + +imapcopy.pl 1.140 2014/10/09 + Openwave the source mailbox in EXAMINE mode since a few servers otherwise mark the messages as SEEN. + +imapdump.pl 1.29 2014/10/15 + Added support for oauth2 logins + +imapdump.pl 1.28 2014/09/06 + Improve logging in debug mode + +imapfilter.pl 1.47 2014/10/14 + Added support for oauth2 tokens + +imapsync.pl 1.65 2014/10/15 + Added support for OAUTH2 logins + +imapsync.pl 1.64 2014/09/05 + Added source_archive feature that moves messages from a source mailbox in an archive mailbox, also on the source. + +list_account_sizes.pl 1.9 2014/10/15 + Added support for oauth2 logins + +list_imap_folders.pl 1.15 2014/10/15 + Added support for oauth2 logins + +maildir_to_imap.pl 1.7 2014/10/15 + Added support for oauth2 logins + +mbxIMAPsync.pl 1.1 2014/10/16 + Added support for oauth2 logins + +mbxIMAPsync.pl 1.2 2014/10/16 + Added support for oauth2 logins + +migrateIMAP.pl 1.55 2014/10/16 + Added support for oauth2 logins + +pop3toimap.pl 1.10 2014/10/16 + Added support for oauth2 logins + +purgeMbx.pl 1.5 2014/10/16 + Added support for oauth2 logins + +thunderbird_to_imap.pl 1.13 2014/10/16 + Added support for oauth2 logins + +trash.pl 1.5 2014/10/16 + Added support for oauth2 logins + diff --git a/S/imap_tools.V1.333/release_notes_1.303.txt b/S/imap_tools.V1.333/release_notes_1.303.txt new file mode 100644 index 0000000..e667f8d --- /dev/null +++ b/S/imap_tools.V1.333/release_notes_1.303.txt @@ -0,0 +1,30 @@ +Release notes for IMAP-Tools version 1.303. +Changes since 20141017: + +The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes + +dumptoIMAP.pl 1.14 2014/11/10 + Correct -S host/user/pwd to -i host/user/pwd in the notes at the top of the script. + +imapcopy.pl 1.143 2014/11/18 + Added -V argument to handle the response from Zimbra 6.0.16 which is not sending a closing ')' line in its response to the FETCH header items. Instead of ')' imapcopy considers ' FLAGS xxxxx' as the end of the FETCHED data. + +imapcopy.pl 1.142 2014/11/06 + Removed 'server unvailable' error trap so that if that phrase appears in the text of a message it won't trigger a reconnect() action. + +list_imap_folders.pl 1.18 2014/11/18 + Added ability to process list of users, added message subject to large message report. + +list_imap_folders.pl 1.17 2014/11/18 + Added 'subject' field to large message report and fixed the -U argument. + +list_imap_folders.pl 1.16 2014/11/15 + Add support for UWash-imap style mailboxes (MH) + +maildir_to_imap.pl 1.9 2014/10/31 + Added -M argument so the user can change the name of the IMAP mailbox to be different than the maildir folder name. + +maildir_to_imap.pl 1.8 2014/10/30 + Require call to ctime() which is not needed. + + diff --git a/S/imap_tools.V1.333/release_notes_1.313.txt b/S/imap_tools.V1.333/release_notes_1.313.txt new file mode 100644 index 0000000..3060878 --- /dev/null +++ b/S/imap_tools.V1.333/release_notes_1.313.txt @@ -0,0 +1,47 @@ +Release notes for IMAP-Tools version 1.313. +Changes since 2014/12/09: + +The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes + +IMAPtoMbox.pl 1.12 2015/02/02 + Fixed IMAP FETCH parsing + +delIMAPdups.pl 1.28 2015/01/29 + Added -r argument for message range to check, eg -r 1:1000 + +delIMAPdups.pl.files 1.2 2015/01/30 + -p argument was not being honored. + +imap_audit.pl 1.18 2015/02/02 + Fixed problem with IMAP FETCH parsing + +imap_audit.pl 1.17 2015/01/31 + Increase max loop counter + +imap_search.pl 1.4 2015/02/02 + Fixed IMAP FETCH parsing + +imapcopy.pl 1.146 2015/02/01 + Fixed FETCH parsing bug exposed by new Zimbra version. + +imapcopy.pl 1.145 2015/01/22 + Add a "skip message-id" option using imapcopy.skip to hold msgs to be skipped + +imapdump.pl 1.34 2015/02/02 + Fixed IMAP FETCH parsing + +imapfilter.pl 1.48 2015/01/23 + Added -T feature which processes a mailbox and its subfolders only. + +imapsync.pl 1.66 2015/02/02 + Fetch problem with IMAP FETCH parsing + +migrateIMAP.pl 1.58 2015/02/01 + Fixed FETCH parser bug + +migrateIMAP.pl 1.57 2015/01/27 + Skip the [Gmail]/All Mail folder + +migrateIMAP.pl 1.56 2015/01/21 + Detect a * BYE response from the server when fetching messages headers and exit. + diff --git a/S/imap_tools.V1.333/release_notes_1.326.txt b/S/imap_tools.V1.333/release_notes_1.326.txt new file mode 100644 index 0000000..655c85d --- /dev/null +++ b/S/imap_tools.V1.333/release_notes_1.326.txt @@ -0,0 +1,116 @@ +Release notes for IMAP-Tools version 1.326. +Changes since 2015/02/03: + +The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes + +IMAPtoMbox.pl 1.13 2015/04/30 + The From address was missing from the first line in the message in the mbox file. + +delIMAPdups.pl 1.30 2015/03/07 + sub getDelimiter was missing + +delIMAPdups.pl 1.29 2015/03/07 + Fixed truncated line in code. + +delIMAPdups.pl.files 1.3 2015/02/04 + Added -g (global) option + +email_archive.pl 1.6 2015/02/21 + Clean up code for production release + +email_attachment_cleaner.pl 1.6 2015/03/04 + Add option to save attachments but not strip them. Add option to specify list of attachments types. + +email_attachment_cleaner.pl 1.5 2015/03/03 + Fix counter bug + +email_attachment_cleaner.pl 1.4 2015/03/03 + Call validate_date() after get_date() + +email_attachment_cleaner.pl 1.3 2015/03/03 + Fixes for test mode + +email_attachment_cleaner.pl 1.2 2015/03/02 + Added some error checking + +email_restore.cgi 1.1 2015/03/01 + Initial version ============================================================================= + +email_restore.cgi 1.4 2015/02/21 + Clean up code for production release + +imap_audit.pl 1.20 2015/04/03 + Fix for multi-line Message-ID in message header + +imap_audit.pl 1.19 2015/02/06 + Fixed a bug in the auth plain login routine + +imap_cleaner.pl 1.5 2015/02/27 + Add -O option to save attachments in the specified directory + +imap_cleaner.pl 1.4 2015/02/27 + Added -u and -p arguments for username and password. Removed list option. + +imap_cleaner.pl 1.3 2015/02/27 + Added -U argument + +imap_cleaner.pl 1.2 2015/02/25 + Comment out date fixup code (not needed). Added test option + +imapcopy.pl 1.157 2015/05/22 + Enhance reconnect() mode. + +imapcopy.pl 1.156 2015/05/19 + Workaround to rename mailboxes with INBOX. prefix that shouldn't be there on the destination. + +imapcopy.pl 1.155 2015/04/26 + Set the $exchange flag in AUTH PLAIN login mode if the destination is an Exchange server + +imapcopy.pl 1.154 2015/04/24 + Tweak the mailbox mapping rules for the case where the source delimiter is an '_' character. + +imapcopy.pl 1.153 2015/04/22 + Nested folders on destination not created correctly when source delimiter is a backslash character + +imapcopy.pl 1.152 2015/04/18 + Added some additional error handling for Exchange-related errors + +imapcopy.pl 1.151 2015/04/11 + Don't skip mailboxes starting with a dot. + +imapcopy.pl 1.150 2015/04/03 + Added fix for multi-line Message-IDs to dated message search routine. + +imapcopy.pl 1.149 2015/04/03 + Fix for multi-line Message-ID line in the header in update mode. + +imapcopy.pl 1.148 2015/04/01 + Don't let a child process try to launch another child process in Parallel mode. + +imapcopy.pl 1.147 2015/03/21 + Make -R argument apply to exclude-mailboxes as well as include-mailboxes + +imapdump.pl 1.36 2015/03/05 + Added option to include all flags (not just S = seen) in the dumped filename. Also option to include custom flags, not just standard IMAP flags. And option to update the flags when they change on the server. + +imapdump.pl 1.35 2015/03/04 + Build dummy msgid if the message lacks one. + +imapsync.pl 1.67 2015/04/03 + Fix for multi-line msgids in message header + +list_imap_folders.pl 1.25 2015/02/16 + Put a space between "fields" and "(Subject)" in body.peek command. The Rocklife MailSite IMAP server wants it that way. + +migrateIMAP.pl 1.60 2015/05/20 + Handle the way that Domino responds to LIST command for nested mailboxes + +migrateIMAP.pl 1.59 2015/04/05 + Fix for multi-line message-id + +reload_archived_msgs.pl 1.1 2015/02/21 + Initial release ============================================================================= + +thunderbird_to_imap.pl 1.14 2015/03/15 + Use eval to protect against substr errors + diff --git a/S/imap_tools.V1.333/release_notes_V1.309.txt b/S/imap_tools.V1.333/release_notes_V1.309.txt new file mode 100644 index 0000000..5cedfc6 --- /dev/null +++ b/S/imap_tools.V1.333/release_notes_V1.309.txt @@ -0,0 +1,14 @@ +Release notes for IMAP-Tools version V1.309. +Changes since 2014/11/19: + +The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes + +delIMAPdups.pl 1.27 2014/11/22 + Accept either a space or colon as separator in users file. + +imapdump.pl 1.31 2014/12/07 + Added parallel mode, multi-user mode, and extract-attachments-as-separate files option. + +list_imap_folders.pl 1.24 2014/11/22 + When writing large message report don't call UTF-7 mailboxname conversion if the server doesn't have Perl support for it. + diff --git a/S/imap_tools.V1.333/thunderbird_to_imap.pl b/S/imap_tools.V1.333/thunderbird_to_imap.pl new file mode 100755 index 0000000..b6f5273 --- /dev/null +++ b/S/imap_tools.V1.333/thunderbird_to_imap.pl @@ -0,0 +1,1138 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/thunderbird_to_imap.pl,v 1.14 2015/03/15 23:57:02 rick Exp $ + +use Socket; +use FileHandle; +use File::Find; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw(encode_base64 decode_base64 ); + +###################################################################### +# Program name thunderbird_to_imap.pl # +# Written by Rick Sanders # +# Date 15 July 2013 # +# # +# Description # +# # +# thunderbird_to_imap.pl is used to copy Thunderbird messages # +# to an IMAP server. The script parses the Thunderbird folders # +# into separate messages which are inserted into IMAP mailboxes # +# with same name on the IMAP server (creating the mailboxes if # +# they do not already exist). # +# # +# Usage: thunderbird_to_imap.pl -i host/username/password # +# -m # +# # +# See the Usage() for optional arguments # +# # +###################################################################### + +init(); +connectToHost($imapHost, \$conn); +login($imapUser,$imapPwd, $conn ); +namespace( $conn, \$prefix, \$delim, $opt_x ); + +push( @dirs, $mbxroot ); +find( \&getMailboxes, @dirs ); # Returns @mbxs + +if ( $mbx_list ) { + Log("mbx_list $mbx_list"); + foreach $_ ( split(/,/, $mbx_list ) ) { + $MBXS{"$_"} = 1; + } +} + +foreach $mbxfn ( @mbxs ) { + ## $count = count_msgs( $mbxfn ); + + # Build the IMAP mailbox name + $imapmbx = $mbxfn; + $imapmbx =~ s/$mbxroot//; + $imapmbx =~ s/\.sbd//g; + $imapmbx =~ s/^\///; + + if ( %MBXS ) { + next unless $MBXS{"$imapmbx"}; + } + + next if $EXCLUDE_MBXS{"$imapmbx"}; # Skip these ones + + $imapmbx = mailbox_name( $imapmbx, $prefix, $delim ); + encode_ampersand( \$imapmbx); + + $mbxs++; + createMbx( $imapmbx, $conn ) unless mbxExists( $imapmbx, $conn ); + + if ( $update ) { + Log("Get msgids on the destination") if $debug; + getMsgIdList( $imapmbx, \%MSGIDS, $conn ); + } + + Log("Copying $imapmbx folder"); + $copied = load_folder_into_imap( $mbxfn, $imapmbx, \%MSGIDS, $conn ); + $total_copied += $copied; +} +Log("Done"); +logout( $conn ); + +Log("\n\nSummary:\n"); +Log(" Mailboxes copied $mbxs"); +Log(" Msgs copied $total_copied"); +Log("Done"); +exit; + + +sub init { + + if ( !getopts('m:M:L:i:dIUE:A:F:x:XcR:') ) { + usage(); + } + + ($sec,$min,$hour,$mday,$mon,$this_year,$wday,$yday,$isdst) = localtime (time); + $this_year += 1900; + + $mbxroot = $opt_m; + $mbx_list = $opt_M; + $logfile = $opt_L; + $exclude = $opt_E; + $range = $opt_R; + $debug = 1 if $opt_d; + $showIMAP = 1 if $opt_I; + $update = 1 if $opt_U; + $crlf = 1 if $opt_c; + $admin_user = $opt_A; + $msgs_per_folder = $opt_F; + ($imapHost,$imapUser,$imapPwd) = split(/\//, $opt_i); + + if ( $logfile ) { + if ( ! open (LOG, ">> $logfile") ) { + print "Can't open logfile $logfile: $!\n"; + $logfile = ''; + } + } + Log("Starting"); + Log("Running in update mode") if $update; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } + + $os = $ENV{'OS'}; + $os = '' if $crlf; # Use Unix/Linx crlf handling + + foreach $_ ( split(/,/, $exclude ) ) { + $EXCLUDE_MBXS{"$_"} = 1; + } + + thunderbird_flags(); + +} + +sub usage { + + print "Usage: ThunderbirdToIMAP.pl\n"; + print " -m \n"; + print " -i \n"; + print " [-E folder1.folder2, etc if want to not copy them]\n"; + print " [-M folder1,folder2, etc if want to copy just certain folders]\n"; + print " [-U update mode, don't copy duplicates]\n"; + print " -R range of message numbers to copy\n"; + print " [-L ]\n"; + print " [-d debug]\n"; + print " [-I log IMAP protocol exchanges]\n"; + +} + +sub Log { + +my $line = shift; +my $msg; + + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time); + $year += 1900; + $msg = sprintf ("%.2d-%.2d-%.4d.%.2d:%.2d:%.2d %s", + $mon + 1, $mday, $year, $hour, $min, $sec, $line); + if ( $logfile ) { + print LOG "$msg\n"; + } + print STDOUT "$line\n"; + + +} + +# connectToHost +# +# Make an IMAP connection to a host +# +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + + # We know whether to use SSL for the well-known ports (143,993,110,995) but + # for any others we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + warn("Error connecting to $host: $error"); + exit; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + warn "Error connecting to $host:$port: $@"; + exit; + } + } + Log("Connected to $host on port $port"); + +} + +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $admin_user ) { + ($admin_user,$admin_pwd) = split(/:/, $admin_user); + login_plain( $user, $admin_user, $admin_pwd, $conn ) or exit; + return 1; + } + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + login_xoauth2( $user, $token, $conn ); + return 1; + } + + # Log("Logging in as $user") if $debug; + $rsn = 1; + sendCommand ($conn, "$rsn LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + if ($response =~ /^$rsn OK/i) { + last; + } + elsif ($response =~ /NO/) { + Log ("unexpected LOGIN response: $response"); + exit; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + # sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN" ); + + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /\+/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + + if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) { + # The destination is an Exchange server + $exchange = 1; + Log("The destination is an Exchange server"); + } + + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + exit; + } + $last if $loops++ > 5; + } + + return 1; + +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse { + +my $fd = shift; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + Log(">>$response") if $showIMAP; +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand { + +my $fd = shift; +my $cmd = shift; + + print $fd "$cmd\r\n"; + Log(">>$cmd") if $showIMAP; +} + +# +# insertMsg +# +# Append a message to an IMAP mailbox +# + +sub insertMsg { + +my $mbx = shift; +my $message = shift; +my $flags = shift; +my $date = shift; +my $conn = shift; +my ($lsn,$lenx); + + # Log(" Inserting message") if $debug; + $lenx = length($$message); + return if $lenx == 0; + + if ( $date ) { + $header_date = $date; + fix_date( \$date ); + } + + $flags =~ s/\\Recent//i; + + if ( $date ) { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}"); + } else { + sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \{$lenx\}"); + } + readResponse ($conn); + if ( $response !~ /^\+/ ) { + Log ("unexpected APPEND response: $response"); + if( $response =~ /invalid(.+)date/i ) { + Log("date $header_date"); + return "INVALID_DATE"; + } + push(@errors,"Error appending message to $mbx for $user"); + return 0; + } + + # print $conn "$$message\r\n"; + + if ( $opt_X ) { + print $conn "$$message\n"; + } else { + print $conn "$$message\r\n"; + } + + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected APPEND response: $response"); + return 0; + } + } + + return 1; +} + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + +# +# getMailboxes +# +# Get a list of the folders and populate @mbxs with the +# mailbox filepath +# + +sub getMailboxes { + +my $fn; + + return if not -f; + $fn = $File::Find::name; + + unless ( $fn =~ /\.sbd$|\.msf|\.dat|\.html/ ) { + push( @mbxs, $fn ); + } + +} + +sub fix_date { + +my $date = shift; + + # Try to make the date acceptable to IMAP + + return if $$date eq ''; + $$date =~ s/\s+/ /g; + if ( $$date =~ /^(.+),/ ) { + ($dmy,$$date) = split(/,/,$$date,2 ); + } + $$date =~ s/,//g; + $$date =~ s/^\s+//; + $$date =~ s/\s/-/; + $$date =~ s/\s/-/; + $$date =~ s/"//g; + + # Some dates don't pad the number of characters in the hr:min:sec part to 2 digits + + my @terms = split(/\s+|-/, $$date); + foreach $term ( @terms ) { + if ( ($term !~ /(.+):(.+):(.+)/) and ($term !~ /(.+):(.+)/) ) { + next; + } + # next unless $term =~ /(.+):(.+):(.+) and $term =~ /(.+):(.+)/; + + my ($hr,$min,$sec); + $hr = $1; $min = $2; $sec = $3; + $sec = '00' if $sec eq ''; + $hr = '0' . $hr if length($hr) == 1; + $min = '0' . $min if length($min) == 1; + $sec = '0' . $sec if length($sec) == 1; + my $ts = "$hr:$min:$sec"; + $$date =~ s/$term/$ts/; + last; + } + + $$date =~ s/\./:/g; + + my ($dom) = split(/-/, $$date); + if ( length( $dom ) == 1 ) { + $$date = '0' . $$date; + } + + # Make sure there is a space between the date, timestamp, and offsest + $str = $$date; + eval '$_ = substr $str, 11, 1'; + eval 'substr $str, 11, 1, " "'; + + eval '$_ = substr $str, 20, 1'; + eval 'substr $str, 20, 1, " "'; + $$date = $str; + + # Strip off (GMT), (PST), etc + + my @terms = split(/\s+/, $$date ); + $terms[2] = '+0000' if $terms[2] !~ /^\+|^\-/; + $$date = "$terms[0] $terms[1] $terms[2]"; + + # Remote some extraneous terms that can cause problems for + # certain IMAP servers + + $$date =~ s/-GM|PST|GMT|UTC//g; + $$date =~ s/\s+$//; + + validate_date( $date ); + +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if necessary + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + Log ("Error creating $mbx: $response"); + last; + } + + } + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 or $port == 110 ) { + # Standard non-SSL ports + return ''; + } elsif ( $port == 993 or $port == 995 ) { + # Standard SSL ports + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +sub namespace { + +my $conn = shift; +my $prefix = shift; +my $delimiter = shift; +my $mbx_delim = shift; + + # Query the server with NAMESPACE so we can determine its + # mailbox prefix (if any) and hierachy delimiter. + + if ( $mbx_delim ) { + # The user has supplied a mbx delimiter and optionally a prefix. + Log("Using user-supplied mailbox hierarchy delimiter $mbx_delim"); + ($$delimiter,$$prefix) = split(/\s+/, $mbx_delim); + return; + } + + @response = (); + sendCommand( $conn, "1 NAMESPACE"); + while ( 1 ) { + readResponse( $conn ); + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) { + Log("Unexpected response to NAMESPACE command: $response"); + last; + } + } + + foreach $_ ( @response ) { + if ( /NAMESPACE/i ) { + my $i = index( $_, '((' ); + my $j = index( $_, '))' ); + my $val = substr($_,$i+2,$j-$i-3); + ($val) = split(/\)/, $val); + ($$prefix,$$delimiter) = split( / /, $val ); + $$prefix =~ s/"//g; + $$delimiter =~ s/"//g; + + # Experimental + if ( $public_mbxs ) { + # Figure out the public mailbox settings + /\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/; + $public = $3; + $public =~ /"(.+)"\s+"(.+)"/; + $src_public_prefix = $1 if $conn eq $src; + $src_public_delim = $2 if $conn eq $src; + $dst_public_prefix = $1 if $conn eq $dst; + $dst_public_delim = $2 if $conn eq $dst; + } + last; + } + last if /^1 NO|^1 BAD|^\* BYE/; + } + + unless ( $$delimiter ) { + # NAMESPACE command is not supported by the server + # so we will have to figure it out another way. + $delim = getDelimiter( $conn ); + $$delimiter = $delim; + $$prefix = ''; + } + + if ( $debug ) { + Log("prefix >$$prefix<"); + Log("delim >$$delimiter<"); + } +} + +sub mailbox_name { + +my $mbx = shift; +my $prefix = shift; +my $delim = shift; + + # Adjust the IMAP mailbox name using the prefix (if any) and the + # mailbox delimiter. + + if ( $delim ne '/' ) { + # Need to substitute the dst's hierarchy delimiter for the '/' character + $srcDelim = '\\' . $srcDelim if $srcDelim eq '.'; + $mbx =~ s#/#$delim#g; + $mbx =~ s/\\//g; + } + if ( $prefix ) { + # The IMAP server uses a mailbox prefix so insert it + $mbx = "$prefix$mbx" unless uc($mbx) eq 'INBOX'; + } + return $mbx; +} + +sub load_folder_into_imap { + +my $file = shift; +my $mailbox = shift; +my $MSGIDS = shift; +my $conn = shift; +my @mail = (); +my $mail = []; +my $blank = 1; +local *FH; +local $_; +my ($message,$date,$copied,$marked_for_delete); + + # read_folder returns the contents of a Thunderbird folder + # eg, all of the messages in it. + + open(FH,"< $file") or die "Can't open $file"; + + if ( $range ) { + Log("Range of messages to be copied = $range"); + } + + ($range_start,$range_end) = split(/:/, $range ); + + $skip = 0; + $blank=0; + $msgnum=0; + $flags=''; + while() { + if ( $os =~ /Windows/i ) { + s/\r$//; + s/; + $//; + } else { + chomp; + } + # if($blank && /\AFrom .*\d{4}/) { + if($blank && /\AFrom\s/) { + # End of the message, this is the first line of the next message + # load the message into IMAP + # unless( $marked_for_delete ) { + + $msgnum++; + if ( $range ) { + if ( $msgnum > $range_end ) { + Log("End of range at $msgnum"); + last; + } + next unless $msgnum >= $range_start; + } + + unless( $skip ) { + $flags = map_flags( $status, $status2 ); + $status = insertMsg( $mailbox, \$message, $flags, $date, $conn); + $copied++; + $flags = ''; + $skip = 0; + } + + if ( $msgs_per_folder ) { + # opt_F allows us to limit number of messages copied per folder + last if $copied == $msgs_per_folder; + } + + if ( $copied > 0 ) { + if ( $copied/500 == int($copied/500)) { Log(" $copied messages so far"); } + } + + $message=$date=$flags=$status=$msgid=$marked_for_delete=''; + $blank = $skip = 0; + + } else { + $blank = m#\A\Z#o ? 1 : 0; + # push(@{$mail}, $_); + # print STDOUT "line $_\n"; + + if ( $opt_X ) { + $message .= "$_\n"; + } else { + $message .= "$_\r\n"; + } + + if ( /^Date: (.+)/ ) { + $date = $1 unless $date; + } + if ( /^Message-ID: (.+)/i ) { + $msgid = $1 unless $msgid; + if ( $update ) { + # In update mode don't copy any messages that already exist in IMAP + $skip = 1 if $$MSGIDS{"$msgid"}; + } + } + if ( /X-Mozilla-Status:\s*(.+)/ ) { + $status = $1 unless $status; + } + if ( /X-Mozilla-Status2:\s*(.+)/ ) { + $status2 = $1 unless $status2; + } + } + } + + # Copy the final message in the folder + + unless ( $skip ) { + $flags = map_flags( $status, $status2 ); + $status = insertMsg( $mailbox, \$message, $flags, $date, $conn); + $copied++; + } + close(FH); + + return $copied; +} + +sub count_msgs { + +my $file = shift; +my $mailbox = shift; +my $conn = shift; +my @mail = (); +my $mail = []; +my $blank = 1; +local *FH; +local $_; +my ($message,$date,$count,$marked_for_delete); +my $seen_mask = 0x0001; +my $del_mask = 0x0008; + + # Count the number of messages in the folder + + open(FH,"< $file") or die "Can't open $file"; + + $blank=$count=$marked_for_delete=0; + $status=''; + while() { + s/\r$//; + s/; + $//; + if($blank && /\AFrom .*\d{4}/) { + # End of the message, this is the first line of the next message + $count++ unless $marked_for_delete; + $message=$date=$flags=$status=$marked_for_delete=''; + $blank = 0; + } else { + $blank = m#\A\Z#o ? 1 : 0; + if ( /X-Mozilla-Status:\s*(.+)/ ) { + # The X-Mozilla-Status mask does not seem to always + # accurately reflect the deleted status + my $status = $1; + # $marked_for_delete = 1 if $status & $del_mask; + } + } + } + + # Count the final message in the folder + + $count++ unless $marked_for_delete; + close(FH); + + return $count; +} + +# Get a list of the user's messages in a mailbox +# +sub getMsgIdList { + +my $mailbox = shift; +my $msgids = shift; +my $conn = shift; +my $empty; +my $msgnum; +my $from; +my $msgid; + + %$msgids = (); + sendCommand ($conn, "1 SELECT \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ / 0 EXISTS/i ) { $empty=1; } + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + # print STDERR "Error: $response\n"; + return 0; + } + } + + if ( $empty ) { + return; + } + + Log("Fetch the header info") if $debug; + + # sendCommand ( $conn, "1 FETCH 1:* (body[header.fields (Message-Id)])"); + sendCommand ( $conn, "1 FETCH 1:* (body.peek[header.fields (Message-Id)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + return if $conn_timed_out; + if ( $response =~ /^1 OK/i ) { + last; + } elsif ( $response =~ /could not be processed/i ) { + Log("Error: response from server: $response"); + return; + } elsif ( $response =~ /^1 NO|^1 BAD/i ) { + return; + } + } + + $flags = ''; + for $i (0 .. $#response) { + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /\* (.+) FETCH/ ) { + ($msgnum) = split(/\s+/, $1); + } + + if ($response[$i] =~ /Message-ID:/i) { + + $response[$i] =~ /Message-Id: (.+)/i; + $msgid = $1; + trim(*msgid); + if ( $msgid eq '' ) { + # Line-wrap, get it from the next line + $msgid = $response[$i+1]; + trim(*msgid); + } + $$msgids{"$msgid"} = $msgnum; + } + } + +} + +sub encode_ampersand { + +my $mbx = shift; + + # The IMAP RFC requires mailbox names with '&' be + # encoded as '&-' + + if ( $$mbx =~ /\&/ ) { + if ( $$mbx !~ /\&-/ ) { + # Need to encode the '&' as '&-' + $$mbx =~ s/\&/\&-/g; + Log("Encoded $$mbx"); + } + } + +} + +sub validate_date { + +my $date = shift; +my ($sec,$min,$hour,$mday,$mon,$this_year,$wday,$yday,$isdst) = localtime (time); + + + # If the date doesn't conform to the standard return a null value + + ($day,$mon,$yr,$hr,$min,$sec,$offset) =~ /(.+)-(.+)-(.+) (.+):(.+):(.+) (.+)/; + $$date =~ /(.+)-(.+)-(.+) (.+):(.+):(.+) (.+)/; + + my $day = $1; + my $mon = $2; + my $yr = $3; + my $hr = $4; + my $min = $5; + my $sec = $6; + my $offset = $7; + $offset =~ s/\+|\-//g; + $this_year += 1900; + + # Make sure the date has valid values for each part and + # return a blank value if not so. + + my $save_date = $$date; + + $$date = '' unless ( $day >= 1 and $day <= 31 ); + $$date = '' unless ( $mon =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i ); + $$date = '' unless ( $yr > 1950 and $yr <= $this_year ); + $$date = '' unless ( $hr >= 0 and $hr <= 23 ); + $$date = '' unless ( $min >= 0 and $min <= 59 ); + $$date = '' unless ( $sec >= 0 and $sec <= 59 ); + $$date = '' unless ( $offset >= 0 and $offset <= 2400 ); + + Log("$save_date is invalid, not using it") if $$date eq ''; + +} + +sub thunderbird_flags { + + # Define the Thunderbird flags + + # Status codes for X-Mozilla-Status + + $seen_mask = 0x0001; + $answered_mask = 0x0002; + $marked_mask = 0x0004; + $del_mask = 0x0008; + $has_re_mask = 0x0010; + $elided_mask = 0x0020; + $offline_mask = 0x0080; + $watched_mask = 0x0100; + $authed_mask = 0x0200; + $partial_mask = 0x0400; + $queued_mask = 0x0800; + $forwarded_mask = 0x1000; + $priorities_mask = 0xE000; + + # Status codes for X-Mozilla-Status2 + + $new_mask = 0x00010000; + $ignored_mask = 0x00040000; + $imap_deleted_mask = 0x00200000; + $report_needed = 0x00400000; + $report_sent = 0x00800000; + $template = 0x01000000; + $labels = 0x0E000000; + $attachment = 0x10000000; +} + +sub map_flags { + +my $status = shift; +my $status2 = shift; +my $imap_flags; + + # Only a few Thunderbird flags correspond to the standard IMAP flags. However, + # IMAP supports 'custom' flags whose meaning is left undefined. Create standard IMAP flags + # for the Thunderbird ones that align with IMAP and custom IMAP flags for the others. + # + # See http://www.eyrich-net.org/mozilla/X-Mozilla-Status.html?en for a description of + # Thunderbird flags. + + if ( $debug ) { + Log("X-Mozilla-Status $status"); + Log("X-Mozilla-Status2 $status2"); + } + + # Map the X-Mozilla-Status flags + + $imap_flags .= '\\SEEN ' if $status & $seen_mask; + $imap_flags .= '\\ANSWERED ' if $status & $answered_mask; + $imap_flags .= '$MARKED ' if $status & $marked_mask; + # + # Don't mark messages as deleted because them they don't show up on the server + # $imap_flags .= '\\DELETED ' if $status & $del_mask; + # + $imap_flags .= '$HAS_RE ' if $status & $has_re_mask; + $imap_flags .= '$ELIDED ' if $status & $elided_mask; + $imap_flags .= '$OFFLINE ' if $status & $offline_mask; + $imap_flags .= '$WATCHED ' if $status & $watched_mask; + $imap_flags .= '$AUTHED ' if $status & $authed_mask; + $imap_flags .= '$PARTIAL ' if $status & $partial_mask; + $imap_flags .= '$QUEUED ' if $status & $queued_mask; + $imap_flags .= '$FORWARDED ' if $status & $forwarded_mask; + $imap_flags .= '$PRIORITIES ' if $status & $priorities_mask; + + # Map the X-Mozilla-Status2 flags + + $imap_flags .= '$NEW ' if $status & $new_mask; + $imap_flags .= '$IGNORED ' if $status & $ignored_mask; + $imap_flags .= '$IMAP_DELETED ' if $status & $imap_deleted_mask; + $imap_flags .= '$REPORT_NEEDED ' if $status & $report_needed_mask; + $imap_flags .= '$REPORT_SENT ' if $status & $report_sent_mask; + $imap_flags .= '$TEMPLATE ' if $status & $template_mask; + $imap_flags .= '$LABELS ' if $status & $labels_mask; + $imap_flags .= '$ATTACHMENT ' if $status & $attachment_mask; + + chop $imap_flags; + + return $imap_flags; + +} diff --git a/S/imap_tools.V1.333/trash.pl b/S/imap_tools.V1.333/trash.pl new file mode 100755 index 0000000..45225ca --- /dev/null +++ b/S/imap_tools.V1.333/trash.pl @@ -0,0 +1,993 @@ +#!/usr/bin/perl + +# $Header: /mhub4/sources/imap-tools/trash.pl,v 1.5 2014/10/16 01:18:31 rick Exp $ + +####################################################################### +# Description # +# # +# This script checks a user's IMAP mailboxes for deleted messages # +# which it moves to the trash mailbox. Optionally the trash # +# mailbox is emptied. # +# # +# trash.pl is called like this: # +# ./trash.pl -S host/user/password # +# # +# Optional arguments: # +# -i format: user password, omit pwd if -a # +# -d debug # +# -t (defaults to 'Trash') # +# -e empty the trash mailbox (default is not to empty it) # +# -a # +# -L # +# -m mailbox list (check just certain mailboxes,see usage notes)# +####################################################################### + +use Socket; +use FileHandle; +use Fcntl; +use Getopt::Std; +use MIME::Base64 qw(encode_base64 decode_base64); +use IO::Socket::INET; +use IO::Socket::SSL; + +################################################################# +# Main program. # +################################################################# + +init(); +sigprc(); + +$n = scalar @users; +Log("There are $n users"); + +foreach $_ ( @users ) { + s/^\s+|\s$//g; + ($sourceUser,$sourcePwd) = split(/\s+/, $_); + Log("$sourceUser"); + + # Get list of all messages on the source host by Message-Id + # + next unless connectToHost($sourceHost, \$src ); + + if ( $admin_user ) { + # Do an admin login using AUTHENTICATION = PLAIN + Log( "Login admin:" .$sourceUser."---". $admin_user ."---". $admin_pwd ) if $verbose; + login_plain( $sourceUser, $admin_user, $admin_pwd, $src ); + } else { + Log("Normal:".$sourceUser ."---".$sourcePwd) if $verbose; + next unless login($sourceUser,$sourcePwd, $src); + } + + createMbx( $trash, $src ) unless mbxExists( $trash, $src); + + @mbxs = getMailboxList($sourceUser, $src); + + Log("Checking mailboxes for deleted messages") if $debug; + $total=0; + foreach $mbx ( @mbxs ) { + next if $mbx eq $trash; + next if $nosel_mbxs{"$mbx"}; + Log(" Checking mailbox $mbx") if $verbose; + %msgList = (); + @sourceMsgs = (); + find_deleted_msgs( $mbx, \$msglist, $src ); + moveToTrash( $mbx, $trash, \$msglist, $src ); + expungeMbx( $mbx, $src ); + } + + Log("$total messages were moved to $trash"); + + if ( $emptyTrash and ($total > 0) ) { + expungeMbx( $trash, $src ); + Log("The $trash mailbox has been emptied"); + } + + logout( $src ); + + $total_users++; + $total_moved += $total; +} + +Log("Done."); +Log("Summary:"); +Log(" Users processed $total_users"); +Log(" Messages moved $total_moved"); +exit; + + +sub init { + + $version = 'V1.0'; + $os = $ENV{'OS'}; + + &processArgs; + + if ($timeout eq '') { $timeout = 60; } + + # Open the logFile + # + if ( $logfile ) { + if ( !open(LOG, ">> $logfile")) { + print STDOUT "Can't open $logfile: $!\n"; + } + select(LOG); $| = 1; + } + Log("\n$0 starting"); + $total=0; + + # Determine whether we have SSL support via openSSL and IO::Socket::SSL + $ssl_installed = 1; + eval 'use IO::Socket::SSL'; + if ( $@ ) { + $ssl_installed = 0; + } +} + +# +# sendCommand +# +# This subroutine formats and sends an IMAP protocol command to an +# IMAP server on a specified connection. +# + +sub sendCommand +{ + local($fd) = shift @_; + local($cmd) = shift @_; + + print $fd "$cmd\r\n"; + + if ($showIMAP) { Log (">> $cmd",2); } +} + +# +# readResponse +# +# This subroutine reads and formats an IMAP protocol response from an +# IMAP server on a specified connection. +# + +sub readResponse +{ + local($fd) = shift @_; + + $response = <$fd>; + chop $response; + $response =~ s/\r//g; + push (@response,$response); + if ($showIMAP) { Log ("<< $response",2); } +} + +# +# Log +# +# This subroutine formats and writes a log message to STDERR. +# + +sub Log { + +my $str = shift; + + # If a logile has been specified then write the output to it + # Otherwise write it to STDOUT + + if ( $logfile ) { + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + if ($year < 99) { $yr = 2000; } + else { $yr = 1900; } + $line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n", + $mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str); + print LOG "$line"; + } + print STDOUT "$str\n"; + +} + +# Make a connection to a IMAP host + +sub connectToHost { + +my $host = shift; +my $conn = shift; + + Log("Connecting to $host") if $debug; + + ($host,$port) = split(/:/, $host); + $port = 143 unless $port; + + # We know whether to use SSL for ports 143 and 993. For any + # other ones we'll have to figure it out. + $mode = sslmode( $host, $port ); + + if ( $mode eq 'SSL' ) { + unless( $ssl_installed == 1 ) { + warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection"); + exit; + } + Log("Attempting an SSL connection") if $debug; + $$conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + Domain => AF_INET, + ); + + unless ( $$conn ) { + $error = IO::Socket::SSL::errstr(); + Log("Error connecting to $host: $error"); + return 0; + } + } else { + # Non-SSL connection + Log("Attempting a non-SSL connection") if $debug; + $$conn = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port, + ); + + unless ( $$conn ) { + Log("Error connecting to $host:$port: $@"); + return 0; + } + } + Log("Connected to $host on port $port") if $debug; + + return 1; +} + + +# trim +# +# remove leading and trailing spaces from a string +sub trim { + +local (*string) = @_; + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return; +} + + +# login +# +# login in at the source host with the user's name and password +# +sub login { + +my $user = shift; +my $pwd = shift; +my $conn = shift; + + if ( $pwd =~ /^oauth2:(.+)/i ) { + $token = $1; + Log("password is an OAUTH2 token"); + $status = login_xoauth2( $user, $token, $conn ); + return $status; + } + + sendCommand ($conn, "1 LOGIN $user $pwd"); + while (1) { + readResponse ( $conn ); + if ($response =~ /^1 OK/i) { + last; + } + elsif ($response =~ /1 NO/) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + } + Log("Logged in as $user") if $debug; + + return 1; +} + +# login_xoauth2 +# +# login in at the source host with the user's name and an XOAUTH2 token. +# +sub login_xoauth2 { + +my $user = shift; +my $token = shift; +my $conn = shift; + + # Do an AUTHENTICATE = XOAUTH2 login + + $login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", ''); + sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" ); + + my $loops; + while (1) { + readResponse ( $conn ); + if ( $response =~ /^\+ (.+)/ ) { + $error = decode_base64( $1 ); + Log("XOAUTH authentication as $user failed: $error"); + return 0; + } + last if $response =~ /^1 OK/; + if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + Log("login complete") if $debug; + + return 1; + +} + + +# logout +# +# log out from the host +# +sub logout { + +my $conn = shift; + + undef @response; + sendCommand ($conn, "1 LOGOUT"); + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected LOGOUT response: $response"); + last; + } + } + close $conn; + return; +} + + +# getMailboxList +# +# get a list of the user's mailboxes from the source host +# +sub getMailboxList { + +my $user = shift; +my $conn = shift; +my @mbxs; + + # Get a list of the user's mailboxes + # + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # the ones in that list + @mbxs = split(/,/, $mbxList); + for $i (0..$#mbxs ) { + $mbxs[$i] =~ s/^\s+//; + $mbxs[$i] =~ s/s+$//; + } + return @mbxs; + } + + if ($debugMode) { Log("Get list of user's mailboxes",2); } + + sendCommand ($conn, "1 LIST \"\" *"); + undef @response; + while ( 1 ) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + last; + } + elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + return 0; + } + } + + %nosel_mbxs = (); + undef @mbxs; + for $i (0 .. $#response) { + # print STDERR "$response[$i]\n"; + $response[$i] =~ s/\s+/ /; + ($dmy,$mbx) = split(/"\/"/,$response[$i]); + $mbx =~ s/^\s+//; $mbx =~ s/\s+$//; + $mbx =~ s/"//g; + + if ($response[$i] =~ /NOSELECT/i) { + $nosel_mbxs{"$mbx"} = 1; + } + if (($mbx =~ /^\#/) && ($user ne 'anonymous')) { + # Skip public mbxs unless we are migrating them + next; + } + if ($mbx =~ /^\./) { + # Skip mailboxes starting with a dot + next; + } + push ( @mbxs, $mbx ) if $mbx ne ''; + } + + if ( $mbxList ) { + # The user has supplied a list of mailboxes so only processes + # those + @mbxs = split(/,/, $mbxList); + } + + return @mbxs; +} + +# getDeletedMsgs +# +# Get a list of deleted messages in the indicated mailbox on +# the source host +# +sub getDeletedMsgs { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + @$msgs = (); + trim( *mailbox ); + sendCommand ($conn, "1 SELECT \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } elsif ( $response =~ / 0 EXISTS/i ) { + $empty = 1; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + print STDERR "Error: $response\n"; + return 0; + } + return 0 if $response =~ /^1 NO/; + } + + return if $empty; + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (Message-ID Subject)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response =~ /Broken pipe|Connection reset by peer/i ) { + Log("Fetch from $mailbox: $response"); + return 0; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID / ) { + $response[$i] =~ /\* ([^FETCH \(UID]*)/; + $msgnum = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $deleted = 0; + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $deleted = 1 if $flags =~ /Deleted/i; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + $response[$i] =~ /INTERNALDATE ([^BODY]*)/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Subject:/ ) { + $response[$i] =~ /Subject: (.+)/; + $subject = $1; + } + if ( $response[$i] =~ /^Message-Id:/ ) { + ($label,$msgid) = split(/: /, $response[$i]); + trim(*msgid); + $msgid =~ s/^\$//; + push( @$msgs, $msgnum ) if $deleted; + } + } +} + + +# getDeletedMsgs +# +# Get a list of deleted messages in the indicated mailbox on +# the source host +# +sub OLD_getDeletedMsgs { + +my $mailbox = shift; +my $msgs = shift; +my $conn = shift; +my $seen; +my $empty; +my $msgnum; + + trim( *mailbox ); + sendCommand ($conn, "1 SELECT \"$mailbox\""); + undef @response; + $empty=0; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } elsif ( $response =~ / 0 EXISTS/i ) { + $empty = 1; + } elsif ( $response !~ /^\*/ ) { + Log ("unexpected response: $response"); + print STDERR "Error: $response\n"; + return 0; + } + return 0 if $response =~ /^1 NO/; + } + + return if $empty; + + sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (Message-ID Subject)])"); + undef @response; + while ( 1 ) { + readResponse ( $conn ); + if ( $response =~ /^1 OK/i ) { + # print STDERR "response $response\n"; + last; + } + elsif ( $response =~ /Broken pipe|Connection reset by peer/i ) { + Log("Fetch from $mailbox: $response"); + return 0; + } + } + + # Get a list of the msgs in the mailbox + # + undef @msgs; + undef $flags; + for $i (0 .. $#response) { + $seen=0; + $_ = $response[$i]; + + last if /OK FETCH complete/; + + if ( $response[$i] =~ /FETCH \(UID / ) { + $response[$i] =~ /\* ([^FETCH \(UID]*)/; + $msgnum = $1; + } + + if ($response[$i] =~ /FLAGS/) { + # Get the list of flags + $deleted = 0; + $response[$i] =~ /FLAGS \(([^\)]*)/; + $flags = $1; + $deleted = 1 if $flags =~ /Deleted/i; + } + if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) { + $response[$i] =~ /INTERNALDATE ([^BODY]*)/i; + $date = $1; + $date =~ s/"//g; + } + if ( $response[$i] =~ /^Subject:/ ) { + $response[$i] =~ /Subject: (.+)/; + $subject = $1; + } + if ( $response[$i] =~ /^Message-Id:/ ) { + ($label,$msgid) = split(/: /, $response[$i]); + trim(*msgid); + $msgid =~ s/^\$//; + push( @$msgs, $msgnum ) if $deleted; + } + } +} + + +sub fetchMsg { + +my $msgnum = shift; +my $mbx = shift; +my $conn = shift; +my $message; + + Log(" Fetching msg $msgnum...") if $debug; + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /^1 OK/i ); + return 0 if $response =~ /^1 NO/; + } + + sendCommand( $conn, "1 FETCH $msgnum (rfc822)"); + while (1) { + readResponse ($conn); + if ( $response =~ /^1 OK/i ) { + $size = length($message); + last; + } + elsif ($response =~ /message number out of range/i) { + Log ("Error fetching uid $uid: out of range",2); + $stat=0; + last; + } + elsif ($response =~ /Bogus sequence in FETCH/i) { + Log ("Error fetching uid $uid: Bogus sequence in FETCH",2); + $stat=0; + last; + } + elsif ( $response =~ /message could not be processed/i ) { + Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)"); + $stat=0; + last; + } + elsif + ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) { + ($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i); + $cc = 0; + $message = ""; + while ( $cc < $len ) { + $n = 0; + $n = read ($conn, $segment, $len - $cc); + if ( $n == 0 ) { + Log ("unable to read $len bytes"); + return 0; + } + $message .= $segment; + $cc += $n; + } + } + } + + return $message; + +} + + +sub usage { + + print STDOUT "usage:\n"; + print STDOUT " trash.pl -S sourceHost/sourceUser/sourcePassword\n"; + print STDOUT " Optional arguments:\n"; + print STDOUT " -d debug\n"; + print STDOUT " -v verbose\n"; + print STDOUT " -I log IMAP commands and responses\n"; + print STDOUT " -t \n"; + print STDOUT " -e empty trash mailbox\n"; + print STDOUT " -L \n"; + print STDOUT " -m (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n"; + print STDOUT " -a \n"; + exit; + +} + +sub processArgs { + + if ( !getopts( "dvS:L:m:ht:ei:a:I" ) ) { + usage(); + } + + ($sourceHost,$sourceUser,$sourcePwd) = split(/\//, $opt_S); + $userList = $opt_i; + $mbxList = $opt_m; + $logfile = $opt_L; + $trash = $opt_t; + $admin_user = $opt_a; + Log("Admin user:" . $admin_user ) if $verbose; + $emptyTrash = 1 if $opt_e; + $debug = 1 if $opt_d; + $verbose = 1 if $opt_v; + $showIMAP = 1 if $opt_I; + + usage() if $opt_h; + $trash = 'Trash' if !$trash; + + if ( $userList ) { + if ( !open(F, "<$userList") ) { + Log("Error opening userlist $userList: $!"); + exit; + } + while( ) { + chomp; + s/^\s+//; + next if /^#/; + push( @users, $_ ); + } + close F; + } else { + push( @users, "$sourceUser $sourcePwd" ); + } + + if ( $admin_user ) { + $admin_user =~ /(.+):(.+)/; + $admin_user = $1; + $admin_pwd = $2; + } + +} + +sub expungeMbx { + +my $mbx = shift; +my $conn = shift; + + Log(" Purging mailbox $mbx") if $debug; + + sendCommand ($conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if ( $response =~ /^1 OK/i ); + return 0 if $response =~ /^1 NO/; + } + + sendCommand ( $conn, "1 EXPUNGE"); + $expunged=0; + while (1) { + readResponse ($conn); + $expunged++ if $response =~ /\* (.+) Expunge/i; + last if $response =~ /^1 OK/; + + if ( $response =~ /^1 BAD|^1 NO/i ) { + print "Error purging messages: $response\n"; + last; + } + } + + $totalExpunged += $expunged; + +} + + +sub dieright { + local($sig) = @_; + print STDOUT "caught signal $sig\n"; + logout( $src ); + exit(-1); +} + +sub sigprc { + + $SIG{'HUP'} = 'dieright'; + $SIG{'INT'} = 'dieright'; + $SIG{'QUIT'} = 'dieright'; + $SIG{'ILL'} = 'dieright'; + $SIG{'TRAP'} = 'dieright'; + $SIG{'IOT'} = 'dieright'; + $SIG{'EMT'} = 'dieright'; + $SIG{'FPE'} = 'dieright'; + $SIG{'BUS'} = 'dieright'; + $SIG{'SEGV'} = 'dieright'; + $SIG{'SYS'} = 'dieright'; + $SIG{'PIPE'} = 'dieright'; + $SIG{'ALRM'} = 'dieright'; + $SIG{'TERM'} = 'dieright'; + $SIG{'URG'} = 'dieright'; +} + +sub moveToTrash { + +my $mbx = shift; +my $trash = shift; +my $msglist = shift; +my $conn = shift; +my $moved; + + return if $mbx eq $trash; + return if $$msglist eq ''; + + my @moved = split(/,/, $$msglist); + $moved = scalar @moved; + + sendCommand ($conn, "1 COPY $$msglist $trash"); + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /NO/) { + Log("unexpected COPY response: $response"); + Log("Please verify that mailbox $trash exists"); + return 0; + } + } + Log(" Moved $moved messages from $mbx to $trash"); + $total += $moved; + +} + + +# login_plain +# +# login in at the source host with the user's name and password. If provided +# with administrator credential, use them as this eliminates the need for the +# user's password. +# +sub login_plain { + +my $user = shift; +my $admin = shift; +my $pwd = shift; +my $conn = shift; + + # Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it. + + if ( !$admin ) { + # Log in as the user + $admin = $user + } + + $login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd); + $login_str = encode_base64("$login_str", ""); + $len = length( $login_str ); + + #sendCommand ($conn, "1 AUTHENTICATE PLAIN {$len}" ); + sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" ); + + #my $loops; + #while (1) { + #readResponse ( $conn ); + #last if $response =~ /\+/; + #if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + #Log ("unexpected LOGIN response: $response"); + #exit; + #} + #$last if $loops++ > 5; + #} + + #sendCommand ($conn, "$login_str" ); + my $loops; + while (1) { + readResponse ( $conn ); + last if $response =~ /^1 OK/i; + if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) { + Log ("unexpected LOGIN response: $response"); + return 0; + } + $last if $loops++ > 5; + } + + return 1; + +} + +sub sslmode { + +my $host = shift; +my $port = shift; +my $mode; + +Log("CONNEXION SSL") if $verbose; + # Determine whether to make an SSL connection + # to the host. Return 'SSL' if so. + + if ( $port == 143 ) { + # Standard non-SSL port + return ''; + } elsif ( $port == 993 ) { + # Standard SSL port + return 'SSL'; + } + + unless ( $ssl_installed ) { + # We don't have SSL installed on this machine + return ''; + } + + # For any other port we need to determine whether it supports SSL + + my $conn = IO::Socket::SSL->new( + Proto => "tcp", + SSL_verify_mode => 0x00, + PeerAddr => $host, + PeerPort => $port, + ); + + if ( $conn ) { + close( $conn ); + $mode = 'SSL'; + } else { + $mode = ''; + } + + return $mode; +} + +sub find_deleted_msgs { + +my $mbx = shift; +my $msglist = shift; +my $conn = shift; +my $msgnum; + + # Issue a SEARCH DELETED command to get a list of messages + # marked for deletion. + + $$msglist = ''; + Log("SELECT $mbx") if $debug; + sendCommand ( $conn, "1 SELECT \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/; + return 0 if $response =~ /^1 NO/; + } + + Log("Search for $msgid") if $debug; + sendCommand ( $conn, "1 SEARCH DELETED"); + while (1) { + readResponse ($conn); + if ( $response =~ /\* SEARCH /i ) { + ($dmy, $$msglist) = split(/\* SEARCH /i, $response, 2); + $$msglist =~ s/\s+/,/g; + Log("msglist $$msglist") if $debug; + } + + last if $response =~ /^1 OK/; + last if $response =~ /complete/i; + } + +} + +sub createMbx { + +my $mbx = shift; +my $conn = shift; + + # Create the mailbox if necessary + + sendCommand ($conn, "1 CREATE \"$mbx\""); + while ( 1 ) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + last if $response =~ /already exists/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + Log ("Error creating $mbx: $response"); + last; + } + if ( $response eq '' or $response =~ /^1 NO/ ) { + Log ("unexpected CREATE response: >$response<"); + Log("response is NULL"); + resume(); + last; + } + + } + +} + +sub mbxExists { + +my $mbx = shift; +my $conn = shift; +my $status = 1; + + # Determine whether a mailbox exists + sendCommand ($conn, "1 EXAMINE \"$mbx\""); + while (1) { + readResponse ($conn); + last if $response =~ /^1 OK/i; + if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) { + $status = 0; + last; + } + } + + return $status; +} + diff --git a/S/imapservers.shtml b/S/imapservers.shtml index ab1959c..196b0e6 100755 --- a/S/imapservers.shtml +++ b/S/imapservers.shtml @@ -4,7 +4,7 @@ -Imapsync list of imap server softwares supported (and the failures one) +Imapsync list of 73 imap server software supported (and the few failures) @@ -18,7 +18,10 @@ - + + @@ -27,17 +30,22 @@

    Imapsync list of imap server softwares supported (and the failures one) (back to menu)

    +

    To know weither your IMAP server is a widespread choice, +take a look at http://openemailsurvey.org/. +

    Let's start with the long reported success stories list: -67 different imap server softwares supported!
    +72 different imap software servers supported!
    [host1] means "source server" and [host2] means "destination server":

    -

    Please report to the author (gilles.lamiral@laposte.net) any success or bad story with +

    Please report to the author (gilles.lamiral@laposte.net) +any success or bad story with imapsync and, if you know them, mention the IMAP server software names and version on both sides. This will help future users. You can grab these values, software name and release number, -by looking at two lines at the beginning of the output. Example: +by looking at two lines at the beginning of the output. +Example: 

    @@ -47,21 +55,24 @@ by looking at two lines at the beginning of the output. Example:

    You can use option --justconnect to get those lines. -Examples (really working)):

    +Examples:

    -  imapsync --host1 test1.lamiral.info --host2 test2.lamiral.info --justconnect
-
-  imapsync --host1 imap.gmail.com --ssl1 --host2 imap-mail.outlook.com --ssl2 --justconnect
+imapsync --host1 test1.lamiral.info \
+         --host2 test2.lamiral.info \
+         --justconnect
    -

    And now the success imap server software list:

    + +

    And now the imap servers software imapsync success list:

    1. 1und1 H mimap1 84498 [host1], H mibap4 95231 [host1](http://www.1und1.de/)
    2. a1.net imap.a1.net IMAP4 Ready [host1]
      3. +
    3. Amazon AWS WorkMail IMAP server [host2]
    4. Apple Server 10.6 Snow Leopard [host1]
    5. Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] (OSL 3.0) (http://www.archiveopteryx.org/)
      6. +
    6. ArGoSoft IMAP Module Version 1.8 (1.8.8.2) http://www.argosoft.com/
    7. Atmail 6.x [host1] https://www.atmail.com/
    8. Axigen Mail Server Version 8.0.0 (https://www.axigen.com/)
    9. BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
      10. @@ -99,6 +110,7 @@ Examples (really working)):

      (http://www.microsoft.com/exchange/)
    10. FirtClass 12 [host1] hard so read the FAQ! (http://www.firstclass.com/)
      11. +
    11. FortiMail 100C in server mode [host1] (https://www.fortinet.com/.../fortimail.html)
    12. FTGate [host1][host2] (http://www.ftgate.com/)
    13. Fusemail imap.fusemail.net:143 (https://www.fusemail.com/).
    14. Gimap (Gmail imap) [host1] [host2] (http://mail.google.com/)
      15. @@ -111,9 +123,10 @@ Examples (really working)):

    15. Hotmail hotmail.com is outlook.com and live.com now.
    16. IceWarp 10.4.5 [host1] 11.2.1.1 [host2] 11.4.1.0 [host2] (https://www.icewarp.com/)
    17. IdeaImapServer v0.80.1 [host1]
      18. +
    18. IMail 7.15 (Ipswitch/Win2003), 8.12, 11.03 [host1] (http://www.imailserver.com/)
    19. iPlanet Messaging server 4.15, 5.1, 5.2 (http://en.wikipedia.org/wiki/Oracle_Communications_Messaging_Server)
      20. -
    20. IMail 7.15 (Ipswitch/Win2003), 8.12, 11.03 [host1] (http://www.imailserver.com/)
      21. +
    21. iRedMail, iRedMail imap server software is Dovecot. http://www.iredmail.org/
    22. Kerio 7.2.0P1 [host1] (http://www.kerio.com/)
    23. Mail2World IMAP4 Server 2.5 [host1] (http://www.mail2world.com/)
    24. MailEnable 4.23 [host1][host2], 4.26 [host1][host2], 5 [host1] @@ -137,7 +150,7 @@ Examples (really working)):

    25. Qualcomm Worldmail (NT) (http://www.eudora.com/worldmail/)
    26. Rockliffe Mailsite 5.3.11, 4.5.6 (http://www.mailsite.com/)
      27. -
    27. RackSpace hoster secure.emailsrvr.com:993 http://www.rackspace.com/)
      28. +
    28. RackSpace hoster secure.emailsrvr.com:993 [host1] http://www.rackspace.com/)
    29. QQMail IMAP4Server [host1] [host2] (See FAQ) https://en.mail.qq.com/
    30. Samsung Contact IMAP server 8.5.0
    31. Scalix v10.1, 10.0.1.3, 11.0.0.431, 11.4.5, 11.4.6 (http://www.scalix.com/)
      32. @@ -208,7 +221,7 @@ alt="Viewable With Any Browser" /> This document last modified on -($Id: imapservers.shtml,v 1.15 2016/06/13 22:52:46 gilles Exp gilles $)
      +($Id: imapservers.shtml,v 1.32 2017/09/11 03:04:46 gilles Exp gilles $)
      Top of the page

      diff --git a/S/imapsync_sold_by_country.txt b/S/imapsync_sold_by_country.txt index 5b4b9b1..b4dde77 100644 --- a/S/imapsync_sold_by_country.txt +++ b/S/imapsync_sold_by_country.txt @@ -1,86 +1,92 @@ -1225 Etats-Unis______________ 24.84 % 25 % 1 -918 Allemagne_______________ 18.62 % 43 % 2 -454 Royaume-Uni_____________ 9.21 % 53 % 3 -253 Italie__________________ 5.13 % 58 % 4 -243 France__________________ 4.93 % 63 % 5 -219 Canada__________________ 4.44 % 67 % 6 -199 Suisse__________________ 4.04 % 71 % 7 -183 Pays-Bas________________ 3.71 % 75 % 8 -172 Australie_______________ 3.49 % 78 % 9 -98 Autriche________________ 1.99 % 80 % 10 -91 Espagne_________________ 1.85 % 82 % 11 -88 Belgique________________ 1.78 % 84 % 12 -71 Suede___________________ 1.44 % 85 % 13 -58 Danemark________________ 1.18 % 87 % 14 -51 Bresil__________________ 1.03 % 88 % 15 -43 Norvege_________________ 0.87 % 89 % 16 -36 Pologne_________________ 0.73 % 89 % 17 -33 Finlande________________ 0.67 % 90 % 18 -28 Republique_tcheque______ 0.57 % 91 % 19 -26 Russie__________________ 0.53 % 91 % 20 -26 Japon___________________ 0.53 % 92 % 21 -25 ________________________ 0.51 % 92 % 22 -23 Nouvelle-Zelande________ 0.47 % 93 % 23 -23 Irlande_________________ 0.47 % 93 % 24 -23 Hongrie_________________ 0.47 % 93 % 25 -19 Portugal________________ 0.39 % 94 % 26 -18 Hong-Kong_______________ 0.37 % 94 % 27 -18 Grece___________________ 0.37 % 95 % 28 -18 Afrique_du_Sud__________ 0.37 % 95 % 29 -14 Slovaquie_______________ 0.28 % 95 % 30 -14 Malaisie________________ 0.28 % 96 % 31 -13 Luxembourg______________ 0.26 % 96 % 32 -13 Inde____________________ 0.26 % 96 % 33 -12 Singapour_______________ 0.24 % 96 % 34 -12 Mexique_________________ 0.24 % 97 % 35 -12 Argentine_______________ 0.24 % 97 % 36 -11 Israel__________________ 0.22 % 97 % 37 -11 Chine___________________ 0.22 % 97 % 38 -11 Chili___________________ 0.22 % 97 % 39 -10 Roumanie________________ 0.20 % 98 % 40 -9 Slovenie________________ 0.18 % 98 % 41 -9 Lettonie________________ 0.18 % 98 % 42 -9 Emirats_Arabes_Unis_____ 0.18 % 98 % 43 -7 Croatie_________________ 0.14 % 98 % 44 -6 Thailande_______________ 0.12 % 98 % 45 -5 Malte___________________ 0.10 % 99 % 46 -5 Islande_________________ 0.10 % 99 % 47 -4 Turquie_________________ 0.08 % 99 % 48 -4 Indonesie_______________ 0.08 % 99 % 49 -4 Estonie_________________ 0.08 % 99 % 50 -4 Egypte__________________ 0.08 % 99 % 51 -4 Bulgarie________________ 0.08 % 99 % 52 -3 Venezuela_______________ 0.06 % 99 % 53 -3 Serbie__________________ 0.06 % 99 % 54 -3 Philippines_____________ 0.06 % 99 % 55 -2 Vietnam_________________ 0.04 % 99 % 56 -2 Uruguay_________________ 0.04 % 99 % 57 -2 Perou___________________ 0.04 % 99 % 58 -2 Lituanie________________ 0.04 % 99 % 59 -2 Costa_Rica______________ 0.04 % 99 % 60 -2 Chypre__________________ 0.04 % 99 % 61 -2 Antilles_neerlandaises__ 0.04 % 100 % 62 -1 Ukraine_________________ 0.02 % 100 % 63 -1 Trinite-et-Tobago_______ 0.02 % 100 % 64 -1 Tanzanie________________ 0.02 % 100 % 65 -1 Taiwan__________________ 0.02 % 100 % 66 -1 Senegal_________________ 0.02 % 100 % 67 -1 Saint_Christophe-Nevis-Anguilla__ 0.02 % 100 % 68 -1 Qatar___________________ 0.02 % 100 % 69 -1 Panama__________________ 0.02 % 100 % 70 -1 Nouvelle-Caledonie______ 0.02 % 100 % 71 -1 Nigeria_________________ 0.02 % 100 % 72 -1 Namibie_________________ 0.02 % 100 % 73 -1 Mongolie________________ 0.02 % 100 % 74 -1 Moldavie________________ 0.02 % 100 % 75 -1 Maldives________________ 0.02 % 100 % 76 -1 Koweit__________________ 0.02 % 100 % 77 -1 Jordanie________________ 0.02 % 100 % 78 -1 Iles_Vierges_britanniques__ 0.02 % 100 % 79 -1 Grenade_________________ 0.02 % 100 % 80 -1 Coree_du_Sud____________ 0.02 % 100 % 81 -1 Colombie________________ 0.02 % 100 % 82 -1 Cameroun________________ 0.02 % 100 % 83 -1 Burkina_Faso____________ 0.02 % 100 % 84 -1 Bahrein_________________ 0.02 % 100 % 85 -TOTAL = 4931 sales 219147 EUR over 85 countries on Fri Aug 19 12:49:52 CEST 2016 +1373 Etats-Unis______________ 23.64 % 24 % 1 +1111 Allemagne_______________ 19.13 % 43 % 2 +521 Royaume-Uni_____________ 8.97 % 52 % 3 +343 Italie__________________ 5.90 % 58 % 4 +282 France__________________ 4.85 % 62 % 5 +244 Canada__________________ 4.20 % 67 % 6 +233 Pays-Bas________________ 4.01 % 71 % 7 +231 Suisse__________________ 3.98 % 75 % 8 +196 Australie_______________ 3.37 % 78 % 9 +128 Autriche________________ 2.20 % 80 % 10 +120 Espagne_________________ 2.07 % 82 % 11 +97 Belgique________________ 1.67 % 84 % 12 +87 Suede___________________ 1.50 % 85 % 13 +78 Danemark________________ 1.34 % 87 % 14 +55 Bresil__________________ 0.95 % 88 % 15 +47 Pologne_________________ 0.81 % 89 % 16 +45 Norvege_________________ 0.77 % 89 % 17 +37 Republique_tcheque______ 0.64 % 90 % 18 +37 Finlande________________ 0.64 % 91 % 19 +31 Russie__________________ 0.53 % 91 % 20 +29 Hongrie_________________ 0.50 % 92 % 21 +28 Nouvelle-Zelande________ 0.48 % 92 % 22 +27 Japon___________________ 0.46 % 93 % 23 +25 ________________________ 0.43 % 93 % 24 +23 Irlande_________________ 0.40 % 93 % 25 +22 Grece___________________ 0.38 % 94 % 26 +21 Portugal________________ 0.36 % 94 % 27 +20 Afrique_du_Sud__________ 0.34 % 95 % 28 +19 Hong-Kong_______________ 0.33 % 95 % 29 +17 Slovaquie_______________ 0.29 % 95 % 30 +17 Inde____________________ 0.29 % 95 % 31 +17 Argentine_______________ 0.29 % 96 % 32 +16 Mexique_________________ 0.28 % 96 % 33 +15 Malaisie________________ 0.26 % 96 % 34 +15 Chili___________________ 0.26 % 97 % 35 +14 Singapour_______________ 0.24 % 97 % 36 +14 Luxembourg______________ 0.24 % 97 % 37 +14 Chine___________________ 0.24 % 97 % 38 +13 Roumanie________________ 0.22 % 97 % 39 +12 Slovenie________________ 0.21 % 98 % 40 +11 Israel__________________ 0.19 % 98 % 41 +10 Emirats_Arabes_Unis_____ 0.17 % 98 % 42 +9 Lettonie________________ 0.15 % 98 % 43 +7 Croatie_________________ 0.12 % 98 % 44 +6 Thailande_______________ 0.10 % 98 % 45 +6 Islande_________________ 0.10 % 99 % 46 +5 Malte___________________ 0.09 % 99 % 47 +5 Estonie_________________ 0.09 % 99 % 48 +5 Egypte__________________ 0.09 % 99 % 49 +4 Turquie_________________ 0.07 % 99 % 50 +4 Indonesie_______________ 0.07 % 99 % 51 +4 Chypre__________________ 0.07 % 99 % 52 +4 Bulgarie________________ 0.07 % 99 % 53 +3 Venezuela_______________ 0.05 % 99 % 54 +3 Serbie__________________ 0.05 % 99 % 55 +3 Philippines_____________ 0.05 % 99 % 56 +3 Lituanie________________ 0.05 % 99 % 57 +3 Ireland_________________ 0.05 % 99 % 58 +2 Vietnam_________________ 0.03 % 99 % 59 +2 Uruguay_________________ 0.03 % 99 % 60 +2 Ukraine_________________ 0.03 % 99 % 61 +2 Perou___________________ 0.03 % 99 % 62 +2 Nouvelle-Caledonie______ 0.03 % 99 % 63 +2 Costa_Rica______________ 0.03 % 100 % 64 +2 Antilles_neerlandaises__ 0.03 % 100 % 65 +1 Trinite-et-Tobago_______ 0.02 % 100 % 66 +1 Tanzanie________________ 0.02 % 100 % 67 +1 Taiwan__________________ 0.02 % 100 % 68 +1 Senegal_________________ 0.02 % 100 % 69 +1 Saint_Christophe-Nevis-Anguilla__ 0.02 % 100 % 70 +1 Qatar___________________ 0.02 % 100 % 71 +1 Panama__________________ 0.02 % 100 % 72 +1 Nigeria_________________ 0.02 % 100 % 73 +1 Namibie_________________ 0.02 % 100 % 74 +1 Mongolie________________ 0.02 % 100 % 75 +1 Monaco__________________ 0.02 % 100 % 76 +1 Moldavie________________ 0.02 % 100 % 77 +1 Maldives________________ 0.02 % 100 % 78 +1 Koweit__________________ 0.02 % 100 % 79 +1 Jordanie________________ 0.02 % 100 % 80 +1 Jamaique________________ 0.02 % 100 % 81 +1 Iles_Vierges_britanniques__ 0.02 % 100 % 82 +1 Grenade_________________ 0.02 % 100 % 83 +1 Coree_du_Sud____________ 0.02 % 100 % 84 +1 Colombie________________ 0.02 % 100 % 85 +1 Cameroun________________ 0.02 % 100 % 86 +1 Burkina_Faso____________ 0.02 % 100 % 87 +1 Bosnie-Herzegovine______ 0.02 % 100 % 88 +1 Bahrein_________________ 0.02 % 100 % 89 +1 Arabie_Saoudite_________ 0.02 % 100 % 90 +1 Albanie_________________ 0.02 % 100 % 91 +TOTAL = 5809 sales 268740 EUR over 91 countries on Thu Sep 7 01:46:18 CEST 2017 diff --git a/S/mailing_list.shtml b/S/mailing_list.shtml index 11a8cdc..5eb7f33 100644 --- a/S/mailing_list.shtml +++ b/S/mailing_list.shtml @@ -10,6 +10,11 @@ + + + - + @@ -103,7 +107,7 @@ alt="Viewable With Any Browser" This document was last modified on -($Id: mailing_list.shtml,v 1.2 2016/08/05 14:24:46 gilles Exp gilles $)
      +($Id: mailing_list.shtml,v 1.3 2016/12/20 10:06:54 gilles Exp gilles $)
      Top of the page

      diff --git a/S/news.shtml b/S/news.shtml index 6fa1b14..a597ced 100755 --- a/S/news.shtml +++ b/S/news.shtml @@ -1,5 +1,6 @@ - + + Imapsync News @@ -12,16 +13,21 @@ - + + + -

      News about next imapsync, currently distributed , next and previous releases (back to menu) +

      News about next imapsync, currently distributed , +next and previous releases (back to menu)

      imapsync was written on @@ -33,7 +39,8 @@ + +

        +
      • 1.836 More secure by default, ssl or tls activation!
        • + +
      • Enhancement: An Imapsync Docker image available!
        • + +
      • Usability: Now goes to SSL by default if port 993 is open. Use --nosslcheck to avoid that.
        • + +
      • Usability: Now goes to TLS by default if possible, ie, only if STARTTLS is in CAPABILITY. If you want only TLS and nothing else, use --tls1 --nossl1
        • + +
      • Usability: Now if you want a basic imap connection on port 143 with no default encryption behavior, ie, no ssl nor tls, + then use --nossl1 --notls1 for host1 and --nossl2 --notls2 for host2.
        • + +
      • Enhancement: Added --gmail1 and --gmail2 to simplify Gmail options setting. + It sets parameters suggested in the Gmail FAQ --ssl, --host, etc.
        • + +
      • Enhancement: Added --office1 and --office2 to simplify Office 365 options setting. + It sets parameters suggested in the Exchange/Office365 FAQ.
        • + +
      • Enhancement: Added --domino1 and --domino2 to simplify Domino options setting. + It sets parameters suggested in the Domino FAQ.
        • + +
      • Enhancement: Added --maxsleep in order to avoid timeouts with --maxbytespersecond and --maxmessagespersecond options. + By default imapsync will sleep 2 seconds maximum, like if the command line contained --maxsleep 2
        • + + +
      • Enhancement: Added --maxbytesafter in order to start --maxbytespersecond limitation only after + --maxbytesafter amount of data transferred. Usefull for Gmail limits, for example, + in order to active a 50K/s limit rate only after 500 MB of data transfer, use + --maxbytesafter 500_000_000 --maxbytespersecond 50_000
        • + +
      • Enhancement: Added --testsunit in order to run any unit test individualy from the command line. + Several --testsunit are allowed. Example: + imapsync --testsunit tests_true --testsunit tests_always_fail
        • + + +
      • Enhancement: Added password setting via environment variables IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2
        • + + +
      • Usability: No more useless and false warning "says it has NO CAPABILITY for AUTHENTICATE LOGIN"
        • + + +
      • Usability: Options --delete1 and --delete are now aliases. +Option --delete1 is preferable over --delete (--delete is still supported).
        • + +
      • Usability: Now prints always permanentflags info. +It helps to understand most flag issues at first run, without --debugflags
        • + +
      • Usability: Now prints "could not append ( Subject:[$subject], Date:[$h1_date], Size:[$h1_size] )" +when append fails.
        • +
      • Usability: Option --showpasswords now shows also passwords with --debugimap. Useful to debug quoting issues.
        • + + +
      • Usability: --ipv4 is now synonym of --inet4 and --ipv6 is now synonim of --inet6
        • + +
      • Usability: Added --testslive6 to check pure ipv6 connectivity.
        • + + +
      • Enhancement: Added --noabletosearch1 and --noabletosearch2; + Still support --noabletosearch, which turn on both --noabletosearch1 and --noabletosearch2 +
        • +
      • Enhancement: Added --abort option to terminate a previous call still running. +In command line context --abort uses the pidfile to know what to abort. +In cgi context, ie online, exact same credentials are needed in order to really abort the other sync.
        • + +
      • Enhancement: Added milliseconds in the default logfile name since several runs is possible within one second in cgi context or on a powerful machine.
        • + +
      • Docker context: Added docker context in order to be run under the nobody user without permission issues.
        • +
      • Docker context: Can run imapsync --tests under nobody user on Unix (or at least Linux).
        • + +
      • Bugfix: Fixed issue "SSL routines:ssl3_check_cert_and_algorithm:dh key too small" with + openssl-dh-key-too-small-error + SSL_cipher_list => 'DEFAULT:!DH'
        • + +
      • CGI context: Allow parameters passed by POST.
        • +
      • CGI context: Abort, before doing anything, if the server load is already too heavy, + and invite to come later depending on the current load (1, 5, or 15 minutes later).
        • + +
      • Bug fix: Guessed prefix is the empty string even when there is no folders (which is a bad sign anyway, since INBOX should be listed).
        • +
      • Bug fix: Option --skipmess could not work most of the time. I guess it was a mistake arrived by badly converting an "unless" to an "if". Perl critics with no tests added => caveat emptor!
        • + + +
      • Refactoring: Removed Mail::IMAPClient overload definitions
        • + +
      • Dependency added: IO::Socket::SSL
        • +
      • Dependency added: Sys::MemInfo
        • +
      • Dependency added: Pod::Usage
        • + +
      + +
      • 1.727 https website and CGI on the way!
        • @@ -455,7 +555,7 @@ by ignoring PERMANENTFLAGS (Exchange tests) This document last modified on -($Id: news.shtml,v 1.28 2016/08/19 14:16:58 gilles Exp gilles $)
        +($Id: news.shtml,v 1.50 2017/09/11 03:04:46 gilles Exp gilles $)
        Top of the page

        diff --git a/S/paypal.shtml b/S/paypal.shtml index baa2083..26e84cd 100644 --- a/S/paypal.shtml +++ b/S/paypal.shtml @@ -29,6 +29,11 @@ img{ border:0px; } + + + @@ -48,22 +53,26 @@ border:0px;

        Thanks in advance!

        -
        +

        - Valid XHTML 1.0 Strict - - CSS Valide ! + + Valid XHTML 1.0 Strict + + CSS Valide ! + + + +Viewable With Any Browser + + + This document last modified on -($Id: paypal.shtml,v 1.9 2016/03/03 15:57:41 gilles Exp gilles $) +($Id: paypal.shtml,v 1.12 2016/12/20 10:06:54 gilles Exp gilles $)

        diff --git a/S/paypal_return.shtml b/S/paypal_return.shtml index e9c608d..e1dc2f8 100644 --- a/S/paypal_return.shtml +++ b/S/paypal_return.shtml @@ -29,6 +29,12 @@ img{ border:0px; } + + + + @@ -114,10 +120,8 @@ style="border:0;width:88px;height:31px" This document last modified on -($Id: paypal_return.shtml,v 1.27 2016/08/18 09:53:42 gilles Exp gilles $) +($Id: paypal_return.shtml,v 1.32 2016/12/20 10:06:54 gilles Exp gilles $)

        - - @@ -135,11 +139,12 @@ var google_remarketing_only = false; + diff --git a/S/poll.shtml b/S/poll.shtml index 6bf4083..f24d5b6 100644 --- a/S/poll.shtml +++ b/S/poll.shtml @@ -18,7 +18,10 @@ - + + @@ -89,7 +92,7 @@ alt="Viewable With Any Browser" /> This document last modified on -($Id: poll.shtml,v 1.2 2016/07/21 22:55:54 gilles Exp gilles $)
        +($Id: poll.shtml,v 1.3 2016/12/20 10:06:54 gilles Exp gilles $)
        Top of the page

        diff --git a/S/robots.txt b/S/robots.txt new file mode 100644 index 0000000..4738d6a --- /dev/null +++ b/S/robots.txt @@ -0,0 +1,3 @@ +User-agent: * +Disallow: + diff --git a/S/style.css b/S/style.css index 9810de1..b2a0c73 100644 --- a/S/style.css +++ b/S/style.css @@ -1,31 +1,56 @@ -/* $Id: style.css,v 1.8 2016/01/21 00:58:22 gilles Exp gilles $ */ +/* $Id: style.css,v 1.12 2016/12/20 10:00:46 gilles Exp gilles $ */ /* http://www.w3schools.com/html/html5_browsers.asp */ + +/* header, section, footer, aside, nav, main, article, figure { - display: block; + display: inline-block; } +*/ body { color: black; - background-color: #eeffff + background-color: #eeffff; +} + +@media screen and ( min-width: 960px ) { + #left-menu { + float: left; + width: 50%; + } + + #centered-logo { + float: left; + width: 50%; + } + + #right-tronche { + float: right; + width: 60%; + } + + } + +@media screen and ( min-width: 1280px ) { + #left-menu { + float: left; + width: 40%; + } + + #centered-logo { + float: left; + width: 60%; + } } -#left-menu { - float: left; - width: 35%; -} - - -#centered-logo { - float: left; - width: 65%; -} +@media screen and ( min-width: 960px ) { div.list { - display: inline-block; - vertical-align: top; + display: inline-block; + vertical-align: top; +} } div.poll { @@ -34,15 +59,6 @@ div.poll { } -#full-page { - float: left; - width: 100%; -} - -#right-tronche { - float: right; - width: 60%; -} div.center { text-align: center; @@ -54,7 +70,8 @@ img { .none { - list-style-type: none; + /* list-style-type: none; + */ } .bold diff --git a/S/template_html5.shtml b/S/template_html5.shtml index 9a655a7..c2ce2ce 100755 --- a/S/template_html5.shtml +++ b/S/template_html5.shtml @@ -10,6 +10,13 @@ + + + + + This document was last modified on -($Id: template_html5.shtml,v 1.1 2016/08/05 14:27:39 gilles Exp gilles $)
        +($Id: template_html5.shtml,v 1.12 2017/09/11 03:04:46 gilles Exp gilles $)
        Top of the page

        diff --git a/S/template_xhtml1.shtml b/S/template_xhtml1.shtml index 90f85fa..4982ca8 100755 --- a/S/template_xhtml1.shtml +++ b/S/template_xhtml1.shtml @@ -19,6 +19,11 @@ + + + @@ -59,7 +64,7 @@ alt="Viewable With Any Browser" /> This document last modified on -($Id: template_xhtml1.shtml,v 1.5 2016/08/03 18:18:40 gilles Exp gilles $)
        +($Id: template_xhtml1.shtml,v 1.16 2017/09/11 03:04:46 gilles Exp gilles $)
        Top of the page

        diff --git a/S/tw-hash.html b/S/tw-hash.html old mode 100755 new mode 100644 diff --git a/S/tw-mention.html b/S/tw-mention.html old mode 100755 new mode 100644 diff --git a/TODO b/TODO index 33969f6..2a4c256 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: TODO,v 1.168 2016/08/19 14:17:53 gilles Exp gilles $ +# $Id: TODO,v 1.193 2017/09/05 15:23:26 gilles Exp gilles $ This documentation is also at http://imapsync.lamiral.info/#doc @@ -7,6 +7,97 @@ This documentation is also at http://imapsync.lamiral.info/#doc TODO file for imapsync ---------------------- +SUGGESTED 2017_09_04 by Gilles +STDOUT instead of STDERR with Mail::IMAPClient output. +Shoulbe easy using $imap->Debug_fh($fileHandle); + +SUGGESTED 2017_09_02 by Gilles +Check that @ARGV is empty after readding it by GetOptions since +remaining arguments are not used and might signal something wrong +in the command line arguments. + +SUGGESTED 2017_08_31 by Gilles +Makefile. Add a "make docker" goal that build, test and publish the +docker package on ks3. + +SUGGESTED 2017_08_22 by Ismael Baena +when hmailserver hierarchy delimiter is “\” +When imapsync asks hmailserver about namespace, hmailserver returns “\\” instead of “\”. +After that, imapsync fails when accessing any folder. Comparing hmailserver logs between +imapsync and outlook accessing the account, I see outlook quoting every path +while imapsync don’t, and outlook doesn’t fail. +I wrote a message to the hmailserver forum, +https://www.hmailserver.com/forum/viewtopic.php?f=7&t=31503 + + +SUGGESTED 2017_05_04 by Gilles +Verif ipv6 connection, seems to fail now +./imapsync --host1 2603:1026:200:52::2 --host2 2603:1026:200:52::2 --justconnect +... +Host1: connecting on host1 [2603:1026:200:52::2] port [143] +Host1: Can not open imap connection on [2603:1026:200:52::2]: Unable to connect to 2603:1026:200:52::2: Invalid argument + +SUGGESTED 2017_05_04 via github +Review the "make install" in Makefile + +SUGGESTED 2017_04_26 by Franco Fassio +--usecache with trailing dots foo... in folder name breaks on NTFS. + +SUGGESTED 2017_04_26 by Franco Fassio +Check that --maxbyteperseconds does not interfer with --timeout +by sleeping too long. + +SUGGESTED 2017_04_11 by Stefano Lo Cascio +Add a --donotsyncflags or similar (--syncflags) + +SUGGESTED 2016_12_01 by Gilles +When working under with webmin and virtualmin imapsync +acts as a cgi, it should not. Find a way to avoid cgi mode +even under a web server. + +SUGGESTED 2016_11_16 by Flávio Zarur Lucarelli LucaNet Sistemas +Getting subjects of messages for duplicates and print them. +Dates and sizes are easier printable because imapsync gets them each time. + +SUGGESTED 2016_10_24 by Gilles +Verify regex --delete2foldersbutnot and --delete2foldersonly are ok +before anything. + +SUGGESTED 2016_10_07 by Gilles +Write a FAQ file for packagers, +mostly how to get the dependency Perl modules complete. + +SUGGESTED 2016_10_07 by Gilles +Write a FAQ file about all errors and explain what they mean. +Maybe propose an action to solve them in the code, +or even solve them directly in the execution. + +SUGGESTED 2016_10_06 by Gilles +Document or fix behavior (do a AND), +curently "--search" makes "--maxage" and "--minage" ignored. + +SUGGESTED 2016_09_16 by Gilles +Add a check of all --regextrans2 before going further, +like what is done with --regexmess + +SUGGESTED 2016_08_25 by David Carter +It would be helpful if imapsync reported Message-Id:/From:/Subject +as well as folder name and message UID when it skips a message. + +SUGGESTED 2016_09_02 by Gilles & David Carter +Exchange Online errors that need a relogin: + "BAD User is authenticated but not connected." + "error while reading data from server: Connection reset by peer" + "timeout waiting 1200s for data from server" + + +SUGGESTED 2016_08_31 by Gilles +Rename $expungeaftereach $expungeaftereach1 or $expunge1aftereach + +SUGGESTED 2016_08_31 by Gilles & David Carter +Detect equivalent folders by upper/lower case on host1 +and add a way to not merge them when host2 is case insensitive. + SUGGESTED 2016_08_19 by Gilles Go back to SSL_VERIFY_PEER but include SSL_ca_file inside imapsync or near. @@ -20,8 +111,9 @@ Add a meaningful exit value to all die: * fatal permission file issue (open) * fatal IMAP issue * fatal IMAP disconnection +Maybe replace all die by exit Add a meaningful exit value to all exit - * exit at end but with errors + * exit at end but with errors * exit at middle because of errormax * exit by signal @@ -36,7 +128,7 @@ https://about.validator.nu/ SUGGESTED 2016_07_12 by Fronik With --automap apply the mapping to subfolders of mapped folders. -If +If Sent => Envoyes then Sent.Foo => Envoyes.Foo @@ -44,22 +136,15 @@ Sent.Foo.Bar => Envoyes.Foo.bar SUGGESTED 2016_07_07 by Jean-Dominique Delyon. Add a way to know easily which account transfers went wrong. -Générer un fichier des comptes qui ont rencontré des problèmes +Générer un fichier des comptes qui ont rencontré des problèmes et afficher le contenu à la fin de la boucle sur les comptes. SUGGESTED 2016_06_29 by Gilles Clarify system flags in RFC Example to add: -If \Forwarded is not in PERMANENTFLAGS but \* is then transform +If \Forwarded is not in PERMANENTFLAGS but \* is, then transform \Forwarded to Forwarded. And by default. -SUGGESTED 2016_06_29 by Gilles -Add --gmail1 --gmail2 --gmail12 to set automatically advices from -https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt -Add --exchange --office365 to set automatically advices from -https://imapsync.lamiral.info/FAQ.d/FAQ.Exchange.txt - - SUGGESTED 2016_06_13 by David Carter --pipemess could also treat stderr ` $command < $input_tmpfile > $output_tmpfile 2> $error_tmpfile ` @@ -108,7 +193,7 @@ In order to avoid useless headaches from --regexmess, add SUGGESTED 2016_06_09 by David Carter Add --pipemess-on-fail -If, and only if, the target server responses with NO or BAD then have another go +If, and only if, the target server responses with NO or BAD then have another go with a sanitized version of the message. SUGGESTED 2016_06_01 by M. Beaubien @@ -119,9 +204,6 @@ no header found so adding our own [Message-Id: <151648@imapsync>] SUGGESTED 2016_04_17 by Gilles Add a --passfile to allow user=>password style file. -SUGGESTED 2016_04_13 by Gilles -Split --noabletosearch in --noabletosearch1 --noabletosearch2 - WANTED 2016_03_11 Add a FAQ about Authentication failures and quoting. @@ -161,7 +243,7 @@ TB WANTED 2015_12_16 Gilles Lamiral -Add "df -i" with usecache and abort if the number of messages +Add "df -i" with usecache and abort if the number of messages to transfer will exhaust empty inodes used by the cache. Looks like module Filesys::DfPortable will help for Unix and Win32. @@ -170,15 +252,15 @@ WANTED 2016_01_28 Stephen Sookdeo List all emails that gives errors so you know exactly which. List with detailed info. Then ability to perform action on these specific emails like delete or ignore per email. -WANTED 2015_06_02 Karen F Bath. +WANTED 2015_06_02 Karen F Bath. Add skipped messages in the final dump. Print the list of messages not copied and why (duplicates or void header). I would like to request if you could add additional errors to the bottom, -as we find that things like MaxLineLength and maxsize limit are classed -as skipped messages and in my opinion are errors; as the email message +as we find that things like MaxLineLength and maxsize limit are classed +as skipped messages and in my opinion are errors; as the email message is not transferred but this is not logged at the bottom. We have our own scan script which we run on all log files at the end -and copy the users logs into subfolders that have issues. +and copy the users logs into subfolders that have issues. I've attached a list of things we search for. "Error", "Output" @@ -219,9 +301,9 @@ Add duplicates test option. WANTED 2015_03_06 Dealing with Content-Type Message/Partial -Extract the components of the partial messages and construct them +Extract the components of the partial messages and construct them with reformime as one message which can then be transferred. (Larry Moore) -See also uudeview http://www.fpx.de/fp/Software/UUDeview/ +See also uudeview http://www.fpx.de/fp/Software/UUDeview/ (Larry said uudeview is weird on Partial issue, too old maybe) Apply --disarmreadreceipts only to UNSEEN messages. @@ -231,7 +313,7 @@ The goal is to know easily why to restart later. Write a Mail::imapsync package and use it. -One day, when I have really nothing better to do, evaluate: +One day, when I have really nothing better to do, evaluate: http://www.rackspace.com/apps/email_hosting/migrations http://www.yippiemove.com/ http://www.migrationwiz.com/ @@ -246,7 +328,7 @@ Move --help documentation into the man page so that description is easier to fin Fix bug found by Pavel Stano on 01/06/2012 (june) imapsync never stop login when login fails with a "* BYE Temp error" from server. -Consider /var/tmp/ instead of /tmp (/tmp is destoyed +Consider /var/tmp/ instead of /tmp (/tmp is destoyed on some Unix at reboot) Fix long path over than 260 character on Win32 with --usecache @@ -269,23 +351,23 @@ been a big help. Explain that users can win time/bandwidth by using --expunge Fix "\Forwarded" flag bug in courier. -Does \lalala can be forbidden (courier does a +Does \lalala can be forbidden (courier does a "16 NO Error in IMAP command received by server" -with +with * OK [PERMANENTFLAGS (\* \Draft \Answered \Flagged \Deleted \Seen)] Limited Add sync imap keywords. Sync Gmail labels to imap keyword http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=503159 http://www.linux-france.org/prj/imapsync_list/msg00022.html http://mail.google.com/support/bin/answer.py?hl=en&answer=77657 -http://mail.google.com/support/bin/answer.py?answer=78892 +http://mail.google.com/support/bin/answer.py?answer=78892 Add and option to sync to & from files. Add an --aclregextrans2 flag. -"Today we discovered, that Cyrus and Dovecot use different characters for -their ACLs. Syncing ACLs vom Cyrus to Dovecot (at least 1.2) doesn't -work. Cyrus uses c and d, Dovecot uses k and x instead." +"Today we discovered, that Cyrus and Dovecot use different characters for +their ACLs. Syncing ACLs vom Cyrus to Dovecot (at least 1.2) doesn't +work. Cyrus uses c and d, Dovecot uses k and x instead." Peer Heinlein. Add more information about skipped messages. @@ -294,13 +376,13 @@ Add Rick Romero patch with --quiet No output at all --showstats intended for use with --quiet -Take a look at Mail::IMAPTalk +Take a look at Mail::IMAPTalk Simon Bertrang said "way better performance, less problems, easier to use and no -issues so far". Sounds good! +issues so far". Sounds good! imapsync doesn't report well. It should says "I had to sync 123 messages but I could transfer only 99 messages" -Maybe count messages not transfered because they're dupplicate. +Maybe count messages not transferred because they're dupplicate. Fix bug "not possible to use space in the imap password" @@ -328,6 +410,33 @@ http://asg.web.cmu.edu/cyrus/download/imapd/altnamespace.html Now the TODO done! (or not) =========================================================================== +SUGGESTED 2016_12_14 by Gilles +DONE 2017_08_31 by Gilles +Look at Pod::Usage and convert the actual doc to it + +DONE 2017_04_24 by Gilles +SUGGESTED 2016_11_29 by Gilles +Fix bug passfile no exist => login +Should be fatal sooner. + +SUGGESTED 2016_06_29 by Gilles +DONE 2017/03/13 by gilles in revision 1.782 +Add --gmail1 --gmail2 --gmail12 to set automatically advices from +https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt +Add --exchange --office365 to set automatically advices from +https://imapsync.lamiral.info/FAQ.d/FAQ.Exchange.txt +Add --domino1 --domino2 + +DONE 2016_09_29 by Gilles +SUGGESTED 2016_04_13 by Gilles +Split --noabletosearch in --noabletosearch1 --noabletosearch2 + + +SUGGESTED 2016_09_29 by Gilles +DONE with revision 1.764 2017/01/19 +Try to use TLS or SSL by default unless not asked to do so. + + SUGGESTED 2016_06_22 by Gilles DONE 2016_07_29 by Gilles Make reconnections launched by a signal Ctrl-c, aka INT signal. @@ -363,15 +472,15 @@ DONE 2015_12_25 Gilles Lamiral Add --ssldebug 0-4 DONE 2015_10_06. Find a way to avoid passwords in --debugimap unless needed. -Proposed in Mail-IMAPClient via $imap->Showcredentials() +Proposed in Mail-IMAPClient via $imap->Showcredentials() in patch at See https://rt.cpan.org/Public/Bug/Display.html?id=107592 -DONE 2015_12_03 WANTED 2015_11_24 Jens Herrmann -Add --logdir to allow imapsync choosing the filename while allowing +DONE 2015_12_03 WANTED 2015_11_24 Jens Herrmann +Add --logdir to allow imapsync choosing the filename while allowing user to choose the dirname part. -DONE. 2015_08_10. +DONE. 2015_08_10. Guess separators and prefixes when NAMESPACE is not available, instead of forcing the user to guess and set them. @@ -379,13 +488,13 @@ DONE 2015_08_03. WANTED 2015_07_21 Fix W/learn/imap_utf7_encode --regextrans2 "s,El&AOk-ments,&AMk-l&AOk-ments," -DONE. Add a FAQ entry about long path over than 260 character on Win32. +DONE. Add a FAQ entry about long path over than 260 character on Win32. DONE. Build and distribute a standalone Darwin Mac OS X binary. It's called imapsync_bin_Darwin -DONE. Add a NOP for host2 for each fake copy in --dry mode. +DONE. Add a NOP for host2 for each fake copy in --dry mode. Goal is to avoid timeouts happening only because of --dry DONE 2015_05_09 WANTED 2015_04_25 @@ -396,7 +505,7 @@ On Windows: DONE. Quota are read if available and warning is printed if 90% quota reached. -Can you setup an option to make it stop if the destination mailbox reports +Can you setup an option to make it stop if the destination mailbox reports that it is over quota? @@ -406,12 +515,12 @@ that - in example, to write each mail to stdout, pipe that to the conversion program, and read the result from stdin - and this all before the mail will transfer to the target imap-server" http://www.courier-mta.org/maildrop/reformime.html -Look at IPC::Open2, assuming a good and safe pipe, +Look at IPC::Open2, assuming a good and safe pipe, or write more code handling all the bad stranger behaviours possible. Option name: --pipemess "command arg1 arg2 ..." -DONE. Transform messages with too long linelength. +DONE. Transform messages with too long linelength. Office365 and Exchange abort connexion when they encounter a message with more than 10000 characters on a single line. Could be done with the previous --pipemess with reformime. @@ -422,7 +531,7 @@ Usage: --maxlinelength 9900 maxlinelengthcmd 'reformime -r7' DONE. Add DavMail in Similar Softwares section. http://davmail.sourceforge.net/ DONE. Convert folder names to utf-8 and print them next to the uft-7 ones. -Look at imapsync/W/learn/ +Look at imapsync/W/learn/ ./imap_utf7 data_utf7 DONE. Separate the online site in a folder site/ or www/ and make the upper directory simple. @@ -454,16 +563,16 @@ NEVER. Use examine() instead of select() in --dry mode. Add a method doing the switch automagicaly. DONE. Write --disarmreadreceipts that does: - --regexmess 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' + --regexmess 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' -DONE. With --foldersizes make the listing on host2 independent of case +DONE. With --foldersizes make the listing on host2 independent of case (avoid "not yet created" if the folder exists in another case string) DONE. Write --maxmessagespersecond and --maxbytespersecond for staying under Microsoft's throttling policies. DONE. Inform about --addheader when the problem occurs "(no wanted headers so we ignore this message)" -DONE. Print the timeout value. +DONE. Print the timeout value. DONE. Inform --timeout is is seconds. DONE. Add an entry to http://lsm.qqx.org/lsm/ @@ -475,7 +584,7 @@ http://www.linux-france.org/prj/imapsync_list/msg00307.html DONE. Remove 2.2.9 Mail::IMAPClient support. -DONE. Add OAUTH autentication support +DONE. Add OAUTH autentication support https://developers.google.com/google-apps/gmail/oauth_overview DONE. Add --delete1 as an alias for --delete @@ -483,13 +592,13 @@ DONE. Add --delete1 as an alias for --delete DONE. Add current date at the beginning of the run, useful when imapsync doesn't finish with statistics. -DONE. Add automatic convertion or detection when +DONE. Add automatic convertion or detection when separator inversion produces an invalid character. From uw to cyrus, for example : FoldA/FoldB.ext -> FoldA.FoldB/ext DONE. Not done since useless now (--useuid) -Add a --skipheaderinfolder option +Add a --skipheaderinfolder option DONE. Not fixed since only reported once a long time ago. Fix this: @@ -498,7 +607,7 @@ Fix this: > 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. @@ -514,7 +623,7 @@ are available: http://www.linux-france.org/prj/imapsync_list/msg01151.html http://www.linux-france.org/prj/imapsync_list/msg01158.html -DONE. Add a note about +DONE. Add a note about "One other thing: You might want to warn idiots like me, that if your cache resides on a filesystem with a limited number of inodes such as ext4, your inodes will be exhausted really fast (check with df -i). I @@ -526,7 +635,7 @@ http://support.google.com/a/bin/answer.py?hl=en&answer=1071518 DONE. Check if a message exists before fetching it (could have been deleted recently) (Check avoided when UID mode is not available) -DONE. Change default --useheader 'Message-ID' --useheader Date to +DONE. Change default --useheader 'Message-ID' --useheader Date to --useheader 'Message-ID' --useheader 'Received' because Exchange changes Date header! (but not Received:) @@ -539,8 +648,8 @@ if needed. Not a script but command lines in INSTALL file. DONE. Post on imapsync mailing-list when a new release comes. No since I no longer distribute it gratis, imapsync detects -itself a new release and buyers are informed by a specific -list. I know some packagers (FreeBSD) use the Changelog file +itself a new release and buyers are informed by a specific +list. I know some packagers (FreeBSD) use the Changelog file to detect an update. DONE. Subscribe users to imapsync_update mailing-list automatically after the payment. @@ -559,7 +668,7 @@ http://www.bwebcentral.com/utils/imapsync-yahoo See patches/imapsync-yahoo -DONE. Add --subscribe by default. +DONE. Add --subscribe by default. Subscribe only when needed (not already subscribed). DONE. Ask Nick Czeczulin why he wrote patent "Method for mailbox migration" @@ -591,13 +700,13 @@ DONE. Add --authmd51 --authmd52 to permit authmd5 by host. DONE. Write option --delete2foldersonly regex. Example: to permit a sync in a subfolder with --delete2folder ---regextrans2 's#(.*)#NEW/$1#' --delete2foldersonly /^NEW/ +--regextrans2 's#(.*)#NEW/$1#' --delete2foldersonly /^NEW/ DONE. Write option --delete2foldersbutnot regex. Example: to permit a sync but not deleting folder OLD ---delete2foldersbutnot /^OLD/ +--delete2foldersbutnot /^OLD/ -DONE. Add cache to speed up transfer. Option --usecache +DONE. Add cache to speed up transfer. Option --usecache DONE. There was a time imapsync took the whole message when the header was bad (empty). But it was bad for speed with big @@ -611,15 +720,15 @@ target account? The --delete2 option only seems to delete individual messages, not folders." DONE. Add NTLM authentification support. Mail-IMAPClient-3.25 -support it. +support it. http://cpansearch.perl.org/src/BUZZ/NTLM-1.05/NTLM.pm http://curl.haxx.se/rfc/ntlm.html DONE. Evaluate memory consumption with (or better): print qx{ ps o pid,pcpu,comm,vsz,rss,size $$ }, "\n" -Search memory leaks with +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_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 @@ -651,7 +760,7 @@ subscription on the source server? Perhaps --subscribeall? DONE. Add an option to make imapsync automatically reconnect when the connection drops -DONE. Add Google adsence to imapsync website to see if it can help. +DONE. Add Google adsence to imapsync website to see if it can help. DONE. Be "FLAGS.SILENT" the normal behavior instead of "+FLAGS.SILENT". @@ -668,11 +777,11 @@ to check usernames and passwords. DONE. Add a --tmpdir option. -DONE. Fix bug "Found that if folders have a space at the end of -the name, it will not create the folder name on the new +DONE. Fix bug "Found that if folders have a space at the end of +the name, it will not create the folder name on the new server, nor will it copy that folder's email." Added regression test checking this. -Could not reproduce this bug. +Could not reproduce this bug. Seems to be a old imapsync bug with 2.2.9 @@ -694,7 +803,7 @@ Sorting by default by internal date is bad with migrations and delayed arrivals. An user option would be good. DONE. -Add failure return code in case of +Add failure return code in case of last FOLDER if $from->IsUnconnected(); last FOLDER if $to->IsUnconnected(); See Phil Lobbes messages (18 Sep 2008) @@ -723,18 +832,18 @@ with no header. It may be a bad message with really no header or it may be a imap server problem, the server gives no header for this message. In that case imapsync gets the whole message to see if there is the same on the other side. It slows the transfer -of course. I think I'll change imapsync behavior and let it +of course. I think I'll change imapsync behavior and let it give up those bad messages missing an header. DONE. Make --syncinternaldates turn on by default -DONE. Check imapsync with gmail (dates problem?). +DONE. Check imapsync with gmail (dates problem?). DONE. Start an imap internet scan project. -DONE. Fix --ssl --justconnect bug +DONE. Fix --ssl --justconnect bug -DONE. Fix --ssl needs --authmech login with gmail. Why? +DONE. Fix --ssl needs --authmech login with gmail. Why? DONE. Try a 50Mo message transfer (slow ?) fast! @@ -769,7 +878,7 @@ http://groups.google.fr/group/comp.mail.imap to talk about imapsync DONE. Add a --recurse option when --folder option is used. -No I won't since this feature can be done by doing a +No I won't since this feature can be done by doing a --include '^INBOX.MyFolder' Yes done with --folderrec @@ -797,7 +906,7 @@ DONE. Add in doc: Does imapsync support IMAP over TLS (IMAPS)? DONE. Add the licence of each IMAP software (the free ones). -DONE. Add MailEnable version 1.54 if +DONE. Add MailEnable version 1.54 if Javier Gomez succeed. He failed. MailEnable is an early stage developpment IMAP server. @@ -826,7 +935,7 @@ DONE. Add a --subscribed option to transfert only subscribed DONE. Add a CREDITS file. -DONE. Pb with namespace INBOX. Some IMAP servers +DONE. Pb with namespace INBOX. Some IMAP servers don't have this CAPABILITY http://www.inter7.com/courierimap/FAQ.html#namespace http://www.rfc-editor.org/rfc/rfc2342.txt diff --git a/VERSION b/VERSION index fe5eb12..35c4846 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.727 +1.836 diff --git a/VERSION_EXE b/VERSION_EXE index fe5eb12..35c4846 100644 --- a/VERSION_EXE +++ b/VERSION_EXE @@ -1 +1 @@ -1.727 +1.836 diff --git a/W/.BUILD_EXE_TIME b/W/.BUILD_EXE_TIME index 45a14a0..676bf4a 100644 --- a/W/.BUILD_EXE_TIME +++ b/W/.BUILD_EXE_TIME @@ -441,3 +441,139 @@ 1471606171 BEGIN 1.727 : vendredi 19 août 2016, 13:29:31 (UTC+0200) 1471616659 BEGIN 1.727 : vendredi 19 août 2016, 16:24:19 (UTC+0200) 1471617309 END 1.727 : vendredi 19 août 2016, 16:35:09 (UTC+0200) +1474122976 BEGIN 1.730 : samedi 17 septembre 2016, 16:36:16 (UTC+0200) +1474123287 END 1.730 : samedi 17 septembre 2016, 16:41:27 (UTC+0200) +1475152767 BEGIN 1.731 : jeudi 29 septembre 2016, 14:39:27 (UTC+0200) +1475153042 END 1.731 : jeudi 29 septembre 2016, 14:44:02 (UTC+0200) +1475183016 BEGIN 1.732 : jeudi 29 septembre 2016, 23:03:36 (UTC+0200) +1475183329 END 1.732 : jeudi 29 septembre 2016, 23:08:49 (UTC+0200) +1476189796 BEGIN 1.737 : mardi 11 octobre 2016, 14:43:16 (UTC+0200) +1476190171 END 1.737 : mardi 11 octobre 2016, 14:49:31 (UTC+0200) +1478207726 BEGIN 1.739 : jeudi 3 novembre 2016, 22:15:26 (UTC+0100) +1478208016 END 1.739 : jeudi 3 novembre 2016, 22:20:16 (UTC+0100) +1479397595 BEGIN 1.740 : jeudi 17 novembre 2016, 16:46:36 (UTC+0100) +1479397878 END 1.740 : jeudi 17 novembre 2016, 16:51:18 (UTC+0100) +1479853031 BEGIN 1.741 : mardi 22 novembre 2016, 23:17:11 (UTC+0100) +1479853321 END 1.741 : mardi 22 novembre 2016, 23:22:01 (UTC+0100) +1482594346 BEGIN 1.747 : samedi 24 décembre 2016, 16:45:46 (UTC+0100) +1483589059 BEGIN 1.749 : jeudi 5 janvier 2017, 05:04:19 (UTC+0100) +1483589684 BEGIN 1.749 : jeudi 5 janvier 2017, 05:14:44 (UTC+0100) +1483589923 END 1.749 : jeudi 5 janvier 2017, 05:18:43 (UTC+0100) +1483624220 BEGIN 1.750 : jeudi 5 janvier 2017, 14:50:20 (UTC+0100) +1483624536 END 1.750 : jeudi 5 janvier 2017, 14:55:36 (UTC+0100) +1483945333 BEGIN 1.751 : lundi 9 janvier 2017, 08:02:13 (UTC+0100) +1483949465 BEGIN 1.751 : lundi 9 janvier 2017, 09:11:05 (UTC+0100) +1483984043 BEGIN 1.751 : lundi 9 janvier 2017, 18:47:23 (UTC+0100) +1484009458 BEGIN 1.752 : mardi 10 janvier 2017, 01:50:58 (UTC+0100) +1484009742 END 1.752 : mardi 10 janvier 2017, 01:55:42 (UTC+0100) +1484112177 BEGIN 1.753 : mercredi 11 janvier 2017, 06:22:57 (UTC+0100) +1484112484 END 1.753 : mercredi 11 janvier 2017, 06:28:04 (UTC+0100) +1484217375 BEGIN 1.757 : jeudi 12 janvier 2017, 11:36:15 (UTC+0100) +1484217700 END 1.757 : jeudi 12 janvier 2017, 11:41:40 (UTC+0100) +1484516992 BEGIN 1.758 : dimanche 15 janvier 2017, 22:49:52 (UTC+0100) +1484517360 END 1.758 : dimanche 15 janvier 2017, 22:56:00 (UTC+0100) +1484577677 BEGIN 1.759 : lundi 16 janvier 2017, 15:41:17 (UTC+0100) +1484578003 END 1.759 : lundi 16 janvier 2017, 15:46:43 (UTC+0100) +1484628512 BEGIN 1.760 : mardi 17 janvier 2017, 05:48:32 (UTC+0100) +1484628850 END 1.760 : mardi 17 janvier 2017, 05:54:10 (UTC+0100) +1484633474 BEGIN 1.761 : mardi 17 janvier 2017, 07:11:14 (UTC+0100) +1484633792 END 1.761 : mardi 17 janvier 2017, 07:16:32 (UTC+0100) +1484788241 BEGIN 1.763 : jeudi 19 janvier 2017, 02:10:41 (UTC+0100) +1484788555 END 1.763 : jeudi 19 janvier 2017, 02:15:55 (UTC+0100) +1484803145 BEGIN 1.765 : jeudi 19 janvier 2017, 06:19:05 (UTC+0100) +1484804058 BEGIN 1.766 : jeudi 19 janvier 2017, 06:34:18 (UTC+0100) +1484804378 END 1.766 : jeudi 19 janvier 2017, 06:39:38 (UTC+0100) +1484805361 BEGIN 1.767 : jeudi 19 janvier 2017, 06:56:01 (UTC+0100) +1484805735 END 1.767 : jeudi 19 janvier 2017, 07:02:16 (UTC+0100) +1484806480 BEGIN 1.768 : jeudi 19 janvier 2017, 07:14:40 (UTC+0100) +1484806804 END 1.768 : jeudi 19 janvier 2017, 07:20:04 (UTC+0100) +1485900842 BEGIN 1.771 : mardi 31 janvier 2017, 23:14:02 (UTC+0100) +1485901133 BEGIN 1.771 : mardi 31 janvier 2017, 23:18:53 (UTC+0100) +1485901561 END 1.771 : mardi 31 janvier 2017, 23:26:01 (UTC+0100) +1487116017 BEGIN 1.773 : mercredi 15 février 2017, 00:46:57 (UTC+0100) +1487157193 BEGIN 1.773 : mercredi 15 février 2017, 12:13:13 (UTC+0100) +1487169674 BEGIN 1.774 : mercredi 15 février 2017, 15:41:14 (UTC+0100) +1487188465 BEGIN 1.774 : mercredi 15 février 2017, 20:54:25 (UTC+0100) +1487240884 BEGIN 1.774 : jeudi 16 février 2017, 11:28:04 (UTC+0100) +1487296664 BEGIN 1.775 : vendredi 17 février 2017, 02:57:44 (UTC+0100) +1487296925 END 1.775 : vendredi 17 février 2017, 03:02:05 (UTC+0100) +1488337707 BEGIN 1.777 : mercredi 1 mars 2017, 04:08:28 (UTC+0100) +1488338331 END 1.777 : mercredi 1 mars 2017, 04:18:51 (UTC+0100) +1489416028 BEGIN 1.783 : lundi 13 mars 2017, 15:40:28 (UTC+0100) +1489416325 END 1.783 : lundi 13 mars 2017, 15:45:25 (UTC+0100) +1489514968 BEGIN 1.785 : mardi 14 mars 2017, 19:09:28 (UTC+0100) +1489515233 END 1.785 : mardi 14 mars 2017, 19:13:53 (UTC+0100) +1489980931 BEGIN 1.786 : lundi 20 mars 2017, 04:35:31 (UTC+0100) +1490084192 BEGIN 1.788 : mardi 21 mars 2017, 09:16:32 (UTC+0100) +1490084443 END 1.788 : mardi 21 mars 2017, 09:20:43 (UTC+0100) +1492680526 BEGIN 1.794 : jeudi 20 avril 2017, 11:28:46 (UTC+0200) +1492680802 END 1.794 : jeudi 20 avril 2017, 11:33:22 (UTC+0200) +1493248850 BEGIN 1.803 : jeudi 27 avril 2017, 01:20:50 (UTC+0200) +1493249119 END 1.803 : jeudi 27 avril 2017, 01:25:19 (UTC+0200) +1493253906 BEGIN 1.804 : jeudi 27 avril 2017, 02:45:06 (UTC+0200) +1493254173 END 1.804 : jeudi 27 avril 2017, 02:49:33 (UTC+0200) +1493298460 BEGIN 1.805 : jeudi 27 avril 2017, 15:07:40 (UTC+0200) +1493299002 BEGIN 1.805 : jeudi 27 avril 2017, 15:16:42 (UTC+0200) +1493299269 END 1.805 : jeudi 27 avril 2017, 15:21:09 (UTC+0200) +1493387151 BEGIN 1.807 : vendredi 28 avril 2017, 15:45:51 (UTC+0200) +1493387431 END 1.807 : vendredi 28 avril 2017, 15:50:31 (UTC+0200) +1493578212 BEGIN 1.807 : dimanche 30 avril 2017, 20:50:12 (UTC+0200) +1493578413 END 1.807 : dimanche 30 avril 2017, 20:53:33 (UTC+0200) +1493586266 BEGIN 1.807 : dimanche 30 avril 2017, 23:04:26 (UTC+0200) +1493586762 END 1.807 : dimanche 30 avril 2017, 23:12:42 (UTC+0200) +1493587646 BEGIN 1.807 : dimanche 30 avril 2017, 23:27:26 (UTC+0200) +1493588141 END 1.807 : dimanche 30 avril 2017, 23:35:41 (UTC+0200) +1493642636 BEGIN 1.807 : lundi 1 mai 2017, 14:43:56 (UTC+0200) +1493642871 END 1.807 : lundi 1 mai 2017, 14:47:51 (UTC+0200) +1493662775 BEGIN 1.807 : lundi 1 mai 2017, 20:19:35 (UTC+0200) +1493663003 END 1.807 : lundi 1 mai 2017, 20:23:23 (UTC+0200) +1493676290 BEGIN 1.807 : mardi 2 mai 2017, 00:04:50 (UTC+0200) +1493676496 END 1.807 : mardi 2 mai 2017, 00:08:16 (UTC+0200) +1493676673 BEGIN 1.807 : mardi 2 mai 2017, 00:11:13 (UTC+0200) +1493676871 END 1.807 : mardi 2 mai 2017, 00:14:31 (UTC+0200) +1493685869 BEGIN 1.807 : mardi 2 mai 2017, 02:44:29 (UTC+0200) +1493686077 END 1.807 : mardi 2 mai 2017, 02:47:57 (UTC+0200) +1493709285 BEGIN 1.807 : mardi 2 mai 2017, 09:14:45 (UTC+0200) +1493709482 END 1.807 : mardi 2 mai 2017, 09:18:02 (UTC+0200) +1493710750 BEGIN 1.807 : mardi 2 mai 2017, 09:39:10 (UTC+0200) +1493710951 END 1.807 : mardi 2 mai 2017, 09:42:31 (UTC+0200) +1493714417 BEGIN 1.807 : mardi 2 mai 2017, 10:40:17 (UTC+0200) +1493714614 END 1.807 : mardi 2 mai 2017, 10:43:34 (UTC+0200) +1493746207 BEGIN 1.807 : mardi 2 mai 2017, 19:30:07 (UTC+0200) +1493746268 BEGIN 1.807 : mardi 2 mai 2017, 19:31:08 (UTC+0200) +1493746540 END 1.807 : mardi 2 mai 2017, 19:35:40 (UTC+0200) +1493747268 BEGIN 1.808 : mardi 2 mai 2017, 19:47:48 (UTC+0200) +1493747469 END 1.808 : mardi 2 mai 2017, 19:51:09 (UTC+0200) +1493749409 BEGIN 1.808 : mardi 2 mai 2017, 20:23:29 (UTC+0200) +1493749606 END 1.808 : mardi 2 mai 2017, 20:26:46 (UTC+0200) +1493750039 BEGIN 1.808 : mardi 2 mai 2017, 20:33:59 (UTC+0200) +1493750963 BEGIN 1.810 : mardi 2 mai 2017, 20:49:23 (UTC+0200) +1493751248 END 1.810 : mardi 2 mai 2017, 20:54:08 (UTC+0200) +1495648275 BEGIN 1.813 : mercredi 24 mai 2017, 19:51:15 (UTC+0200) +1495648641 END 1.813 : mercredi 24 mai 2017, 19:57:21 (UTC+0200) +1499474148 BEGIN 1.819 : samedi 8 juillet 2017, 02:35:48 (UTC+0200) +1499537272 BEGIN 1.819 : samedi 8 juillet 2017, 20:07:52 (UTC+0200) +1499610623 BEGIN 1.819 : dimanche 9 juillet 2017, 16:30:23 (UTC+0200) +1499627770 BEGIN 1.819 : dimanche 9 juillet 2017, 21:16:10 (UTC+0200) +1499628010 END 1.819 : dimanche 9 juillet 2017, 21:20:10 (UTC+0200) +1499729465 BEGIN 1.819 : mardi 11 juillet 2017, 01:31:05 (UTC+0200) +1499729716 END 1.819 : mardi 11 juillet 2017, 01:35:16 (UTC+0200) +1501096358 BEGIN 1.825 : mercredi 26 juillet 2017, 21:12:38 (UTC+0200) +1501096497 BEGIN 1.825 : mercredi 26 juillet 2017, 21:14:57 (UTC+0200) +1501096673 BEGIN 1.825 : mercredi 26 juillet 2017, 21:17:53 (UTC+0200) +1501096738 BEGIN 1.825 : mercredi 26 juillet 2017, 21:18:58 (UTC+0200) +1501097034 END 1.825 : mercredi 26 juillet 2017, 21:23:54 (UTC+0200) +1502873680 BEGIN 1.825 : mercredi 16 août 2017, 10:54:41 (UTC+0200) +1502886497 BEGIN 1.825 : mercredi 16 août 2017, 14:28:17 (UTC+0200) +1502887469 BEGIN 1.825 : mercredi 16 août 2017, 14:44:29 (UTC+0200) +1502887710 END 1.825 : mercredi 16 août 2017, 14:48:30 (UTC+0200) +1503494561 BEGIN 1.829 : mercredi 23 août 2017, 15:22:41 (UTC+0200) +1503939535 BEGIN 1.831 : lundi 28 août 2017, 18:58:55 (UTC+0200) +1503939776 END 1.831 : lundi 28 août 2017, 19:02:56 (UTC+0200) +1504149108 BEGIN 1.833 : jeudi 31 août 2017, 05:11:48 (UTC+0200) +1504149402 END 1.833 : jeudi 31 août 2017, 05:16:42 (UTC+0200) +1504156366 BEGIN 1.834 : jeudi 31 août 2017, 07:12:46 (UTC+0200) +1504156668 END 1.834 : jeudi 31 août 2017, 07:17:48 (UTC+0200) +1504415626 BEGIN 1.835 : dimanche 3 septembre 2017, 07:13:46 (UTC+0200) +1504628756 BEGIN 1.836 : mardi 5 septembre 2017, 18:25:56 (UTC+0200) +1504629099 END 1.836 : mardi 5 septembre 2017, 18:31:39 (UTC+0200) diff --git a/W/.tests.errors.txt b/W/.tests.errors.txt index 8beaca0..d45e5a5 100644 --- a/W/.tests.errors.txt +++ b/W/.tests.errors.txt @@ -59,3 +59,1115 @@ 2016_08_19_16_55_43 : ALL 2 TESTS SUCCESSFUL 2016_08_19_19_54_03 : ALL 1 TESTS SUCCESSFUL 2016_08_19_20_18_58 : ALL 115 TESTS SUCCESSFUL +2016_09_01_03_17_27 : ALL 1 TESTS SUCCESSFUL +2016_09_01_03_17_32 : ALL 2 TESTS SUCCESSFUL +2016_09_01_03_18_02 : ALL 1 TESTS SUCCESSFUL +2016_09_01_03_18_05 : ALL 2 TESTS SUCCESSFUL +2016_09_01_03_18_20 : ALL 1 TESTS SUCCESSFUL +2016_09_01_03_18_22 : FAILED 1/2 TESTS: free_ssl +2016_09_01_03_18_40 : ALL 1 TESTS SUCCESSFUL +2016_09_01_03_18_42 : ALL 2 TESTS SUCCESSFUL +2016_09_16_00_28_20 : ALL 1 TESTS SUCCESSFUL +2016_09_16_00_47_52 : ALL 116 TESTS SUCCESSFUL +2016_09_17_17_00_49 : ALL 1 TESTS SUCCESSFUL +2016_09_17_17_19_08 : ALL 116 TESTS SUCCESSFUL +2016_09_26_11_12_41 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_13_55 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_14_36 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_15_17 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_15_48 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_16_29 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_17_53 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_18_33 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_19_34 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_19_44 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_20_24 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_20_24 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_21_55 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_21_56 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_22_20 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_22_20 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_22_28 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_22_28 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_22_43 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_22_53 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_23_39 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_24_28 : ALL 2 TESTS SUCCESSFUL +2016_09_26_11_25_08 : ALL 1 TESTS SUCCESSFUL +2016_09_26_11_25_53 : ALL 3 TESTS SUCCESSFUL +2016_09_29_12_01_21 : ALL 1 TESTS SUCCESSFUL +2016_09_29_12_01_32 : ALL 2 TESTS SUCCESSFUL +2016_09_29_12_02_50 : ALL 1 TESTS SUCCESSFUL +2016_09_29_12_02_54 : ALL 2 TESTS SUCCESSFUL +2016_09_29_12_11_16 : ALL 1 TESTS SUCCESSFUL +2016_09_29_12_11_19 : ALL 2 TESTS SUCCESSFUL +2016_09_29_12_11_48 : ALL 1 TESTS SUCCESSFUL +2016_09_29_12_11_52 : ALL 2 TESTS SUCCESSFUL +2016_09_29_12_12_54 : FAILED 1/1 TESTS: perl_syntax +2016_09_29_12_14_52 : ALL 1 TESTS SUCCESSFUL +2016_09_29_12_14_55 : ALL 2 TESTS SUCCESSFUL +2016_09_29_12_16_10 : ALL 1 TESTS SUCCESSFUL +2016_09_29_12_16_14 : ALL 2 TESTS SUCCESSFUL +2016_09_29_13_44_54 : ALL 1 TESTS SUCCESSFUL +2016_09_29_13_44_58 : ALL 2 TESTS SUCCESSFUL +2016_09_29_14_15_45 : ALL 1 TESTS SUCCESSFUL +2016_09_29_14_15_48 : ALL 2 TESTS SUCCESSFUL +2016_09_29_14_17_05 : ALL 1 TESTS SUCCESSFUL +2016_09_29_14_17_07 : FAILED 1/2 TESTS: ll_noabletosearch1 +2016_09_29_14_23_01 : ALL 1 TESTS SUCCESSFUL +2016_09_29_14_23_04 : ALL 2 TESTS SUCCESSFUL +2016_09_29_14_26_39 : ALL 1 TESTS SUCCESSFUL +2016_09_29_14_26_42 : ALL 2 TESTS SUCCESSFUL +2016_09_29_14_44_27 : ALL 1 TESTS SUCCESSFUL +2016_09_29_15_06_52 : ALL 116 TESTS SUCCESSFUL +2016_09_29_23_09_17 : ALL 1 TESTS SUCCESSFUL +2016_09_29_23_30_11 : ALL 116 TESTS SUCCESSFUL +2016_10_03_00_57_01 : ALL 1 TESTS SUCCESSFUL +2016_10_03_00_57_08 : ALL 2 TESTS SUCCESSFUL +2016_10_03_00_57_34 : ALL 1 TESTS SUCCESSFUL +2016_10_03_00_57_38 : ALL 2 TESTS SUCCESSFUL +2016_10_06_03_26_27 : ALL 1 TESTS SUCCESSFUL +2016_10_06_03_45_36 : FAILED 2/116 TESTS: option_tests ll_authmech_XOAUTH_gmail +2016_10_09_21_20_41 : ALL 1 TESTS SUCCESSFUL +2016_10_09_21_38_59 : FAILED 2/116 TESTS: option_tests ll_delete2foldersonly_NEW_3 +2016_10_10_05_55_31 : ALL 1 TESTS SUCCESSFUL +2016_10_10_06_12_48 : ALL 116 TESTS SUCCESSFUL +2016_10_10_22_54_25 : ALL 1 TESTS SUCCESSFUL +2016_10_10_23_15_40 : ALL 116 TESTS SUCCESSFUL +2016_10_11_02_16_33 : ALL 1 TESTS SUCCESSFUL +2016_10_11_18_32_56 : ALL 1 TESTS SUCCESSFUL +2016_10_11_18_34_03 : ALL 2 TESTS SUCCESSFUL +2016_10_11_18_36_19 : ALL 1 TESTS SUCCESSFUL +2016_10_11_18_36_47 : ALL 2 TESTS SUCCESSFUL +2016_10_11_18_36_56 : ALL 1 TESTS SUCCESSFUL +2016_10_11_18_37_59 : ALL 2 TESTS SUCCESSFUL +2016_10_11_18_58_07 : ALL 1 TESTS SUCCESSFUL +2016_10_11_18_58_15 : ALL 2 TESTS SUCCESSFUL +2016_10_11_18_58_41 : ALL 1 TESTS SUCCESSFUL +2016_10_11_18_58_49 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_07_41 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_07_41 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_08_21 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_08_21 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_18_08 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_18_08 : FAILED 1/2 TESTS: setx +2016_10_11_19_18_16 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_18_16 : FAILED 1/2 TESTS: setback +2016_10_11_19_18_27 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_18_27 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_18_40 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_18_40 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_18_52 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_18_52 : ALL 3 TESTS SUCCESSFUL +2016_10_11_19_21_53 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_21_53 : ALL 3 TESTS SUCCESSFUL +2016_10_11_19_22_21 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_22_29 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_23_08 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_23_16 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_24_48 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_24_56 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_27_00 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_27_07 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_31_32 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_31_32 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_32_36 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_32_36 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_33_45 : ALL 1 TESTS SUCCESSFUL +2016_10_11_19_33_53 : ALL 2 TESTS SUCCESSFUL +2016_10_11_19_47_27 : ALL 1 TESTS SUCCESSFUL +2016_10_11_20_05_18 : ALL 116 TESTS SUCCESSFUL +2016_10_11_21_04_34 : ALL 1 TESTS SUCCESSFUL +2016_10_11_21_22_54 : ALL 118 TESTS SUCCESSFUL +2016_10_27_12_41_24 : ALL 1 TESTS SUCCESSFUL +2016_10_27_12_41_37 : ALL 2 TESTS SUCCESSFUL +2016_10_27_12_43_33 : ALL 1 TESTS SUCCESSFUL +2016_10_27_12_43_51 : ALL 2 TESTS SUCCESSFUL +2016_10_30_13_12_36 : ALL 1 TESTS SUCCESSFUL +2016_10_30_13_12_40 : ALL 2 TESTS SUCCESSFUL +2016_11_01_01_19_45 : ALL 1 TESTS SUCCESSFUL +2016_11_01_01_19_45 : ALL 2 TESTS SUCCESSFUL +2016_11_01_01_20_03 : ALL 1 TESTS SUCCESSFUL +2016_11_01_01_20_47 : ALL 2 TESTS SUCCESSFUL +2016_11_01_01_20_54 : ALL 1 TESTS SUCCESSFUL +2016_11_01_01_21_07 : ALL 2 TESTS SUCCESSFUL +2016_11_01_01_23_20 : ALL 1 TESTS SUCCESSFUL +2016_11_01_01_23_31 : ALL 2 TESTS SUCCESSFUL +2016_11_03_21_54_10 : ALL 1 TESTS SUCCESSFUL +2016_11_03_22_13_36 : ALL 118 TESTS SUCCESSFUL +2016_11_15_02_13_57 : ALL 1 TESTS SUCCESSFUL +2016_11_15_02_14_02 : ALL 2 TESTS SUCCESSFUL +2016_11_17_15_10_56 : ALL 1 TESTS SUCCESSFUL +2016_11_17_15_30_01 : ALL 118 TESTS SUCCESSFUL +2016_11_17_16_26_30 : ALL 1 TESTS SUCCESSFUL +2016_11_17_16_44_56 : ALL 118 TESTS SUCCESSFUL +2016_11_22_22_50_48 : ALL 1 TESTS SUCCESSFUL +2016_11_22_23_09_40 : ALL 118 TESTS SUCCESSFUL +2016_11_23_09_25_07 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_25_17 : ALL 2 TESTS SUCCESSFUL +2016_11_23_09_28_29 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_28_32 : ALL 2 TESTS SUCCESSFUL +2016_11_23_09_44_28 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_44_31 : ALL 2 TESTS SUCCESSFUL +2016_11_23_09_50_03 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_50_06 : ALL 2 TESTS SUCCESSFUL +2016_11_23_09_52_25 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_52_29 : FAILED 1/2 TESTS: ll_regexmess_add_header +2016_11_23_09_52_48 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_52_51 : FAILED 1/2 TESTS: ll_regexmess_add_header +2016_11_23_09_53_22 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_58_15 : ALL 1 TESTS SUCCESSFUL +2016_11_23_09_58_20 : FAILED 1/2 TESTS: ll_regexmess_add_header +2016_11_23_10_10_47 : ALL 1 TESTS SUCCESSFUL +2016_11_23_10_10_50 : FAILED 1/2 TESTS: ll_regexmess_add_header +2016_11_28_17_43_13 : ALL 1 TESTS SUCCESSFUL +2016_11_28_17_43_18 : ALL 2 TESTS SUCCESSFUL +2016_11_28_17_44_46 : ALL 1 TESTS SUCCESSFUL +2016_11_28_17_44_50 : ALL 2 TESTS SUCCESSFUL +2016_11_28_17_45_11 : ALL 1 TESTS SUCCESSFUL +2016_11_28_17_45_14 : ALL 2 TESTS SUCCESSFUL +2016_11_29_03_48_41 : ALL 1 TESTS SUCCESSFUL +2016_11_29_03_48_45 : ALL 2 TESTS SUCCESSFUL +2016_12_12_02_34_42 : FAILED 1/1 TESTS: perl_syntax +2016_12_12_02_34_47 : FAILED 1/1 TESTS: perl_syntax +2016_12_12_02_35_51 : FAILED 1/1 TESTS: perl_syntax +2016_12_12_02_36_18 : ALL 1 TESTS SUCCESSFUL +2016_12_12_02_36_19 : ALL 2 TESTS SUCCESSFUL +2016_12_12_02_36_51 : ALL 1 TESTS SUCCESSFUL +2016_12_12_02_36_53 : ALL 2 TESTS SUCCESSFUL +2016_12_12_02_46_48 : ALL 1 TESTS SUCCESSFUL +2016_12_12_02_46_51 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_16_27 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_16_29 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_18_23 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_18_25 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_20_42 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_20_43 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_20_51 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_20_53 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_23_05 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_23_08 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_23_12 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_23_14 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_24_18 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_24_36 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_24_36 : FAILED 1/2 TESTS: abort2 +2016_12_12_03_24_47 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_24_48 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_24_49 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_24_58 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_25_04 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_25_07 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_25_24 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_27_03 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_27_09 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_27_09 : FAILED 1/2 TESTS: ll_abort2 +2016_12_12_03_27_21 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_27_25 : FAILED 1/2 TESTS: ll_abort_run +2016_12_12_03_27_25 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_27_55 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_28_03 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_28_06 : FAILED 1/2 TESTS: ll_abort_run +2016_12_12_03_28_07 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_31_16 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_31_22 : ALL 2 TESTS SUCCESSFUL +2016_12_12_03_31_34 : ALL 1 TESTS SUCCESSFUL +2016_12_12_03_31_41 : ALL 2 TESTS SUCCESSFUL +2016_12_12_22_45_23 : ALL 1 TESTS SUCCESSFUL +2016_12_12_22_54_37 : ALL 1 TESTS SUCCESSFUL +2016_12_12_23_13_01 : FAILED 1/118 TESTS: ll_authmech_XOAUTH_gmail +2016_12_12_23_15_44 : ALL 1 TESTS SUCCESSFUL +2016_12_12_23_15_54 : ALL 2 TESTS SUCCESSFUL +2016_12_12_23_16_43 : ALL 1 TESTS SUCCESSFUL +2016_12_12_23_16_57 : FAILED 1/2 TESTS: ll_authmech_XOAUTH_gmail +2016_12_12_23_21_49 : ALL 1 TESTS SUCCESSFUL +2016_12_12_23_22_04 : FAILED 1/2 TESTS: ll_authmech_XOAUTH_gmail +2016_12_12_23_40_25 : ALL 1 TESTS SUCCESSFUL +2016_12_12_23_58_40 : ALL 117 TESTS SUCCESSFUL +2016_12_13_14_05_12 : ALL 1 TESTS SUCCESSFUL +2016_12_13_14_24_54 : ALL 117 TESTS SUCCESSFUL +2016_12_13_20_48_55 : ALL 1 TESTS SUCCESSFUL +2016_12_13_20_48_58 : ALL 2 TESTS SUCCESSFUL +2016_12_13_20_52_10 : ALL 1 TESTS SUCCESSFUL +2016_12_13_20_52_13 : ALL 2 TESTS SUCCESSFUL +2016_12_13_20_52_40 : ALL 1 TESTS SUCCESSFUL +2016_12_13_20_52_42 : ALL 2 TESTS SUCCESSFUL +2016_12_13_20_53_17 : ALL 1 TESTS SUCCESSFUL +2016_12_13_20_53_19 : ALL 2 TESTS SUCCESSFUL +2016_12_14_17_35_59 : ALL 1 TESTS SUCCESSFUL +2016_12_14_17_54_42 : FAILED 2/117 TESTS: option_tests_debug ll +2016_12_14_18_26_41 : ALL 1 TESTS SUCCESSFUL +2016_12_14_18_27_04 : ALL 2 TESTS SUCCESSFUL +2016_12_14_18_45_32 : ALL 1 TESTS SUCCESSFUL +2016_12_14_18_55_04 : ALL 1 TESTS SUCCESSFUL +2016_12_14_19_05_19 : ALL 1 TESTS SUCCESSFUL +2016_12_14_19_23_13 : FAILED 2/117 TESTS: option_tests ll_ask_password +2016_12_14_23_51_08 : ALL 1 TESTS SUCCESSFUL +2016_12_14_23_51_13 : FAILED 1/2 TESTS: option_tests +2016_12_14_23_53_01 : ALL 1 TESTS SUCCESSFUL +2016_12_14_23_53_05 : FAILED 1/2 TESTS: ll_ask_password +2016_12_15_00_00_25 : ALL 1 TESTS SUCCESSFUL +2016_12_15_00_00_29 : ALL 2 TESTS SUCCESSFUL +2016_12_15_00_07_36 : ALL 1 TESTS SUCCESSFUL +2016_12_15_00_07_40 : ALL 2 TESTS SUCCESSFUL +2016_12_15_05_42_24 : ALL 1 TESTS SUCCESSFUL +2016_12_15_06_00_09 : FAILED 3/117 TESTS: option_tests option_tests_debug ll_exclude +2016_12_15_06_10_50 : ALL 1 TESTS SUCCESSFUL +2016_12_15_06_10_53 : FAILED 1/2 TESTS: ll_regextrans2_d +2016_12_15_06_11_24 : ALL 1 TESTS SUCCESSFUL +2016_12_15_06_11_29 : ALL 2 TESTS SUCCESSFUL +2016_12_15_06_16_19 : ALL 1 TESTS SUCCESSFUL +2016_12_15_06_16_25 : ALL 2 TESTS SUCCESSFUL +2016_12_15_06_16_47 : ALL 1 TESTS SUCCESSFUL +2016_12_15_06_16_52 : ALL 2 TESTS SUCCESSFUL +2016_12_24_16_41_53 : ALL 1 TESTS SUCCESSFUL +2016_12_24_17_01_27 : ALL 117 TESTS SUCCESSFUL +2017_01_05_03_04_44 : ALL 1 TESTS SUCCESSFUL +2017_01_05_03_23_58 : FAILED 1/117 TESTS: l_office365_justconnect_inet4_inet6 +2017_01_05_04_18_13 : ALL 1 TESTS SUCCESSFUL +2017_01_05_04_36_08 : ALL 117 TESTS SUCCESSFUL +2017_01_05_15_18_24 : ALL 1 TESTS SUCCESSFUL +2017_01_05_15_37_27 : ALL 117 TESTS SUCCESSFUL +2017_01_09_08_52_00 : ALL 1 TESTS SUCCESSFUL +2017_01_09_09_10_57 : ALL 117 TESTS SUCCESSFUL +2017_01_09_19_00_22 : ALL 1 TESTS SUCCESSFUL +2017_01_10_21_19_24 : ALL 1 TESTS SUCCESSFUL +2017_01_10_21_38_26 : FAILED 2/117 TESTS: option_tests option_tests_debug +2017_01_11_06_45_22 : ALL 1 TESTS SUCCESSFUL +2017_01_11_07_04_31 : ALL 117 TESTS SUCCESSFUL +2017_01_11_15_53_57 : ALL 1 TESTS SUCCESSFUL +2017_01_11_16_12_29 : ALL 117 TESTS SUCCESSFUL +2017_01_11_20_49_39 : ALL 1 TESTS SUCCESSFUL +2017_01_11_20_49_41 : ALL 2 TESTS SUCCESSFUL +2017_01_11_20_50_10 : ALL 1 TESTS SUCCESSFUL +2017_01_11_20_50_12 : ALL 2 TESTS SUCCESSFUL +2017_01_11_21_37_48 : ALL 1 TESTS SUCCESSFUL +2017_01_11_21_37_50 : FAILED 1/2 TESTS: ll_justlogin +2017_01_11_21_40_31 : ALL 1 TESTS SUCCESSFUL +2017_01_11_21_40_34 : ALL 2 TESTS SUCCESSFUL +2017_01_11_21_41_55 : ALL 1 TESTS SUCCESSFUL +2017_01_11_21_41_58 : ALL 2 TESTS SUCCESSFUL +2017_01_11_21_42_04 : ALL 1 TESTS SUCCESSFUL +2017_01_11_21_42_06 : FAILED 1/2 TESTS: ll_justlogin +2017_01_12_04_09_25 : ALL 1 TESTS SUCCESSFUL +2017_01_12_04_09_28 : ALL 2 TESTS SUCCESSFUL +2017_01_12_04_10_35 : ALL 1 TESTS SUCCESSFUL +2017_01_12_04_10_57 : ALL 2 TESTS SUCCESSFUL +2017_01_12_04_11_56 : ALL 1 TESTS SUCCESSFUL +2017_01_12_04_11_59 : ALL 2 TESTS SUCCESSFUL +2017_01_12_04_13_46 : ALL 1 TESTS SUCCESSFUL +2017_01_12_04_13_57 : ALL 2 TESTS SUCCESSFUL +2017_01_12_04_14_57 : ALL 1 TESTS SUCCESSFUL +2017_01_12_04_15_00 : ALL 2 TESTS SUCCESSFUL +2017_01_12_04_24_09 : FAILED 1/1 TESTS: perl_syntax +2017_01_12_04_24_24 : ALL 1 TESTS SUCCESSFUL +2017_01_12_04_24_26 : ALL 2 TESTS SUCCESSFUL +2017_01_12_04_25_09 : ALL 1 TESTS SUCCESSFUL +2017_01_12_04_25_12 : ALL 2 TESTS SUCCESSFUL +2017_01_12_10_54_34 : ALL 1 TESTS SUCCESSFUL +2017_01_12_11_00_23 : ALL 1 TESTS SUCCESSFUL +2017_01_12_11_13_49 : ALL 1 TESTS SUCCESSFUL +2017_01_12_11_17_00 : ALL 1 TESTS SUCCESSFUL +2017_01_12_11_41_00 : FAILED 1/117 TESTS: option_tests +2017_01_15_19_19_24 : ALL 1 TESTS SUCCESSFUL +2017_01_15_19_19_59 : ALL 1 TESTS SUCCESSFUL +2017_01_15_19_37_18 : ALL 1 TESTS SUCCESSFUL +2017_01_15_19_38_09 : ALL 1 TESTS SUCCESSFUL +2017_01_15_19_58_08 : ALL 117 TESTS SUCCESSFUL +2017_01_15_20_32_11 : ALL 1 TESTS SUCCESSFUL +2017_01_16_15_07_31 : ALL 1 TESTS SUCCESSFUL +2017_01_16_15_27_36 : ALL 117 TESTS SUCCESSFUL +2017_01_17_04_39_20 : FAILED 1/1 TESTS: perl_syntax +2017_01_17_04_44_32 : ALL 1 TESTS SUCCESSFUL +2017_01_17_04_44_45 : ALL 2 TESTS SUCCESSFUL +2017_01_17_05_45_52 : ALL 1 TESTS SUCCESSFUL +2017_01_17_06_06_04 : ALL 117 TESTS SUCCESSFUL +2017_01_17_07_23_12 : ALL 1 TESTS SUCCESSFUL +2017_01_17_07_42_44 : ALL 117 TESTS SUCCESSFUL +2017_01_18_22_11_58 : ALL 1 TESTS SUCCESSFUL +2017_01_18_22_29_08 : ALL 1 TESTS SUCCESSFUL +2017_01_18_22_29_10 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_18_22_29_30 : ALL 1 TESTS SUCCESSFUL +2017_01_18_22_29_33 : ALL 2 TESTS SUCCESSFUL +2017_01_18_22_30_31 : ALL 1 TESTS SUCCESSFUL +2017_01_18_22_30_39 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_18_22_31_55 : ALL 117 TESTS SUCCESSFUL +2017_01_18_22_41_37 : FAILED 1/1 TESTS: perl_syntax +2017_01_18_22_42_24 : ALL 1 TESTS SUCCESSFUL +2017_01_18_22_42_32 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_19_00_07_34 : ALL 1 TESTS SUCCESSFUL +2017_01_19_00_07_42 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_19_00_18_36 : ALL 1 TESTS SUCCESSFUL +2017_01_19_00_18_44 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_19_00_19_23 : ALL 1 TESTS SUCCESSFUL +2017_01_19_00_19_31 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_19_00_21_47 : ALL 1 TESTS SUCCESSFUL +2017_01_19_00_21_55 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_19_00_24_58 : ALL 1 TESTS SUCCESSFUL +2017_01_19_00_25_05 : FAILED 1/2 TESTS: ll_showpasswords +2017_01_19_01_48_49 : ALL 1 TESTS SUCCESSFUL +2017_01_19_01_49_58 : ALL 1 TESTS SUCCESSFUL +2017_01_19_02_09_00 : FAILED 1/117 TESTS: ll_timeout +2017_01_19_04_41_14 : ALL 1 TESTS SUCCESSFUL +2017_01_19_05_00_46 : FAILED 1/117 TESTS: ll_timeout +2017_01_19_06_15_27 : ALL 1 TESTS SUCCESSFUL +2017_01_19_06_34_13 : FAILED 8/117 TESTS: option_tests l_office365_justconnect_tls_SSL_verify_mode_1 ll_timeout ll_justconnect_devel ll_tls_justconnect ll_tls_justlogin ll_tls ll_delete +2017_01_19_06_53_41 : ALL 1 TESTS SUCCESSFUL +2017_01_19_07_13_17 : FAILED 6/117 TESTS: l_office365_justconnect_tls_SSL_verify_mode_1 ll_timeout ll_justconnect_devel ll_tls_justconnect ll_tls_justlogin ll_tls +2017_01_28_06_49_57 : ALL 1 TESTS SUCCESSFUL +2017_01_28_06_50_18 : ALL 2 TESTS SUCCESSFUL +2017_01_28_06_54_22 : ALL 1 TESTS SUCCESSFUL +2017_01_28_06_54_30 : ALL 2 TESTS SUCCESSFUL +2017_01_31_23_02_10 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_02_20 : ALL 2 TESTS SUCCESSFUL +2017_01_31_23_02_27 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_02_37 : ALL 2 TESTS SUCCESSFUL +2017_01_31_23_02_57 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_03_07 : ALL 2 TESTS SUCCESSFUL +2017_01_31_23_03_37 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_03_43 : FAILED 1/2 TESTS: easygmail_gmail2 +2017_01_31_23_04_24 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_04_35 : ALL 2 TESTS SUCCESSFUL +2017_01_31_23_04_52 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_05_00 : FAILED 1/2 TESTS: easygmail_gmail2 +2017_01_31_23_05_25 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_05_32 : FAILED 1/2 TESTS: easygmail_gmail2 +2017_01_31_23_06_39 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_06_48 : FAILED 1/2 TESTS: easygmail_gmail2 +2017_01_31_23_07_43 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_07_57 : ALL 2 TESTS SUCCESSFUL +2017_01_31_23_10_31 : ALL 1 TESTS SUCCESSFUL +2017_01_31_23_10_44 : ALL 2 TESTS SUCCESSFUL +2017_02_09_12_38_08 : ALL 1 TESTS SUCCESSFUL +2017_02_09_12_38_31 : ALL 2 TESTS SUCCESSFUL +2017_02_09_12_40_11 : ALL 1 TESTS SUCCESSFUL +2017_02_09_12_40_21 : ALL 2 TESTS SUCCESSFUL +2017_02_09_12_42_24 : ALL 1 TESTS SUCCESSFUL +2017_02_09_12_42_54 : ALL 2 TESTS SUCCESSFUL +2017_02_15_00_25_10 : ALL 1 TESTS SUCCESSFUL +2017_02_15_00_44_22 : FAILED 9/117 TESTS: yahoo_xxxx l_office365_justconnect_tls_SSL_verify_mode_1 ll_timeout ll_justconnect_devel ll_tls_justconnect ll_tls_justlogin ll_tls ll_authmech_xoauth2_gmail ll_authmech_xoauth2_json_gmail +2017_02_15_02_18_30 : ALL 1 TESTS SUCCESSFUL +2017_02_15_02_37_11 : FAILED 8/117 TESTS: yahoo_xxxx l_office365_justconnect_tls_SSL_verify_mode_1 ll_justconnect_devel ll_tls_justconnect ll_tls_justlogin ll_tls ll_authmech_xoauth2_gmail ll_authmech_xoauth2_json_gmail +2017_02_15_11_18_00 : ALL 1 TESTS SUCCESSFUL +2017_02_15_11_18_34 : FAILED 8/9 TESTS: yahoo_xxxx l_office365_justconnect_tls_SSL_verify_mode_1 ll_justconnect_devel ll_tls_justconnect ll_tls_justlogin ll_tls ll_authmech_xoauth2_gmail ll_authmech_xoauth2_json_gmail +2017_02_15_12_09_21 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_09_28 : FAILED 1/2 TESTS: yahoo_xxxx +2017_02_15_12_15_32 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_15_40 : FAILED 1/2 TESTS: yahoo_xxxx_login +2017_02_15_12_23_55 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_24_40 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_27_55 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_28_37 : ALL 2 TESTS SUCCESSFUL +2017_02_15_12_31_21 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_31_25 : FAILED 1/2 TESTS: yahoo_all +2017_02_15_12_33_10 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_35_13 : FAILED 1/2 TESTS: yahoo_all +2017_02_15_12_38_04 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_38_04 : FAILED 1/2 TESTS: yahoo_login_tls +2017_02_15_12_38_30 : ALL 1 TESTS SUCCESSFUL +2017_02_15_12_38_33 : FAILED 1/2 TESTS: yahoo_xxxx_login_tls +2017_02_15_13_27_32 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_29_35 : FAILED 1/2 TESTS: yahoo_xxxx_login_tls +2017_02_15_13_51_42 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_52_33 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_53_10 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_53_17 : FAILED 1/2 TESTS: yahoo_xxxx_login_tls +2017_02_15_13_53_30 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_54_12 : ALL 2 TESTS SUCCESSFUL +2017_02_15_13_54_43 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_54_47 : ALL 2 TESTS SUCCESSFUL +2017_02_15_13_54_59 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_56_35 : FAILED 2/9 TESTS: ll_authmech_xoauth2_gmail ll_authmech_xoauth2_json_gmail +2017_02_15_13_56_59 : ALL 1 TESTS SUCCESSFUL +2017_02_15_13_57_02 : FAILED 1/2 TESTS: ll_authmech_xoauth2_gmail +2017_02_15_15_37_56 : ALL 1 TESTS SUCCESSFUL +2017_02_15_15_39_29 : ALL 9 TESTS SUCCESSFUL +2017_02_17_03_13_57 : ALL 1 TESTS SUCCESSFUL +2017_02_17_03_41_08 : FAILED 1/117 TESTS: ll_timeout +2017_02_17_09_36_33 : ALL 1 TESTS SUCCESSFUL +2017_02_17_09_36_38 : FAILED 1/2 TESTS: ll_timeout +2017_02_17_09_39_58 : ALL 1 TESTS SUCCESSFUL +2017_02_17_10_01_03 : ALL 117 TESTS SUCCESSFUL +2017_02_27_15_39_13 : ALL 1 TESTS SUCCESSFUL +2017_02_27_15_39_57 : ALL 2 TESTS SUCCESSFUL +2017_02_27_15_43_50 : ALL 1 TESTS SUCCESSFUL +2017_02_27_15_43_56 : ALL 2 TESTS SUCCESSFUL +2017_02_27_15_44_41 : ALL 1 TESTS SUCCESSFUL +2017_02_27_15_44_48 : ALL 2 TESTS SUCCESSFUL +2017_02_27_15_46_03 : ALL 1 TESTS SUCCESSFUL +2017_02_27_15_46_14 : ALL 2 TESTS SUCCESSFUL +2017_02_27_15_46_24 : ALL 1 TESTS SUCCESSFUL +2017_02_27_15_46_35 : ALL 2 TESTS SUCCESSFUL +2017_02_27_16_24_44 : ALL 1 TESTS SUCCESSFUL +2017_02_27_16_24_55 : ALL 2 TESTS SUCCESSFUL +2017_02_27_17_47_38 : ALL 1 TESTS SUCCESSFUL +2017_02_27_18_17_18 : FAILED 2/117 TESTS: l_office365_justconnect_inet4_inet6 l_office365_justconnect_tls_SSL_verify_mode_1 +2017_02_27_18_17_59 : ALL 1 TESTS SUCCESSFUL +2017_02_27_18_20_30 : FAILED 1/3 TESTS: l_office365_justconnect_inet4_inet6 +2017_02_27_18_20_46 : ALL 1 TESTS SUCCESSFUL +2017_02_27_18_23_07 : FAILED 1/2 TESTS: l_office365_justconnect_inet4_inet6 +2017_02_28_11_37_22 : ALL 1 TESTS SUCCESSFUL +2017_02_28_11_41_38 : ALL 1 TESTS SUCCESSFUL +2017_02_28_11_41_54 : ALL 2 TESTS SUCCESSFUL +2017_02_28_11_43_08 : ALL 1 TESTS SUCCESSFUL +2017_02_28_11_57_21 : ALL 1 TESTS SUCCESSFUL +2017_02_28_11_59_15 : ALL 1 TESTS SUCCESSFUL +2017_02_28_11_59_43 : ALL 2 TESTS SUCCESSFUL +2017_02_28_12_00_47 : ALL 1 TESTS SUCCESSFUL +2017_02_28_12_01_17 : ALL 2 TESTS SUCCESSFUL +2017_02_28_12_01_27 : ALL 1 TESTS SUCCESSFUL +2017_02_28_12_01_46 : ALL 1 TESTS SUCCESSFUL +2017_02_28_12_01_49 : ALL 2 TESTS SUCCESSFUL +2017_02_28_12_03_59 : ALL 117 TESTS SUCCESSFUL +2017_02_28_12_04_22 : ALL 1 TESTS SUCCESSFUL +2017_02_28_12_24_32 : ALL 117 TESTS SUCCESSFUL +2017_03_01_04_08_06 : ALL 1 TESTS SUCCESSFUL +2017_03_01_04_08_18 : ALL 1 TESTS SUCCESSFUL +2017_03_01_04_44_07 : ALL 117 TESTS SUCCESSFUL +2017_03_01_05_00_10 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_00_22 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_02_38 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_02_44 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_03_41 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_05_02 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_06_07 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_07_57 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_08_11 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_09_03 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_09_50 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_10_04 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_10_24 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_10_39 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_10_47 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_10_55 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_11_25 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_11_38 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_12_04 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_12_18 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_12_32 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_12_42 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_13_07 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_13_16 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_13_56 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_14_12 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_14_41 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_20_10 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_20_25 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_22_04 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_22_19 : ALL 2 TESTS SUCCESSFUL +2017_03_01_05_22_26 : ALL 1 TESTS SUCCESSFUL +2017_03_01_05_22_35 : ALL 2 TESTS SUCCESSFUL +2017_03_01_15_35_41 : ALL 1 TESTS SUCCESSFUL +2017_03_01_15_35_47 : ALL 2 TESTS SUCCESSFUL +2017_03_01_15_37_38 : ALL 1 TESTS SUCCESSFUL +2017_03_01_15_37_42 : FAILED 1/2 TESTS: ll_ask_password +2017_03_05_12_11_19 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_19_05 : FAILED 1/1 TESTS: perl_syntax +2017_03_07_22_19_54 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_20_07 : ALL 2 TESTS SUCCESSFUL +2017_03_07_22_24_36 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_24_46 : ALL 2 TESTS SUCCESSFUL +2017_03_07_22_42_30 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_42_33 : FAILED 1/2 TESTS: office1_office2 +2017_03_07_22_43_06 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_43_09 : FAILED 1/2 TESTS: office1_office2 +2017_03_07_22_43_27 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_43_53 : FAILED 1/2 TESTS: office1_office2 +2017_03_07_22_45_37 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_45_54 : FAILED 1/2 TESTS: office1_office2 +2017_03_07_22_45_57 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_54_58 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_55_14 : ALL 2 TESTS SUCCESSFUL +2017_03_07_22_59_19 : ALL 1 TESTS SUCCESSFUL +2017_03_07_22_59_33 : ALL 2 TESTS SUCCESSFUL +2017_03_07_23_02_34 : ALL 1 TESTS SUCCESSFUL +2017_03_07_23_02_49 : ALL 2 TESTS SUCCESSFUL +2017_03_07_23_05_34 : ALL 1 TESTS SUCCESSFUL +2017_03_07_23_10_30 : ALL 1 TESTS SUCCESSFUL +2017_03_07_23_10_44 : ALL 2 TESTS SUCCESSFUL +2017_03_07_23_11_52 : ALL 1 TESTS SUCCESSFUL +2017_03_07_23_12_06 : ALL 2 TESTS SUCCESSFUL +2017_03_07_23_12_51 : ALL 1 TESTS SUCCESSFUL +2017_03_07_23_13_05 : ALL 2 TESTS SUCCESSFUL +2017_03_07_23_20_01 : ALL 1 TESTS SUCCESSFUL +2017_03_07_23_40_52 : ALL 117 TESTS SUCCESSFUL +2017_03_09_12_29_09 : ALL 1 TESTS SUCCESSFUL +2017_03_09_12_50_04 : ALL 117 TESTS SUCCESSFUL +2017_03_10_02_04_57 : ALL 1 TESTS SUCCESSFUL +2017_03_10_02_25_41 : ALL 117 TESTS SUCCESSFUL +2017_03_13_00_30_45 : FAILED 1/1 TESTS: perl_syntax +2017_03_13_00_32_04 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_32_04 : FAILED 1/2 TESTS: exchange1 +2017_03_13_00_32_33 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_32_40 : FAILED 1/2 TESTS: exchange_1 +2017_03_13_00_34_14 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_34_26 : ALL 2 TESTS SUCCESSFUL +2017_03_13_00_40_03 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_40_04 : FAILED 1/2 TESTS: ll_domino2 +2017_03_13_00_42_02 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_42_04 : FAILED 1/2 TESTS: ll_domino2 +2017_03_13_00_44_33 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_44_37 : FAILED 1/2 TESTS: ll_domino2 +2017_03_13_00_48_12 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_48_17 : ALL 2 TESTS SUCCESSFUL +2017_03_13_00_52_17 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_52_21 : ALL 2 TESTS SUCCESSFUL +2017_03_13_00_53_16 : ALL 1 TESTS SUCCESSFUL +2017_03_13_00_53_21 : ALL 2 TESTS SUCCESSFUL +2017_03_13_01_09_25 : ALL 1 TESTS SUCCESSFUL +2017_03_13_01_09_26 : FAILED 1/2 TESTS: ll_domino1 +2017_03_13_01_09_34 : ALL 1 TESTS SUCCESSFUL +2017_03_13_01_09_38 : ALL 2 TESTS SUCCESSFUL +2017_03_13_01_10_52 : ALL 1 TESTS SUCCESSFUL +2017_03_13_01_10_56 : ALL 2 TESTS SUCCESSFUL +2017_03_13_01_15_11 : ALL 1 TESTS SUCCESSFUL +2017_03_13_01_38_21 : FAILED 1/1 TESTS: perl_syntax +2017_03_13_01_39_24 : FAILED 1/1 TESTS: perl_syntax +2017_03_13_01_44_52 : FAILED 1/1 TESTS: perl_syntax +2017_03_13_01_46_23 : ALL 1 TESTS SUCCESSFUL +2017_03_13_01_57_33 : ALL 1 TESTS SUCCESSFUL +2017_03_13_01_59_42 : FAILED 1/2 TESTS: ll_env_password +2017_03_13_01_59_46 : ALL 1 TESTS SUCCESSFUL +2017_03_13_01_59_49 : ALL 2 TESTS SUCCESSFUL +2017_03_13_02_00_32 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_00_36 : ALL 2 TESTS SUCCESSFUL +2017_03_13_02_03_13 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_03_47 : ALL 3 TESTS SUCCESSFUL +2017_03_13_02_04_41 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_05_19 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_06_12 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_06_17 : ALL 2 TESTS SUCCESSFUL +2017_03_13_02_07_52 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_08_00 : ALL 3 TESTS SUCCESSFUL +2017_03_13_02_08_18 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_08_21 : ALL 2 TESTS SUCCESSFUL +2017_03_13_02_08_32 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_08_40 : ALL 3 TESTS SUCCESSFUL +2017_03_13_02_09_33 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_09_42 : ALL 3 TESTS SUCCESSFUL +2017_03_13_02_10_58 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_11_06 : ALL 3 TESTS SUCCESSFUL +2017_03_13_02_19_22 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_19_30 : ALL 3 TESTS SUCCESSFUL +2017_03_13_02_21_43 : ALL 1 TESTS SUCCESSFUL +2017_03_13_02_45_48 : ALL 120 TESTS SUCCESSFUL +2017_03_13_07_21_17 : ALL 1 TESTS SUCCESSFUL +2017_03_13_07_21_30 : ALL 2 TESTS SUCCESSFUL +2017_03_13_07_21_55 : ALL 1 TESTS SUCCESSFUL +2017_03_13_07_22_14 : ALL 2 TESTS SUCCESSFUL +2017_03_13_07_23_18 : ALL 1 TESTS SUCCESSFUL +2017_03_13_07_44_06 : FAILED 1/120 TESTS: option_tests +2017_03_13_14_13_32 : ALL 1 TESTS SUCCESSFUL +2017_03_13_14_34_56 : FAILED 1/120 TESTS: option_tests +2017_03_13_15_18_35 : ALL 1 TESTS SUCCESSFUL +2017_03_13_15_39_17 : FAILED 1/120 TESTS: option_tests +2017_03_14_01_56_18 : ALL 1 TESTS SUCCESSFUL +2017_03_14_01_57_27 : ALL 1 TESTS SUCCESSFUL +2017_03_14_01_59_20 : ALL 1 TESTS SUCCESSFUL +2017_03_14_02_19_32 : FAILED 1/120 TESTS: option_tests +2017_03_14_18_29_18 : ALL 1 TESTS SUCCESSFUL +2017_03_14_18_30_35 : ALL 2 TESTS SUCCESSFUL +2017_03_14_18_38_22 : ALL 1 TESTS SUCCESSFUL +2017_03_14_18_43_17 : ALL 2 TESTS SUCCESSFUL +2017_03_14_18_49_37 : ALL 1 TESTS SUCCESSFUL +2017_03_14_18_54_38 : ALL 2 TESTS SUCCESSFUL +2017_03_14_18_54_54 : ALL 1 TESTS SUCCESSFUL +2017_03_14_18_56_26 : ALL 1 TESTS SUCCESSFUL +2017_03_14_18_56_54 : ALL 2 TESTS SUCCESSFUL +2017_03_14_18_57_06 : ALL 1 TESTS SUCCESSFUL +2017_03_14_18_57_37 : ALL 2 TESTS SUCCESSFUL +2017_03_14_18_58_05 : ALL 1 TESTS SUCCESSFUL +2017_03_14_19_03_39 : ALL 2 TESTS SUCCESSFUL +2017_03_14_19_06_00 : ALL 1 TESTS SUCCESSFUL +2017_03_14_19_06_29 : ALL 2 TESTS SUCCESSFUL +2017_03_14_19_07_18 : ALL 1 TESTS SUCCESSFUL +2017_03_18_00_18_47 : ALL 1 TESTS SUCCESSFUL +2017_03_18_00_40_07 : ALL 120 TESTS SUCCESSFUL +2017_03_20_07_24_32 : ALL 1 TESTS SUCCESSFUL +2017_03_20_07_25_45 : ALL 2 TESTS SUCCESSFUL +2017_03_20_07_26_09 : ALL 1 TESTS SUCCESSFUL +2017_03_20_07_27_10 : ALL 1 TESTS SUCCESSFUL +2017_03_20_07_27_54 : ALL 2 TESTS SUCCESSFUL +2017_03_20_13_39_58 : ALL 1 TESTS SUCCESSFUL +2017_03_20_13_40_42 : ALL 2 TESTS SUCCESSFUL +2017_03_20_14_15_06 : ALL 1 TESTS SUCCESSFUL +2017_03_20_14_15_48 : ALL 2 TESTS SUCCESSFUL +2017_03_20_14_31_30 : ALL 1 TESTS SUCCESSFUL +2017_03_20_14_32_13 : ALL 2 TESTS SUCCESSFUL +2017_03_20_14_46_49 : ALL 1 TESTS SUCCESSFUL +2017_03_20_14_47_23 : ALL 2 TESTS SUCCESSFUL +2017_03_20_14_48_00 : ALL 1 TESTS SUCCESSFUL +2017_03_20_14_48_42 : ALL 2 TESTS SUCCESSFUL +2017_03_20_21_20_18 : ALL 1 TESTS SUCCESSFUL +2017_03_20_21_20_22 : ALL 2 TESTS SUCCESSFUL +2017_03_20_21_21_37 : ALL 1 TESTS SUCCESSFUL +2017_03_20_21_21_41 : ALL 2 TESTS SUCCESSFUL +2017_03_20_21_22_18 : ALL 1 TESTS SUCCESSFUL +2017_03_20_21_22_22 : ALL 2 TESTS SUCCESSFUL +2017_03_20_23_32_03 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_32_44 : ALL 2 TESTS SUCCESSFUL +2017_03_20_23_33_06 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_33_42 : ALL 2 TESTS SUCCESSFUL +2017_03_20_23_33_45 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_34_59 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_35_58 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_37_16 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_37_57 : ALL 2 TESTS SUCCESSFUL +2017_03_20_23_38_37 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_39_18 : ALL 2 TESTS SUCCESSFUL +2017_03_20_23_39_24 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_40_55 : ALL 2 TESTS SUCCESSFUL +2017_03_20_23_42_24 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_43_56 : ALL 2 TESTS SUCCESSFUL +2017_03_20_23_56_25 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_58_47 : ALL 1 TESTS SUCCESSFUL +2017_03_20_23_59_14 : ALL 2 TESTS SUCCESSFUL +2017_03_21_00_00_07 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_00_53 : ALL 2 TESTS SUCCESSFUL +2017_03_21_00_01_15 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_02_01 : ALL 2 TESTS SUCCESSFUL +2017_03_21_00_05_33 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_10_02 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_10_47 : ALL 2 TESTS SUCCESSFUL +2017_03_21_00_11_21 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_11_48 : ALL 2 TESTS SUCCESSFUL +2017_03_21_00_14_10 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_14_45 : ALL 2 TESTS SUCCESSFUL +2017_03_21_00_15_25 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_16_24 : ALL 2 TESTS SUCCESSFUL +2017_03_21_00_21_18 : ALL 1 TESTS SUCCESSFUL +2017_03_21_00_22_20 : ALL 1 TESTS SUCCESSFUL +2017_03_21_08_27_10 : ALL 1 TESTS SUCCESSFUL +2017_03_21_08_48_16 : ALL 120 TESTS SUCCESSFUL +2017_03_24_23_47_54 : ALL 1 TESTS SUCCESSFUL +2017_03_24_23_48_02 : ALL 2 TESTS SUCCESSFUL +2017_03_24_23_49_04 : ALL 1 TESTS SUCCESSFUL +2017_03_24_23_49_25 : ALL 2 TESTS SUCCESSFUL +2017_04_06_01_07_51 : ALL 1 TESTS SUCCESSFUL +2017_04_06_01_29_21 : ALL 120 TESTS SUCCESSFUL +2017_04_12_14_53_49 : ALL 1 TESTS SUCCESSFUL +2017_04_12_15_15_38 : ALL 120 TESTS SUCCESSFUL +2017_04_12_17_14_51 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_14_51 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_12_17_16_50 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_16_56 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_12_17_19_23 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_19_32 : ALL 2 TESTS SUCCESSFUL +2017_04_12_17_20_55 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_21_03 : ALL 2 TESTS SUCCESSFUL +2017_04_12_17_22_22 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_22_30 : ALL 2 TESTS SUCCESSFUL +2017_04_12_17_23_23 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_23_29 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_12_17_25_32 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_25_38 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_12_17_26_16 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_26_22 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_12_17_27_01 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_27_07 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_12_17_42_43 : ALL 1 TESTS SUCCESSFUL +2017_04_12_17_42_49 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_12_21_37_27 : ALL 1 TESTS SUCCESSFUL +2017_04_12_21_37_33 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_40_50 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_40_56 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_41_49 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_41_51 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_42_26 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_42_34 : FAILED 1/2 TESTS: option_tests_in_var_tmp_sub +2017_04_13_02_42_46 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_42_48 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_47_38 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_47_40 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_48_31 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_48_33 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_49_33 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_49_35 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_50_57 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_50_59 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_52_56 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_52_58 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_53_30 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_53_31 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_02_55_54 : FAILED 1/1 TESTS: perl_syntax +2017_04_13_02_56_20 : ALL 1 TESTS SUCCESSFUL +2017_04_13_02_56_21 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_01_02 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_01_04 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_06_21 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_06_23 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_08_09 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_08_11 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_09_00 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_09_02 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_09_37 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_09_39 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_11_22 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_11_24 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_12_50 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_12_52 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_14_34 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_14_36 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_16_50 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_16_52 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_17_27 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_17_28 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_18_45 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_18_47 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_18_56 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_19_03 : FAILED 1/2 TESTS: option_tests_in_var_tmp_sub +2017_04_13_03_19_42 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_19_49 : FAILED 1/2 TESTS: option_tests_in_var_tmp_sub +2017_04_13_03_20_32 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_20_34 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_03_51_30 : ALL 1 TESTS SUCCESSFUL +2017_04_13_03_51_32 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_14_25_27 : ALL 1 TESTS SUCCESSFUL +2017_04_13_14_25_29 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_14_33_31 : ALL 1 TESTS SUCCESSFUL +2017_04_13_14_33_33 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_14_41_28 : ALL 1 TESTS SUCCESSFUL +2017_04_13_14_41_30 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_14_46_33 : ALL 1 TESTS SUCCESSFUL +2017_04_13_14_46_35 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_14_50_16 : ALL 1 TESTS SUCCESSFUL +2017_04_13_14_50_18 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_14_50_36 : ALL 1 TESTS SUCCESSFUL +2017_04_13_14_50_38 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_14_52_56 : ALL 1 TESTS SUCCESSFUL +2017_04_13_14_52_58 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_15_24_18 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_24_20 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_15_35_37 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_35_39 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_15_38_25 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_38_27 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_04_13_15_40_05 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_40_07 : ALL 2 TESTS SUCCESSFUL +2017_04_13_15_40_57 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_40_57 : FAILED 1/2 TESTS: option_tests_in_var +2017_04_13_15_41_10 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_41_18 : FAILED 1/2 TESTS: option_tests_in_var_tmp_sub +2017_04_13_15_41_45 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_41_54 : ALL 2 TESTS SUCCESSFUL +2017_04_13_15_42_16 : ALL 1 TESTS SUCCESSFUL +2017_04_13_15_42_23 : ALL 2 TESTS SUCCESSFUL +2017_04_22_14_58_20 : ALL 1 TESTS SUCCESSFUL +2017_04_22_15_02_48 : ALL 1 TESTS SUCCESSFUL +2017_04_22_15_23_15 : ALL 122 TESTS SUCCESSFUL +2017_04_24_04_53_15 : ALL 1 TESTS SUCCESSFUL +2017_04_24_04_53_15 : FAILED 1/2 TESTS: passfile_noexist +2017_04_24_04_53_55 : ALL 1 TESTS SUCCESSFUL +2017_04_24_04_53_55 : FAILED 1/2 TESTS: passfile_noexistee +2017_04_24_04_54_12 : ALL 1 TESTS SUCCESSFUL +2017_04_24_04_54_18 : FAILED 1/2 TESTS: passfile_noexist +2017_04_24_05_02_43 : ALL 1 TESTS SUCCESSFUL +2017_04_24_05_02_46 : FAILED 1/2 TESTS: passfile_noexist +2017_04_24_05_06_35 : ALL 1 TESTS SUCCESSFUL +2017_04_24_05_06_38 : ALL 2 TESTS SUCCESSFUL +2017_04_24_05_07_01 : ALL 1 TESTS SUCCESSFUL +2017_04_24_05_07_03 : FAILED 1/2 TESTS: passfile_noexist +2017_04_24_12_17_02 : ALL 1 TESTS SUCCESSFUL +2017_04_24_12_17_41 : ALL 1 TESTS SUCCESSFUL +2017_04_24_12_17_47 : ALL 3 TESTS SUCCESSFUL +2017_04_24_12_54_42 : ALL 1 TESTS SUCCESSFUL +2017_04_24_13_18_16 : FAILED 4/124 TESTS: office365_justconnect_inet4_inet6 ll_ask_password ll_env_password ll_authmech_xoauth2_json_gmail +2017_04_24_15_48_46 : ALL 1 TESTS SUCCESSFUL +2017_04_24_15_48_52 : ALL 3 TESTS SUCCESSFUL +2017_04_24_15_51_01 : ALL 1 TESTS SUCCESSFUL +2017_04_24_15_51_07 : ALL 3 TESTS SUCCESSFUL +2017_04_24_22_52_47 : ALL 1 TESTS SUCCESSFUL +2017_04_24_23_16_56 : FAILED 3/124 TESTS: option_tests option_tests_in_var_tmp option_tests_in_var_tmp_sub +2017_04_25_01_00_30 : ALL 1 TESTS SUCCESSFUL +2017_04_25_01_22_09 : ALL 124 TESTS SUCCESSFUL +2017_04_25_16_13_59 : ALL 1 TESTS SUCCESSFUL +2017_04_25_16_43_26 : ALL 124 TESTS SUCCESSFUL +2017_04_25_18_13_58 : ALL 1 TESTS SUCCESSFUL +2017_04_25_18_35_45 : FAILED 1/124 TESTS: free_ssl +2017_04_25_22_54_46 : ALL 1 TESTS SUCCESSFUL +2017_04_25_22_55_14 : ALL 1 TESTS SUCCESSFUL +2017_04_26_01_17_24 : ALL 1 TESTS SUCCESSFUL +2017_04_26_01_37_52 : ALL 124 TESTS SUCCESSFUL +2017_04_26_13_22_27 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_22_38 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_23_38 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_23_47 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_24_25 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_24_29 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_25_23 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_25_27 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_26_16 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_26_19 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_26_44 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_26_47 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_34_11 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_34_16 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_34_47 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_34_51 : ALL 2 TESTS SUCCESSFUL +2017_04_26_13_35_14 : ALL 1 TESTS SUCCESSFUL +2017_04_26_13_35_24 : ALL 2 TESTS SUCCESSFUL +2017_04_26_19_54_31 : ALL 1 TESTS SUCCESSFUL +2017_04_26_20_16_24 : ALL 124 TESTS SUCCESSFUL +2017_05_02_21_19_15 : ALL 1 TESTS SUCCESSFUL +2017_05_02_21_41_14 : ALL 124 TESTS SUCCESSFUL +2017_05_03_04_47_52 : ALL 1 TESTS SUCCESSFUL +2017_05_03_04_48_06 : ALL 2 TESTS SUCCESSFUL +2017_05_23_09_45_39 : ALL 1 TESTS SUCCESSFUL +2017_05_23_09_46_39 : ALL 2 TESTS SUCCESSFUL +2017_05_23_11_04_56 : ALL 1 TESTS SUCCESSFUL +2017_05_23_11_05_02 : ALL 2 TESTS SUCCESSFUL +2017_05_23_11_05_29 : ALL 1 TESTS SUCCESSFUL +2017_05_23_11_05_38 : ALL 2 TESTS SUCCESSFUL +2017_05_23_11_06_18 : ALL 1 TESTS SUCCESSFUL +2017_05_23_11_06_24 : ALL 2 TESTS SUCCESSFUL +2017_05_23_11_06_49 : ALL 1 TESTS SUCCESSFUL +2017_05_23_11_07_20 : ALL 2 TESTS SUCCESSFUL +2017_05_23_11_07_35 : ALL 1 TESTS SUCCESSFUL +2017_05_23_11_07_49 : ALL 2 TESTS SUCCESSFUL +2017_05_30_00_20_13 : ALL 1 TESTS SUCCESSFUL +2017_05_30_00_20_27 : ALL 2 TESTS SUCCESSFUL +2017_05_30_00_24_46 : ALL 1 TESTS SUCCESSFUL +2017_05_30_00_25_01 : ALL 2 TESTS SUCCESSFUL +2017_05_30_00_26_53 : ALL 1 TESTS SUCCESSFUL +2017_05_30_00_27_10 : ALL 2 TESTS SUCCESSFUL +2017_05_30_00_29_25 : ALL 1 TESTS SUCCESSFUL +2017_05_30_00_29_43 : ALL 2 TESTS SUCCESSFUL +2017_05_30_00_33_13 : ALL 1 TESTS SUCCESSFUL +2017_05_30_00_33_15 : ALL 2 TESTS SUCCESSFUL +2017_05_30_00_33_43 : ALL 1 TESTS SUCCESSFUL +2017_05_30_00_33_46 : FAILED 1/2 TESTS: inet4_inet6 +2017_05_30_09_27_11 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_27_24 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_30_20 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_30_24 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_40_55 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_40_59 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_45_07 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_45_11 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_47_03 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_47_07 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_48_01 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_48_05 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_49_10 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_49_15 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_49_55 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_49_59 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_51_37 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_51_41 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_52_31 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_52_35 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_54_18 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_54_22 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_55_12 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_55_16 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_56_04 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_56_08 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_57_03 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_57_07 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_09_59_46 : ALL 1 TESTS SUCCESSFUL +2017_05_30_09_59_50 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_00_40 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_00_44 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_01_24 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_01_28 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_01_48 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_01_52 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_02_43 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_02_47 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_03_24 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_03_28 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_03_55 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_03_59 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_04_48 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_04_52 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_05_31 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_05_36 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_06_44 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_06_49 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_05_30_10_08_07 : ALL 1 TESTS SUCCESSFUL +2017_05_30_10_08_12 : FAILED 1/2 TESTS: ll_regexmess_change_header +2017_06_01_03_04_51 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_05_00 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_06_33 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_06_37 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_07_47 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_07_51 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_14_30 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_14_34 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_15_04 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_15_08 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_15_28 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_15_33 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_15_55 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_15_59 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_16_39 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_16_43 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_17_00 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_17_04 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_17_38 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_17_42 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_22_20 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_22_24 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_23_06 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_23_10 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_23_58 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_24_01 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_25_02 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_25_05 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_25_43 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_25_47 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_26_23 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_26_27 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_26_41 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_26_45 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_27_09 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_27_12 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_27_30 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_27_34 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_29_30 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_29_34 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_29_56 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_30_00 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_31_42 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_31_46 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_32_25 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_32_29 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_33_25 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_33_29 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_35_54 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_35_58 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_37_47 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_37_51 : ALL 2 TESTS SUCCESSFUL +2017_06_01_03_42_15 : ALL 1 TESTS SUCCESSFUL +2017_06_01_03_42_19 : ALL 2 TESTS SUCCESSFUL +2017_06_02_00_49_51 : ALL 1 TESTS SUCCESSFUL +2017_06_02_00_50_03 : ALL 2 TESTS SUCCESSFUL +2017_06_02_00_50_32 : ALL 1 TESTS SUCCESSFUL +2017_06_02_00_50_37 : ALL 2 TESTS SUCCESSFUL +2017_06_08_11_31_37 : ALL 1 TESTS SUCCESSFUL +2017_06_08_11_31_42 : ALL 2 TESTS SUCCESSFUL +2017_06_08_11_34_47 : ALL 1 TESTS SUCCESSFUL +2017_06_08_11_34_50 : ALL 2 TESTS SUCCESSFUL +2017_06_08_11_36_11 : ALL 1 TESTS SUCCESSFUL +2017_06_08_11_36_14 : FAILED 1/2 TESTS: ll_ssl_justconnect_SSL_VERIFY_PEER +2017_06_16_12_02_28 : ALL 1 TESTS SUCCESSFUL +2017_06_16_12_03_28 : ALL 2 TESTS SUCCESSFUL +2017_06_17_15_53_44 : ALL 1 TESTS SUCCESSFUL +2017_06_17_15_54_04 : FAILED 1/2 TESTS: yahoo_all +2017_06_17_15_55_04 : ALL 1 TESTS SUCCESSFUL +2017_06_17_15_56_04 : ALL 2 TESTS SUCCESSFUL +2017_06_17_15_57_26 : ALL 1 TESTS SUCCESSFUL +2017_06_17_15_57_55 : ALL 2 TESTS SUCCESSFUL +2017_06_17_16_20_24 : ALL 1 TESTS SUCCESSFUL +2017_06_17_16_21_07 : ALL 2 TESTS SUCCESSFUL +2017_06_19_17_16_40 : ALL 1 TESTS SUCCESSFUL +2017_06_19_17_17_19 : ALL 2 TESTS SUCCESSFUL +2017_06_19_17_18_32 : ALL 1 TESTS SUCCESSFUL +2017_06_19_17_18_44 : ALL 2 TESTS SUCCESSFUL +2017_06_19_17_40_07 : ALL 1 TESTS SUCCESSFUL +2017_06_19_17_40_16 : ALL 2 TESTS SUCCESSFUL +2017_06_19_17_41_03 : ALL 1 TESTS SUCCESSFUL +2017_06_19_17_41_11 : ALL 2 TESTS SUCCESSFUL +2017_07_06_05_24_46 : ALL 1 TESTS SUCCESSFUL +2017_07_06_05_54_01 : FAILED 1/124 TESTS: office365_justconnect_inet4_inet6 +2017_07_06_13_12_23 : ALL 1 TESTS SUCCESSFUL +2017_07_06_13_15_17 : FAILED 1/2 TESTS: office365_justconnect_inet4_inet6 +2017_07_06_14_03_55 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_04_17 : ALL 2 TESTS SUCCESSFUL +2017_07_06_14_04_39 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_30_01 : ALL 124 TESTS SUCCESSFUL +2017_07_06_14_42_45 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_42_49 : ALL 2 TESTS SUCCESSFUL +2017_07_06_14_43_54 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_44_00 : ALL 2 TESTS SUCCESSFUL +2017_07_06_14_44_42 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_44_48 : ALL 2 TESTS SUCCESSFUL +2017_07_06_14_45_52 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_45_55 : ALL 2 TESTS SUCCESSFUL +2017_07_06_14_48_24 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_48_24 : FAILED 1/2 TESTS: ks2ipv6.lamiral.info +2017_07_06_14_48_41 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_48_47 : ALL 2 TESTS SUCCESSFUL +2017_07_06_14_53_30 : ALL 1 TESTS SUCCESSFUL +2017_07_06_14_53_48 : ALL 5 TESTS SUCCESSFUL +2017_07_08_00_16_24 : ALL 1 TESTS SUCCESSFUL +2017_07_08_00_39_03 : FAILED 5/130 TESTS: option_tests option_tests_in_var_tmp option_tests_in_var_tmp_sub testlive testlive6 +2017_07_08_00_44_01 : ALL 1 TESTS SUCCESSFUL +2017_07_08_01_05_59 : FAILED 3/130 TESTS: option_tests option_tests_in_var_tmp option_tests_in_var_tmp_sub +2017_07_08_01_21_18 : ALL 1 TESTS SUCCESSFUL +2017_07_08_01_43_17 : ALL 130 TESTS SUCCESSFUL +2017_07_21_00_24_17 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_25_43 : ALL 2 TESTS SUCCESSFUL +2017_07_21_00_27_20 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_27_35 : ALL 2 TESTS SUCCESSFUL +2017_07_21_00_28_14 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_28_29 : ALL 2 TESTS SUCCESSFUL +2017_07_21_00_30_04 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_30_13 : ALL 2 TESTS SUCCESSFUL +2017_07_21_00_33_33 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_33_56 : ALL 2 TESTS SUCCESSFUL +2017_07_21_00_42_02 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_51_05 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_51_20 : ALL 2 TESTS SUCCESSFUL +2017_07_21_00_52_18 : ALL 1 TESTS SUCCESSFUL +2017_07_21_00_52_33 : ALL 2 TESTS SUCCESSFUL +2017_07_21_01_16_17 : ALL 1 TESTS SUCCESSFUL +2017_07_21_01_16_31 : ALL 2 TESTS SUCCESSFUL +2017_07_21_01_16_56 : ALL 1 TESTS SUCCESSFUL +2017_07_21_01_17_14 : ALL 2 TESTS SUCCESSFUL +2017_07_22_16_42_03 : ALL 1 TESTS SUCCESSFUL +2017_07_22_17_17_05 : FAILED 4/130 TESTS: option_tests option_tests_in_var_tmp option_tests_in_var_tmp_sub free_ssl +2017_07_24_10_05_38 : ALL 1 TESTS SUCCESSFUL +2017_07_27_15_35_41 : ALL 1 TESTS SUCCESSFUL +2017_07_27_15_58_56 : FAILED 2/130 TESTS: option_tests_in_var_tmp option_tests_in_var_tmp_sub +2017_07_27_17_32_53 : ALL 1 TESTS SUCCESSFUL +2017_07_27_17_33_03 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_07_27_17_34_48 : ALL 1 TESTS SUCCESSFUL +2017_07_27_17_34_58 : FAILED 1/2 TESTS: option_tests_in_var_tmp +2017_07_27_17_37_16 : ALL 1 TESTS SUCCESSFUL +2017_07_27_17_37_27 : ALL 2 TESTS SUCCESSFUL +2017_07_27_17_38_18 : ALL 1 TESTS SUCCESSFUL +2017_07_27_18_01_28 : ALL 130 TESTS SUCCESSFUL +2017_08_27_00_19_42 : ALL 1 TESTS SUCCESSFUL +2017_08_27_00_42_29 : ALL 130 TESTS SUCCESSFUL +2017_08_28_21_23_19 : ALL 1 TESTS SUCCESSFUL +2017_08_28_21_46_41 : FAILED 4/130 TESTS: option_tests option_tests_in_var_tmp option_tests_in_var_tmp_sub free_ssl +2017_08_28_23_18_30 : ALL 1 TESTS SUCCESSFUL +2017_08_28_23_30_05 : FAILED 64/130 TESTS: option_tests option_tests_in_var_tmp option_tests_in_var_tmp_sub ll_oneemail ll_nosubscribe ll_justfoldersizes ll_authmd5 ll_authmd51 ll_authmd52 ll_noauthmd5 ll_maxage ll_maxsize ll_skipsize ll_skipheader ll_include ll_exclude ll_exclude_INBOX ll_regextrans2 ll_regextrans2_subfolder ll_sep2 ll_skipmess ll_skipmess_8bits ll_pipemess ll_pipemess_catcat ll_justconnect ll_justconnect_ipv6 ll_justconnect_ipv6_nossl ks_justconnect_ipv6 ks_justconnect_ipv6_nossl ll_justlogin ll_justconnect_devel ll_ssl ll_ssl_justconnect ll_ssl_justlogin ll_tls_justconnect ll_tls_justlogin ll_tls ll_authmech_PLAIN ll_authmech_xoauth2_gmail ll_authmech_xoauth2_json_gmail ll_authmech_LOGIN ll_authmech_CRAMMD5 ll_authuser ll_delete2 ll_delete ll_folderrec ll_newmessage ll_usecache ll_usecache_noheader ll_usecache_debugcache ll_nousecache ll_delete2foldersonly_NEW_3 ll_delete2foldersonly ll_delete2foldersonly_tmp ll_delete2foldersbutnot ll_folder_create ll_folder_create_INBOX_Inbox ll_useuid ll_noheader_force ll_noheader ll_domino1_domino2 ll_domino2 testslive testslive6 +2017_08_29_00_26_13 : ALL 1 TESTS SUCCESSFUL +2017_08_29_00_41_34 : FAILED 43/130 TESTS: option_tests option_tests_in_var_tmp option_tests_in_var_tmp_sub gmail gmail_gmail gmail_gmail_INBOX gmail_gmail_folderfirst yahoo_all free_ssl office365_justconnect_inet4_inet6 office365_justconnect_tls_SSL_verify_mode_1 ll_ask_password ll_env_password ll_timeout ll_folder ll_folder_noexist ll_folder_mixfolders ll_oneemail ll_buffersize ll_justfolders_delete1emptyfolders ll_prefix12 ll_nosyncinternaldates ll_idatefromheader ll_folder_rev ll_subscribed ll_nosubscribe ll_justfoldersizes ll_authmd5 ll_authmd51 ll_authmd52 ll_noauthmd5 ll_maxage ll_maxsize ll_skipsize ll_skipheader ll_include ll_exclude ll_exclude_INBOX ll_regextrans2 ll_regextrans2_subfolder ll_sep2 ll_skipmess ll_skipmess_8bits +2017_08_29_01_08_37 : ALL 1 TESTS SUCCESSFUL +2017_08_29_02_53_01 : ALL 1 TESTS SUCCESSFUL +2017_08_29_02_54_46 : ALL 1 TESTS SUCCESSFUL +2017_08_29_03_17_18 : ALL 1 TESTS SUCCESSFUL +2017_08_29_03_22_56 : ALL 1 TESTS SUCCESSFUL +2017_08_29_05_13_32 : ALL 1 TESTS SUCCESSFUL +2017_08_31_04_12_32 : ALL 1 TESTS SUCCESSFUL +2017_08_31_04_35_55 : ALL 130 TESTS SUCCESSFUL +2017_08_31_06_14_44 : ALL 1 TESTS SUCCESSFUL +2017_08_31_06_37_10 : ALL 130 TESTS SUCCESSFUL +2017_09_03_06_12_35 : ALL 1 TESTS SUCCESSFUL +2017_09_03_06_36_17 : ALL 130 TESTS SUCCESSFUL +2017_09_03_15_17_33 : ALL 1 TESTS SUCCESSFUL +2017_09_05_10_31_24 : ALL 1 TESTS SUCCESSFUL +2017_09_05_10_31_39 : ALL 2 TESTS SUCCESSFUL +2017_09_05_10_33_57 : ALL 1 TESTS SUCCESSFUL +2017_09_05_10_34_07 : ALL 2 TESTS SUCCESSFUL +2017_09_05_10_35_54 : ALL 1 TESTS SUCCESSFUL +2017_09_05_10_36_05 : ALL 2 TESTS SUCCESSFUL +2017_09_05_11_19_50 : ALL 1 TESTS SUCCESSFUL +2017_09_05_11_20_02 : ALL 2 TESTS SUCCESSFUL +2017_09_05_11_21_07 : ALL 1 TESTS SUCCESSFUL +2017_09_05_11_21_17 : ALL 2 TESTS SUCCESSFUL +2017_09_05_11_22_19 : ALL 1 TESTS SUCCESSFUL +2017_09_05_11_22_29 : ALL 2 TESTS SUCCESSFUL +2017_09_05_11_38_16 : ALL 1 TESTS SUCCESSFUL +2017_09_05_11_38_31 : ALL 2 TESTS SUCCESSFUL +2017_09_05_11_39_19 : ALL 1 TESTS SUCCESSFUL +2017_09_05_11_39_32 : ALL 2 TESTS SUCCESSFUL +2017_09_05_11_40_49 : ALL 1 TESTS SUCCESSFUL +2017_09_05_11_41_33 : ALL 2 TESTS SUCCESSFUL +2017_09_05_17_18_12 : ALL 1 TESTS SUCCESSFUL +2017_09_05_17_44_28 : ALL 130 TESTS SUCCESSFUL +2017_09_05_18_16_27 : ALL 1 TESTS SUCCESSFUL +2017_09_05_18_47_25 : ALL 130 TESTS SUCCESSFUL diff --git a/W/Mail-IMAPClient-3.38/META.yml b/W/Mail-IMAPClient-3.38/META.yml deleted file mode 100644 index cfde733..0000000 --- a/W/Mail-IMAPClient-3.38/META.yml +++ /dev/null @@ -1,36 +0,0 @@ ---- -abstract: 'IMAP4 client library' -author: - - 'Phil Pearl (Lobbes) ' -build_requires: - ExtUtils::MakeMaker: 0 -configure_requires: - ExtUtils::MakeMaker: 0 -dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921' -license: perl -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 -name: Mail-IMAPClient -no_index: - directory: - - t - - inc -requires: - Carp: 0 - Errno: 0 - Fcntl: 0 - File::Temp: 0 - IO::File: 0 - IO::Select: 0 - IO::Socket: 0 - IO::Socket::INET: 1.26 - List::Util: 0 - MIME::Base64: 0 - Parse::RecDescent: 1.94 - Test::More: 0 - perl: 5.008 -resources: - homepage: http://sourceforge.net/projects/mail-imapclient/ -version: 3.38 diff --git a/W/Mail-IMAPClient-3.38/Changes b/W/Mail-IMAPClient-3.39/Changes similarity index 99% rename from W/Mail-IMAPClient-3.38/Changes rename to W/Mail-IMAPClient-3.39/Changes index c907ff5..df74a2c 100644 --- a/W/Mail-IMAPClient-3.38/Changes +++ b/W/Mail-IMAPClient-3.39/Changes @@ -5,6 +5,18 @@ Changes from 2.99_01 to 3.16 made by Mark Overmeer Changes from 0.09 to 2.99_01 made by David Kernen - Potential compatibility issues from 3.17+ highlighted with '*' +version 3.39: Fri Feb 3 00:43:00 UTC 2017 + - rt.cpan.org#115726: uninitialized value via fetch_hash + [Malte Stretz] + - rt.cpan.org#119523: better error reporting on failed TLS connections + [Matthew Horsfall] + - rt.cpan.org#114904: document noop() + [Glenn Golden] + - rt.cpan.org#97718: (redux) never retry DONE + [Laurence Darby] + - _imap_command() new doretry => 0|1 option to suppress/allow retry + - updated copyright for 2017 + version 3.38: Tue Feb 9 02:48:21 UTC 2016 - rt.cpan.org#107592: redact credentials via debug if !Showcredentials [Gilles Lamiral] diff --git a/W/Mail-IMAPClient-3.38/MANIFEST b/W/Mail-IMAPClient-3.39/MANIFEST similarity index 100% rename from W/Mail-IMAPClient-3.38/MANIFEST rename to W/Mail-IMAPClient-3.39/MANIFEST diff --git a/W/Mail-IMAPClient-3.38/META.json b/W/Mail-IMAPClient-3.39/META.json similarity index 91% rename from W/Mail-IMAPClient-3.38/META.json rename to W/Mail-IMAPClient-3.39/META.json index 7985ffd..8d7c850 100644 --- a/W/Mail-IMAPClient-3.38/META.json +++ b/W/Mail-IMAPClient-3.39/META.json @@ -4,7 +4,7 @@ "Phil Pearl (Lobbes) " ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", + "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "perl_5" ], @@ -52,5 +52,5 @@ "resources" : { "homepage" : "http://sourceforge.net/projects/mail-imapclient/" }, - "version" : "3.38" + "version" : "3.39" } diff --git a/W/Mail-IMAPClient-3.39/META.yml b/W/Mail-IMAPClient-3.39/META.yml new file mode 100644 index 0000000..48efe03 --- /dev/null +++ b/W/Mail-IMAPClient-3.39/META.yml @@ -0,0 +1,36 @@ +--- +abstract: 'IMAP4 client library' +author: + - 'Phil Pearl (Lobbes) ' +build_requires: + ExtUtils::MakeMaker: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Mail-IMAPClient +no_index: + directory: + - t + - inc +requires: + Carp: '0' + Errno: '0' + Fcntl: '0' + File::Temp: '0' + IO::File: '0' + IO::Select: '0' + IO::Socket: '0' + IO::Socket::INET: '1.26' + List::Util: '0' + MIME::Base64: '0' + Parse::RecDescent: '1.94' + Test::More: '0' + perl: '5.008' +resources: + homepage: http://sourceforge.net/projects/mail-imapclient/ +version: '3.39' diff --git a/W/Mail-IMAPClient-3.38/Makefile.PL b/W/Mail-IMAPClient-3.39/Makefile.PL similarity index 100% rename from W/Mail-IMAPClient-3.38/Makefile.PL rename to W/Mail-IMAPClient-3.39/Makefile.PL diff --git a/W/Mail-IMAPClient-3.38/README b/W/Mail-IMAPClient-3.39/README similarity index 98% rename from W/Mail-IMAPClient-3.38/README rename to W/Mail-IMAPClient-3.39/README index ece2549..772544f 100644 --- a/W/Mail-IMAPClient-3.38/README +++ b/W/Mail-IMAPClient-3.39/README @@ -84,7 +84,7 @@ COPYRIGHT AND LICENSE ===================== Copyright (C) 1999-2003 The Kernen Group, Inc. Copyright (C) 2007-2009 Mark Overmeer -Copyright (C) 2010-2016 Phil Pearl (Lobbes) +Copyright (C) 2010-2017 Phil Pearl (Lobbes) All rights reserved. This library is free software; you can redistribute it and/or modify diff --git a/W/Mail-IMAPClient-3.38/examples/build_dist.pl b/W/Mail-IMAPClient-3.39/examples/build_dist.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/build_dist.pl rename to W/Mail-IMAPClient-3.39/examples/build_dist.pl diff --git a/W/Mail-IMAPClient-3.38/examples/build_ldif.pl b/W/Mail-IMAPClient-3.39/examples/build_ldif.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/build_ldif.pl rename to W/Mail-IMAPClient-3.39/examples/build_ldif.pl diff --git a/W/Mail-IMAPClient-3.38/examples/cleanTest.pl b/W/Mail-IMAPClient-3.39/examples/cleanTest.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/cleanTest.pl rename to W/Mail-IMAPClient-3.39/examples/cleanTest.pl diff --git a/W/Mail-IMAPClient-3.38/examples/copy_folder.pl b/W/Mail-IMAPClient-3.39/examples/copy_folder.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/copy_folder.pl rename to W/Mail-IMAPClient-3.39/examples/copy_folder.pl diff --git a/W/Mail-IMAPClient-3.38/examples/cyrus_expire.pl b/W/Mail-IMAPClient-3.39/examples/cyrus_expire.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/cyrus_expire.pl rename to W/Mail-IMAPClient-3.39/examples/cyrus_expire.pl diff --git a/W/Mail-IMAPClient-3.38/examples/cyrus_expunge.pl b/W/Mail-IMAPClient-3.39/examples/cyrus_expunge.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/cyrus_expunge.pl rename to W/Mail-IMAPClient-3.39/examples/cyrus_expunge.pl diff --git a/W/Mail-IMAPClient-3.38/examples/find_dup_msgs.pl b/W/Mail-IMAPClient-3.39/examples/find_dup_msgs.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/find_dup_msgs.pl rename to W/Mail-IMAPClient-3.39/examples/find_dup_msgs.pl diff --git a/W/Mail-IMAPClient-3.38/examples/idle.pl b/W/Mail-IMAPClient-3.39/examples/idle.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/idle.pl rename to W/Mail-IMAPClient-3.39/examples/idle.pl diff --git a/W/Mail-IMAPClient-3.38/examples/imap_to_mbox.pl b/W/Mail-IMAPClient-3.39/examples/imap_to_mbox.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/imap_to_mbox.pl rename to W/Mail-IMAPClient-3.39/examples/imap_to_mbox.pl diff --git a/W/Mail-IMAPClient-3.38/examples/imtestExample.pl b/W/Mail-IMAPClient-3.39/examples/imtestExample.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/imtestExample.pl rename to W/Mail-IMAPClient-3.39/examples/imtestExample.pl diff --git a/W/Mail-IMAPClient-3.38/examples/migrate_mail2.pl b/W/Mail-IMAPClient-3.39/examples/migrate_mail2.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/migrate_mail2.pl rename to W/Mail-IMAPClient-3.39/examples/migrate_mail2.pl diff --git a/W/Mail-IMAPClient-3.38/examples/migrate_mbox.pl b/W/Mail-IMAPClient-3.39/examples/migrate_mbox.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/migrate_mbox.pl rename to W/Mail-IMAPClient-3.39/examples/migrate_mbox.pl diff --git a/W/Mail-IMAPClient-3.38/examples/populate_mailbox.pl b/W/Mail-IMAPClient-3.39/examples/populate_mailbox.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/populate_mailbox.pl rename to W/Mail-IMAPClient-3.39/examples/populate_mailbox.pl diff --git a/W/Mail-IMAPClient-3.38/examples/sharedFolder.pl b/W/Mail-IMAPClient-3.39/examples/sharedFolder.pl similarity index 100% rename from W/Mail-IMAPClient-3.38/examples/sharedFolder.pl rename to W/Mail-IMAPClient-3.39/examples/sharedFolder.pl diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pm b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient.pm old mode 100644 new mode 100755 similarity index 99% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pm rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient.pm index 6df532f..5f6f724 --- a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pm +++ b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient.pm @@ -7,7 +7,7 @@ use strict; use warnings; package Mail::IMAPClient; -our $VERSION = '3.38'; +our $VERSION = '3.39'; use Mail::IMAPClient::MessageSet; @@ -46,7 +46,7 @@ my %SEARCH_KEYS = map { ( $_ => 1 ) } qw( # modules require(d) during runtime when applicable my %Load_Module = ( "Compress-Zlib" => "Compress::Zlib", - "INET" => "IO::Socket::INET", + "INET" => "IO::Socket::INET6", "SSL" => "IO::Socket::SSL", "UNIX" => "IO::Socket::UNIX", "BodyStructure" => "Mail::IMAPClient::BodyStructure", @@ -366,7 +366,11 @@ sub connect(@) { return $self->Socket($sock); } else { - my $lasterr = $self->LastError || ""; + my $lasterr = $self->LastError; + if ( !$lasterr and $self->Ssl and $ioclass ) { + $lasterr = $ioclass->errstr; + } + $lasterr ||= ""; $self->LastError("Unable to connect to $server: $lasterr"); return undef; } @@ -1165,7 +1169,8 @@ sub done { my $count = shift || $self->Count; # DONE looks like a tag when sent and not already in IDLE - $self->_imap_command( { addtag => 0, tag => qr/(?:$count|DONE)/ }, "DONE" ) + $self->_imap_command( + { addtag => 0, tag => qr/(?:$count|DONE)/, doretry => 0 }, "DONE" ) or return undef; return $self->Results; } @@ -1211,8 +1216,11 @@ sub reconnect { } # wrapper for _imap_command_do to enable retrying on lost connections +# options: +# doretry => 0|1 - suppress|allow retry after reconnect sub _imap_command { my $self = shift; + my $opt = ref( $_[0] ) eq "HASH" ? $_[0] : {}; my $tries = 0; my $retry = $self->Reconnectretry || 0; @@ -1241,6 +1249,7 @@ sub _imap_command { my $ret = $self->reconnect; if ($ret) { $self->_debug("reconnect success($ret) on try #$tries/$retry"); + last if exists $opt->{doretry} and !$opt->{doretry}; } elsif ( defined $ret and $ret == 0 ) { # escaping recursion return undef; @@ -2297,9 +2306,15 @@ sub fetch_hash { # NOTE: old code tried to remove any "unrequested" data in $entry # - UID is sometimes not explicitly requested, are there others? + # - rt#115726: Uid and $entry->{UID} not set, ignore unsolicited data if ( $self->Uid ) { - $uids->{ $entry->{UID} } = $entry; - delete $entry->{UID} unless $asked_for_uid; + if ( $entry->{UID} ) { + $uids->{ $entry->{UID} } = $entry; + delete $entry->{UID} unless $asked_for_uid; + } + else { + $self->_debug("ignoring unsolicited response: $l"); + } } else { $uids->{$mid} = $entry; diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pod b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient.pod similarity index 99% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pod rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient.pod index d6d969b..e2c9ae4 100644 --- a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pod +++ b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient.pod @@ -2116,9 +2116,24 @@ the IMAP client command "STATUS folder RECENT"), or C in the case of an error. The B method was contributed by Rob Deker (deker@ikimbo.com). +=head2 noop + +Example: + + $imap->noop or die "noop failed: $@\n"; + +The B method performs an IMAP NOOP command. Per RFC3501 this +command does nothing and always succeeds. However, if a connection +times out or other errors occur while communicating with the server, +this method can still fail. This command can be used as a periodic +poll to check for (untagged) status updates (new messages, etc.) from +the server and also to reset any inactivity/auto-logout timers the +server may maintain. + =head2 reconnect Example: + $imap->noop or $imap->reconnect or die "noop failed: $@\n"; Attempt to reconnect if the IMAP connection unless $imap is already in @@ -3969,7 +3984,7 @@ http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient Copyright (C) 1999-2003 The Kernen Group, Inc. Copyright (C) 2007-2009 Mark Overmeer - Copyright (C) 2010-2016 Phil Pearl (Lobbes) + Copyright (C) 2010-2017 Phil Pearl (Lobbes) All rights reserved. This library is free software; you can redistribute it and/or modify diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure.pm b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure.pm similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure.pm rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure.pm diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.grammar b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure/Parse.grammar similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.grammar rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure/Parse.grammar diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.pm b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure/Parse.pm similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.pm rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure/Parse.pm diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.pod b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure/Parse.pod similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.pod rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/BodyStructure/Parse.pod diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/MessageSet.pm b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/MessageSet.pm similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/MessageSet.pm rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/MessageSet.pm diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.grammar b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/Thread.grammar similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.grammar rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/Thread.grammar diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.pm b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/Thread.pm similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.pm rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/Thread.pm diff --git a/W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.pod b/W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/Thread.pod similarity index 100% rename from W/Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.pod rename to W/Mail-IMAPClient-3.39/lib/Mail/IMAPClient/Thread.pod diff --git a/W/Mail-IMAPClient-3.38/prepare_dist b/W/Mail-IMAPClient-3.39/prepare_dist similarity index 100% rename from W/Mail-IMAPClient-3.38/prepare_dist rename to W/Mail-IMAPClient-3.39/prepare_dist diff --git a/W/Mail-IMAPClient-3.38/t/basic.t b/W/Mail-IMAPClient-3.39/t/basic.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/basic.t rename to W/Mail-IMAPClient-3.39/t/basic.t diff --git a/W/Mail-IMAPClient-3.38/t/body_string.t b/W/Mail-IMAPClient-3.39/t/body_string.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/body_string.t rename to W/Mail-IMAPClient-3.39/t/body_string.t diff --git a/W/Mail-IMAPClient-3.38/t/bodystructure.t b/W/Mail-IMAPClient-3.39/t/bodystructure.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/bodystructure.t rename to W/Mail-IMAPClient-3.39/t/bodystructure.t diff --git a/W/Mail-IMAPClient-3.38/t/fetch_hash.t b/W/Mail-IMAPClient-3.39/t/fetch_hash.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/fetch_hash.t rename to W/Mail-IMAPClient-3.39/t/fetch_hash.t diff --git a/W/Mail-IMAPClient-3.38/t/lib/MyTest.pm b/W/Mail-IMAPClient-3.39/t/lib/MyTest.pm similarity index 100% rename from W/Mail-IMAPClient-3.38/t/lib/MyTest.pm rename to W/Mail-IMAPClient-3.39/t/lib/MyTest.pm diff --git a/W/Mail-IMAPClient-3.38/t/messageset.t b/W/Mail-IMAPClient-3.39/t/messageset.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/messageset.t rename to W/Mail-IMAPClient-3.39/t/messageset.t diff --git a/W/Mail-IMAPClient-3.38/t/pod.t b/W/Mail-IMAPClient-3.39/t/pod.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/pod.t rename to W/Mail-IMAPClient-3.39/t/pod.t diff --git a/W/Mail-IMAPClient-3.38/t/quota.t b/W/Mail-IMAPClient-3.39/t/quota.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/quota.t rename to W/Mail-IMAPClient-3.39/t/quota.t diff --git a/W/Mail-IMAPClient-3.38/t/simple.t b/W/Mail-IMAPClient-3.39/t/simple.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/simple.t rename to W/Mail-IMAPClient-3.39/t/simple.t diff --git a/W/Mail-IMAPClient-3.38/t/thread.t b/W/Mail-IMAPClient-3.39/t/thread.t similarity index 100% rename from W/Mail-IMAPClient-3.38/t/thread.t rename to W/Mail-IMAPClient-3.39/t/thread.t diff --git a/W/Mail-IMAPClient-3.38/test_template.txt b/W/Mail-IMAPClient-3.39/test_template.txt similarity index 100% rename from W/Mail-IMAPClient-3.38/test_template.txt rename to W/Mail-IMAPClient-3.39/test_template.txt diff --git a/W/build_exe.bat b/W/build_exe.bat index da9496a..52a1376 100644 --- a/W/build_exe.bat +++ b/W/build_exe.bat @@ -1,10 +1,10 @@ -REM $Id: build_exe.bat,v 1.40 2016/08/19 14:12:29 gilles Exp gilles $ +REM $Id: build_exe.bat,v 1.46 2017/08/23 13:04:40 gilles Exp gilles $ @SETLOCAL -ECHO Currently running through %0 %* +@ECHO Currently running through %0 %* -ECHO Building imapsync.exe +@ECHO Building imapsync.exe @REM the following command change current directory to the dirname of the current batch pathname CD /D %~dp0 @@ -24,8 +24,13 @@ EXIT /B :pp_exe @SETLOCAL -CALL pp -o imapsync.exe --link libeay32_.dll --link zlib1_.dll --link ssleay32_.dll .\imapsync -IF ERRORLEVEL 1 CALL pp -o imapsync.exe .\imapsync +@REM CALL pp -o imapsync.exe --link libeay32_.dll --link zlib1_.dll --link ssleay32_.dll .\imapsync +IF %PROCESSOR_ARCHITECTURE% == x86 ( + CALL pp -o imapsync.exe -M Test2::Formatter -M Test2::Formatter::TAP -M Test2::Event -M Test2::Event::Info --link zlib1_.dll --link libcrypto-1_1_.dll --link libssl-1_1_.dll .\imapsync + REM CALL pp -o imapsync.exe -M Test2::Formatter -M Test2::Formatter::TAP -M Test2::Event -M Test2::Event::Info --link zlib1_.dll .\imapsync +) ELSE ( + CALL pp -o imapsync.exe -M Test2::Formatter -M Test2::Formatter::TAP -M Test2::Event -M Test2::Event::Info .\imapsync +) @ENDLOCAL EXIT /B @@ -64,6 +69,7 @@ perl ^ -mIO::Socket::SSL ^ -mIO::Tee ^ -mMail::IMAPClient ^ + -mNet::Ping ^ -mTerm::ReadKey ^ -mTime::Local ^ -mUnicode::String ^ diff --git a/W/build_mac.sh b/W/build_mac.sh index 36c8e4e..14445f4 100755 --- a/W/build_mac.sh +++ b/W/build_mac.sh @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: build_mac.sh,v 1.6 2016/06/22 20:04:16 gilles Exp gilles $ +# $Id: build_mac.sh,v 1.8 2017/03/01 03:06:46 gilles Exp gilles $ # exit on any failure set -e @@ -26,8 +26,9 @@ cpanm Mail::IMAPClient IO::Socket::SSL PAR::Packer pp -o $BIN_NAME \ -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL \ -M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey \ - -M Authen::NTLM \ + -M Authen::NTLM -M Net::Ping \ -M Crypt::OpenSSL::RSA -M JSON -M JSON::WebToken -M LWP -M HTML::Entities \ + -M Sys::MemInfo \ imapsync ./imapsync_bin_Darwin diff --git a/W/checklink.txt b/W/checklink.txt index 267bf49..e69de29 100644 --- a/W/checklink.txt +++ b/W/checklink.txt @@ -1,11 +0,0 @@ - -Processing http://lamiral.info/~gilles/imapsync/ - - -List of broken links and other issues: -http://fr.linkedin.com/in/gilleslamiral - Line: 185 - Code: 405 Method Not Allowed - To do: The server does not allow HTTP HEAD requests, which prevents the - Link Checker to check the link automatically. Check the link - manually. diff --git a/W/imapsync.1 b/W/imapsync.1 index 828be1c..d63479e 100644 --- a/W/imapsync.1 +++ b/W/imapsync.1 @@ -1,4 +1,4 @@ -.\" Automatically generated by Pod::Man 2.27 (Pod::Simple 3.28) +.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29) .\" .\" Standard preamble: .\" ======================================================================== @@ -133,21 +133,20 @@ .\" ======================================================================== .\" .IX Title "IMAPSYNC 1" -.TH IMAPSYNC 1 "2016-08-19" "perl v5.18.2" "User Contributed Perl Documentation" +.TH IMAPSYNC 1 "2017-09-05" "perl v5.22.1" "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" -imapsync \- Email IMAP tool for syncing, copying and migrating email mailboxes. -.PP -The imapsync command synchronises mailboxes between two imap servers. -More than 69 different IMAP server softwares supported with success, -few failures. -.PP -$Revision: 1.727 $ -.SH "SYNOPSIS" -.IX Header "SYNOPSIS" +imapsync \- Email IMAP tool for syncing, copying and migrating +email mailboxes between two imap servers, one way, +and without duplicates. +.SH "VERSION" +.IX Header "VERSION" +This documentation refers to Imapsync \f(CW$Revision:\fR 1.836 $ +.SH "USAGE" +.IX Header "USAGE" .Vb 5 \& To synchronize the source imap account \& "test1" on server "test1.lamiral.info" with password "secret1" @@ -159,86 +158,104 @@ $Revision: 1.727 $ \& \-\-host1 test1.lamiral.info \-\-user1 test1 \-\-password1 secret1 \e \& \-\-host2 test2.lamiral.info \-\-user2 test2 \-\-password2 secret2 .Ve -.SH "REQUIRED ARGUMENTS" -.IX Header "REQUIRED ARGUMENTS" -The required argmuments are the six values, three on each sides, -needed to login into the \s-1IMAP\s0 servers, +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +We sometimes need to transfer mailboxes from one imap server to +another. +.PP +Imapsync command is a tool allowing incremental and +recursive imap transfers from one mailbox to another. +.PP +By default all folders are transferred, recursively, meaning +the whole folder hierarchy is taken, all messages in them, +and all messages flags (\eSeen \eAnswered \eFlagged etc.) +are synced too. +.PP +Imapsync reduces the amount +of data transferred by not transferring a given message +if it resides already on both sides. Same specific headers +and the transfer is done only once (by default it's +\&\*(L"Message-Id:\*(R" and \*(L"Received:\*(R" lines but it can be changed with +\&\-\-useheader option). +.PP +All flags are preserved, unread will stay unread, read will stay read, +deleted will stay deleted. +.PP +You can stop the transfer at any +time and restart it later, imapsync works well with bad +connections and interruptions. +.PP +You can decide to delete the messages from the source mailbox +after a successful transfer, it can be a good feature when migrating +live mailboxes since messages will be only on one side. +In that case, use the \-\-delete1 option. Option \-\-delete1 implies +also option \-\-expunge1 so all messages marked deleted on host1 +will be really deleted. +.PP +A different scenario is synchronizing a mailbox B from another mailbox A +in case you just want to keep a \*(L"live\*(R" copy of A in B. +In that case \-\-delete2 has to be used, it deletes messages in host2 +folder B that are not in host1 folder A. If you also need to destroy +host2 folders that are not in host1 then use \-\-delete2folders (see also +\&\-\-delete2foldersonly and \-\-delete2foldersbutnot). +.PP +Imapsync is not adequate for maintaining two active imap accounts +in synchronization when the user plays independently on both sides. +Use offlineimap (written by John Goerzen) or mbsync (written by +Michael R. Elkins) for a 2 ways synchronization. +.SH "OPTIONS" +.IX Header "OPTIONS" +.Vb 1 +\& usage: imapsync [options] +.Ve +.PP +Mandatory options are the six values, three on each sides, +needed to log in into the \s-1IMAP\s0 servers, ie, a host, a username, and a password, two times. -.SH "INSTALL" -.IX Header "INSTALL" -.Vb 5 -\& Imapsync works under any Unix with perl. -\& Imapsync works under Windows (2000, XP, Vista, Seven) -\& as a standalone binary software called imapsync.exe -\& Imapsync works under OS X as a standalone binary -\& software called imapsync_bin_Darwin. -\& -\& Purchase latest imapsync at -\& http://imapsync.lamiral.info/ -\& -\& You\*(Aqll receive a link to a compressed tarball called imapsync\-x.xx.tgz -\& where x.xx is the version number. Untar the tarball where -\& you want (on Unix): -\& -\& tar xzvf imapsync\-x.xx.tgz -\& -\& Go into the directory imapsync\-x.xx and read the INSTALL file. -\& As mentioned at http://imapsync.lamiral.info/#install -\& the INSTALL file can also be found at -\& http://imapsync.lamiral.info/INSTALL -\& It is now split in several files for each system -\& http://imapsync.lamiral.info/INSTALL.d/ -.Ve -.SH "CONFIGURATION" -.IX Header "CONFIGURATION" -There is no specific configuration file for imapsync, -everything is specified by the command line parameteres -and the default behavior. -.SH "USAGE" -.IX Header "USAGE" -To get a description of each option just run imapsync -with no argument, like this: .PP -.Vb 1 -\& imapsync -.Ve +Conventions used: .PP -This description of options is also available at -http://imapsync.lamiral.info/OPTIONS and is -reproduced here: -.PP -.Vb 1 -\& usage: ./imapsync [options] -\& -\& Several options are mandatory. +.Vb 4 \& str means string \& int means integer \& reg means regular expression \& cmd means command \& -\& \-\-dry : Makes imapsync doing nothing, just print what would -\& be done without \-\-dry. -\& +\& \-\-dry : Makes imapsync doing nothing for real, just print what +\& would be done without \-\-dry. +.Ve +.SS "OPTIONS/credentials" +.IX Subsection "OPTIONS/credentials" +.Vb 8 \& \-\-host1 str : Source or "from" imap server. Mandatory. \& \-\-port1 int : Port to connect on host1. Default is 143, 993 if \-\-ssl1 \& \-\-user1 str : User to login on host1. Mandatory. -\& \-\-showpasswords : Shows passwords on output instead of "MASKED". -\& Useful to restart a complete run by just reading the log. \& \-\-password1 str : Password for the user1. \& \-\-host2 str : "destination" imap server. Mandatory. \& \-\-port2 int : Port to connect on host2. Default is 143, 993 if \-\-ssl2 \& \-\-user2 str : User to login on host2. Mandatory. \& \-\-password2 str : Password for the user2. \& +\& \-\-showpasswords : Shows passwords on output instead of "MASKED". +\& Useful to restart a complete run by just reading the log, +\& or to debug passwords. It\*(Aqs not a secure practice. +\& \& \-\-passfile1 str : Password file for the user1. It must contain the \& password on the first line. This option avoids to show \& the password on the command line like \-\-password1 does. \& \-\-passfile2 str : Password file for the user2. Contains the password. -\& -\& \-\-ssl1 : Use a SSL connection on host1. -\& \-\-ssl2 : Use a SSL connection on host2. -\& \-\-tls1 : Use a TLS connection on host1. -\& \-\-tls2 : Use a TLS connection on host2. +.Ve +.SS "OPTIONS/encryption" +.IX Subsection "OPTIONS/encryption" +.Vb 10 +\& \-\-nossl1 : Do not use a SSL connection on host1. +\& \-\-ssl1 : Use a SSL connection on host1. On by default if possible. +\& \-\-nossl2 : Do not use a SSL connection on host2. +\& \-\-ssl2 : Use a SSL connection on host2. On by default if possible. +\& \-\-notls1 : Do not use a TLS connection on host1. +\& \-\-tls1 : Use a TLS connection on host1. On by default if possible. +\& \-\-notls2 : Do not use a TLS connection on host2. +\& \-\-tls2 : Use a TLS connection on host2. On by default if possible. \& \-\-debugssl int : SSL debug mode from 0 to 4. \& \-\-sslargs1 str : Pass any ssl parameter for host1 ssl or tls connection. Example: \& \-\-sslargs1 SSL_verify_mode=1 \-\-sslargs1 SSL_version=SSLv3 @@ -251,7 +268,10 @@ reproduced here: \& Default is 120 and 0 means no timeout at all. \& \-\-timeout2 int : Connection timeout in seconds for host2. \& Default is 120 and 0 means no timeout at all. -\& +.Ve +.SS "OPTIONS/authentication" +.IX Subsection "OPTIONS/authentication" +.Vb 3 \& \-\-authmech1 str : Auth mechanism to use with host1: \& PLAIN, LOGIN, CRAM\-MD5 etc. Use UPPERCASE. \& \-\-authmech2 str : Auth mechanism to use with host2. See \-\-authmech1 @@ -264,12 +284,14 @@ reproduced here: \& be able to use an administrative user. \& \-\-proxyauth2 : Use proxyauth on host2. Requires \-\-authuser2. \& -\& \-\-authmd51 : Use MD5 authentification for host1. -\& \-\-authmd52 : Use MD5 authentification for host2. +\& \-\-authmd51 : Use MD5 authentication for host1. +\& \-\-authmd52 : Use MD5 authentication for host2. \& \-\-domain1 str : Domain on host1 (NTLM authentication). \& \-\-domain2 str : Domain on host2 (NTLM authentication). -\& -\& +.Ve +.SS "OPTIONS/folders" +.IX Subsection "OPTIONS/folders" +.Vb 4 \& \-\-folder str : Sync this folder. \& \-\-folder str : and this one, etc. \& \-\-folderrec str : Sync this folder recursively. @@ -280,17 +302,16 @@ reproduced here: \& \-\-folderlast str : Sync this folder last. \-\-folderlast "[Gmail]/All Mail" \& \-\-folderlast str : then this one, etc. \& -\& \-\-nomixfolders : Do not merge folders when host1 is case sensitive +\& \-\-nomixfolders : Do not merge folders when host1 is case\-sensitive \& while host2 is not (like Exchange). Only the first \& similar folder is synced (ex: Sent SENT sent \-> Sent). \& \& \-\-skipemptyfolders : Empty host1 folders are not created on host2. \& -\& \-\-f1f2 str1=str2 : Force folder str1 to be synced to str2. \& \-\-include reg : Sync folders matching this regular expression \& \-\-include reg : or this one, etc. -\& in case both \-\-include \-\-exclude options are -\& use, include is done before. +\& If both \-\-include \-\-exclude options are used, then +\& include is done before. \& \-\-exclude reg : Skips folders matching this regular expression \& Several folders to avoid: \& \-\-exclude \*(Aqfold1|fold2|f3\*(Aq skips fold1, fold2 and f3. @@ -301,37 +322,73 @@ reproduced here: \& It does it by adding two \-\-regextrans2 options before \& all others. Add \-\-debug to see what\*(Aqs really going on. \& +\& \-\-automap : guesses folders mapping, for folders like +\& "Sent", "Junk", "Drafts", "All", "Archive", "Flagged". +\& \-\-f1f2 str1=str2 : Force folder str1 to be synced to str2, +\& \-\-f1f2 overrides \-\-automap and \-\-regextrans2. +\& +\& \-\-nomixfolders : Avoid merging folders that are considered different on +\& host1 but the same on destination host2 because of +\& case sensitivities and insensitivities. +\& +\& \-\-subscribed : Transfers subscribed folders. +\& \-\-subscribe : Subscribe to the folders transferred on the +\& host2 that are subscribed on host1. On by default. +\& \-\-subscribeall : Subscribe to the folders transferred on the +\& host2 even if they are not subscribed on host1. +\& +\& \-\-prefix1 str : Remove prefix str to all destination folders, +\& usually INBOX. or INBOX/ or an empty string "". +\& imapsync guesses the prefix if host1 imap server +\& does not have NAMESPACE capability. This option +\& should not be used, most of the time. +\& \-\-prefix2 str : Add prefix to all host2 folders. See \-\-prefix1 +\& \-\-sep1 str : Host1 separator in case NAMESPACE is not supported. +\& \-\-sep2 str : Host2 separator in case NAMESPACE is not supported. +\& \& \-\-regextrans2 reg : Apply the whole regex to each destination folders. \& \-\-regextrans2 reg : 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. \& Have in mind that \-\-regextrans2 is applied after prefix -\& and separator inversion. -\& +\& and separator inversion. For examples see +\& http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt +.Ve +.SS "OPTIONS/folders sizes" +.IX Subsection "OPTIONS/folders sizes" +.Vb 5 +\& \-\-nofoldersizes : Do not calculate the size of each folder at the +\& beginning of the sync. Default is to calculate them. +\& \-\-nofoldersizesatend: Do not calculate the size of each folder at the +\& end of the sync. Default is to calculate them. +\& \-\-justfoldersizes : Exit after having printed the initial folder sizes. +.Ve +.SS "OPTIONS/tmp" +.IX Subsection "OPTIONS/tmp" +.Vb 10 \& \-\-tmpdir str : Where to store temporary files and subdirectories. \& Will be created if it doesn\*(Aqt exist. \& Default is system specific, Unix is /tmp but -\& it\*(Aqs often small and deleted at reboot. +\& /tmp is often too small and deleted at reboot. \& \-\-tmpdir /var/tmp should be better. -\& \-\-pidfile str : The file where imapsync pid is written. -\& \-\-pidfilelocking : Abort if pidfile already exists. Usefull to avoid +\& \-\-pidfile str : The file where imapsync pid is written, +\& it can be dirname/filename. +\& Default name is imapsync.pid in tmpdir. +\& \-\-pidfilelocking : Abort if pidfile already exists. Useful to avoid \& concurrent transfers on the same mailbox. -\& +.Ve +.SS "OPTIONS/log" +.IX Subsection "OPTIONS/log" +.Vb 3 \& \-\-nolog : Turn off logging on file \& \-\-logfile str : Change the default log filename (can be dirname/filename). -\& \-\-logdir str : Change the default log directory. Default is LOG_imapsync -\& -\& \-\-prefix1 str : Remove prefix to all destination folders -\& (usually INBOX. or INBOX/ or an empty string "") -\& you have to use \-\-prefix1 if host1 imap server -\& does not have NAMESPACE capability, so imapsync -\& suggests to use it. All other cases are bad. -\& \-\-prefix2 str : Add prefix to all host2 folders. See \-\-prefix1 -\& \-\-sep1 str : Host1 separator in case NAMESPACE is not supported. -\& \-\-sep2 str : Host2 separator in case NAMESPACE is not supported. -\& -\& \-\-skipmess reg : Skips messages maching the regex. +\& \-\-logdir str : Change the default log directory. Default is LOG_imapsync/ +.Ve +.SS "OPTIONS/messages" +.IX Subsection "OPTIONS/messages" +.Vb 4 +\& \-\-skipmess reg : Skips messages matching the regex. \& Example: \*(Aqm/[\ex80\-ff]/\*(Aq # to avoid 8bits messages. \& \-\-skipmess is applied before \-\-regexmess \& \-\-skipmess reg : or this one, etc. @@ -345,16 +402,33 @@ reproduced here: \& \-\-regexmess reg : Apply the whole regex to each message before transfer. \& Example: \*(Aqs/\e000/ /g\*(Aq # to replace null by space. \& \-\-regexmess reg : and this one, etc. -\& +.Ve +.SS "OPTIONS/flags" +.IX Subsection "OPTIONS/flags" +.Vb 3 \& \-\-regexflag reg : Apply the whole regex to each flags list. \& Example: \*(Aqs/"Junk"//g\*(Aq # to remove "Junk" flag. -\& \-\-regexflag reg : and this one, etc. -\& -\& \-\-delete : Deletes messages on host1 server after a successful -\& transfer. Option \-\-delete has the following behavior: +\& \-\-regexflag reg : then this one, etc. +.Ve +.SS "OPTIONS/deletions" +.IX Subsection "OPTIONS/deletions" +.Vb 10 +\& \-\-delete1 : Deletes messages on host1 server after a successful +\& transfer. Option \-\-delete1 has the following behavior: \& it marks messages as deleted with the IMAP flag \& \eDeleted, then messages are really deleted with an -\& EXPUNGE IMAP command. +\& EXPUNGE IMAP command. If expunging after each message +\& slows down too much the sync then use +\& \-\-noexpungeaftereach to speed up. +\& \-\-expunge1 : Expunge messages on host1 just before syncing a folder. +\& Expunge is done per folder. +\& Expunge aims is to really delete messages marked deleted. +\& An expunge is also done after each message copied +\& if option \-\-delete1 is set. +\& \-\-noexpunge1 : Do not expunge messages on host1. +\& \-\-delete1emptyfolders : Deletes empty folders on host1, INBOX excepted. +\& Useful with \-\-delete1 since what remains on host1 +\& is only what failed to be synced. \& \& \-\-delete2 : Delete messages in host2 that are not in \& host1 server. Useful for backup or pre\-sync. @@ -369,26 +443,23 @@ reproduced here: \& Example: \-\-delete2foldersonly "/^Junk$|^INBOX.Junk$/" \& \-\-delete2foldersbutnot reg : Do not delete folders matching regex. \& Example: \-\-delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" -\& \-\-noexpunge : Do not expunge messages on host1. -\& Expunge really deletes messages marked deleted. -\& Expunge is made at the beginning, on host1 only. -\& Newly transferred messages are also expunged if -\& option \-\-delete is given. -\& No expunge is done on host2 account (unless \-\-expunge2) -\& \-\-expunge1 : Expunge messages on host1 after messages transfer. +\& \& \-\-expunge2 : Expunge messages on host2 after messages transfer. \& \-\-uidexpunge2 : uidexpunge messages on the host2 account \& that are not on the host1 account, requires \-\-delete2 -\& \-\-nomixfolders : Avoid merging folders that are considered different on -\& host1 but the same on destination host2 because of -\& case sensitivities and insensitivities. -\& +.Ve +.SS "OPTIONS/dates" +.IX Subsection "OPTIONS/dates" +.Vb 5 \& \-\-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. -\& +.Ve +.SS "OPTIONS/message selection" +.IX Subsection "OPTIONS/message selection" +.Vb 12 \& \-\-maxsize int : Skip messages larger (or equal) than int bytes \& \-\-minsize int : Skip messages smaller (or equal) than int bytes \& \-\-maxage int : Skip messages older than int days. @@ -408,44 +479,34 @@ reproduced here: \& \-\-search2 str : Same as \-\-search for selecting host2 messages only. \& \-\-search CRIT equals \-\-search1 CRIT \-\-search2 CRIT \& -\& \-\-exitwhenover int : Stop syncing when total bytes transferred reached. -\& Gmail per day allows -\& 2500000000 = 2.5 GB downloaded from Gmail as host2 -\& 500000000 = 500 MB uploaded to Gmail as host1. -\& \& \-\-maxlinelength int : skip messages with a line length longer than int bytes. \& RFC 2822 says it must be no more than 1000 bytes. \& +\& \& \-\-useheader str : Use this header to compare messages on both sides. \& Ex: Message\-ID or Subject or Date. \& \-\-useheader str and this one, etc. \& -\& \-\-subscribed : Transfers subscribed folders. -\& \-\-subscribe : Subscribe to the folders transferred on the -\& host2 that are subscribed on host1. On by default. -\& \-\-subscribeall : Subscribe to the folders transferred on the -\& host2 even if they are not subscribed on host1. -\& -\& \-\-nofoldersizes : Do not calculate the size of each folder in bytes -\& and message counts. Default is to calculate them. -\& \-\-nofoldersizesatend: Do not calculate the size of each folder in bytes -\& and message counts at the end. Default is on. -\& \-\-justfoldersizes : Exit after having printed the folder sizes. -\& -\& \-\-syncacls : Synchronises acls (Access Control Lists). -\& \-\-nosyncacls : Does not synchronize acls. This is the default. -\& Acls in IMAP are not standardized, be careful. -\& -\& \-\-usecache : Use cache to speedup. +\& \-\-usecache : Use cache to speed up the sync. \& \-\-nousecache : Do not use cache. Caveat: \-\-useuid \-\-nousecache creates \& duplicates on multiple runs. \& \-\-useuid : Use uid instead of header as a criterium to recognize \& messages. Option \-\-usecache is then implied unless \& \-\-nousecache is used. -\& +.Ve +.SS "OPTIONS/miscelaneous" +.IX Subsection "OPTIONS/miscelaneous" +.Vb 3 +\& \-\-syncacls : Synchronizes acls (Access Control Lists). +\& \-\-nosyncacls : Does not synchronize acls. This is the default. +\& Acls in IMAP are not standardized, be careful. +.Ve +.SS "OPTIONS/debugging" +.IX Subsection "OPTIONS/debugging" +.Vb 8 \& \-\-debug : Debug mode. \& \-\-debugfolders : Debug mode for the folders part only. -\& \-\-debugcontent : Debug content of the messages transfered. Huge ouput. +\& \-\-debugcontent : Debug content of the messages transferred. Huge output. \& \-\-debugflags : Debug mode for flags. \& \-\-debugimap1 : IMAP debug mode for host1. Very verbose. \& \-\-debugimap2 : IMAP debug mode for host2. Very verbose. @@ -457,6 +518,40 @@ reproduced here: \& \-\-tests : Run local non\-regression tests. Exit code 0 means all ok. \& \-\-testslive : Run a live test with test1.lamiral.info imap server. \& Useful to check the basics. Needs internet connexion. +\& \-\-testslive6 : Run a live test with ks2ipv6.lamiral.info imap server. +\& Useful to check the ipv6 connectivity. Needs internet. +.Ve +.SS "OPTIONS/specific" +.IX Subsection "OPTIONS/specific" +.Vb 2 +\& \-\-gmail1 : sets \-\-host1 to Gmail and options from FAQ.Gmail.txt +\& \-\-gmail2 : sets \-\-host2 to Gmail and options from FAQ.Gmail.txt +\& +\& \-\-office1 : sets \-\-host1 to Office365 options from FAQ.Exchange.txt +\& \-\-office2 : sets \-\-host2 to Office365 options from FAQ.Exchange.txt +\& +\& \-\-exchange1 : sets options from FAQ.Exchange.txt, account1 part +\& \-\-exchange2 : sets options from FAQ.Exchange.txt, account2 part +\& +\& \-\-domino1 : sets options from FAQ.Domino.txt, account1 part +\& \-\-domino2 : sets options from FAQ.Domino.txt, account2 part +.Ve +.SS "OPTIONS/behavior" +.IX Subsection "OPTIONS/behavior" +.Vb 1 +\& \-\-maxmessagespersecond int : limits the number of messages transferred per second. +\& +\& \-\-maxbytespersecond int : limits the average transfer rate per second. +\& \-\-maxbytesafter int : starts \-\-maxbytespersecond limitation only after +\& \-\-maxbytesafter amount of data transferred. +\& +\& \-\-maxsleep int : do not sleep more than int seconds. +\& On by default, 2 seconds max, like \-\-maxsleep 2 +\& +\& \-\-abort : terminates a previous call still running. +\& It uses the pidfile to know what processus to abort. +\& +\& \-\-exitwhenover int : Stop syncing when total bytes transferred reached. \& \& \-\-version : Print only software version. \& \-\-noreleasecheck : Do not check for new imapsync release (a http request). @@ -470,97 +565,15 @@ reproduced here: \& \& \-\-help : print this help. \& -\& Example: -\& To synchronize the source imap account -\& "test1" on server "test1.lamiral.info" with password "secret1" -\& to the destination imap account -\& "test2" on server "test2.lamiral.info" with password "secret2" -\& do: +\& Example: to synchronize imap account "test1" on "test1.lamiral.info" +\& to imap account "test2" on "test2.lamiral.info" +\& with test1 password "secret1" +\& and test2 password "secret2" \& \& imapsync \e \& \-\-host1 test1.lamiral.info \-\-user1 test1 \-\-password1 secret1 \e \& \-\-host2 test2.lamiral.info \-\-user2 test2 \-\-password2 secret2 .Ve -.SH "DESCRIPTION" -.IX Header "DESCRIPTION" -Imapsync command is a tool allowing incremental and -recursive imap transfers from one mailbox to another. -.PP -By default all folders are transferred, recursively, all -possible flags (\eSeen \eAnswered \eFlagged etc.) are synced too. -.PP -We sometimes need to transfer mailboxes from one imap server to -another. This is called migration. -.PP -Imapsync reduces the amount -of data transferred by not transferring a given message -if it resides already on both sides. Same specific headers -and the transfer is done only once; taken into account are by default -Message-Id and Received header lines. -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 and interruptions. -.PP -You can decide to delete the messages from the source mailbox -after a successful transfer, it can be a good feature when migrating -live mailboxes since messages will be only on one side. -In that case, use the \-\-delete option. Option \-\-delete implies -also option \-\-expunge so all messages marked deleted on host1 -will be really deleted. -(you can use \-\-noexpunge to avoid this but I don't see any -good real world scenario for the combination \-\-delete \-\-noexpunge). -.PP -A different scenario is synchronizing a mailbox B from another mailbox A -in case you just want to keep a \*(L"live\*(R" copy of A in B. -In that case \-\-delete2 has to be used, it deletes messages in host2 -folder B that are not in host1 folder A. If you also need to destroy -host2 folders that are not in host1 then use \-\-delete2folders (see also -\&\-\-delete2foldersonly and \-\-delete2foldersbutnot). -.PP -Imapsync is not adequate for maintaining two active imap accounts -in synchronization when the user plays independently on both sides. -Use offlineimap (written by John Goerzen) or mbsync (written by -Michael R. Elkins) for 2 ways synchronizations. -.SH "OPTIONS" -.IX Header "OPTIONS" -To get a description of each option just invoke: -.PP -.Vb 1 -\& imapsync -.Ve -.PP -or read the previous section named \s-1USAGE,\s0 -.PP -or read http://imapsync.lamiral.info/OPTIONS -.SH "HISTORY" -.IX Header "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 its 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). -.SH "EXAMPLE" -.IX Header "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. -.PP -To synchronize the imap account \*(L"buddy\*(R" (with password \*(L"secret1\*(R") -on host \*(L"imap.src.fr\*(R" to the imap account \*(L"max\*(R" (with password \*(L"secret2\*(R") -on host \*(L"imap.dest.fr\*(R": -.PP -.Vb 2 -\& imapsync \-\-host1 imap.src.fr \-\-user1 buddy \-\-password1 secret1 \e -\& \-\-host2 imap.dest.fr \-\-user2 max \-\-password2 secret2 -.Ve -.PP -Then you will have max's mailbox updated from buddy's -mailbox. .SH "SECURITY" .IX Header "SECURITY" You can use \-\-passfile1 instead of \-\-password1 to give the @@ -571,84 +584,42 @@ dangerous because of the 'ps auxwwwwe' command. So, saving the password in a well protected file (600 or rw\-\-\-\-\-\-\-) is the best solution. .PP -imasync is not totally protected against sniffers on the -network since passwords may be transferred in plain text -if \s-1CRAM\-MD5\s0 is not supported by your imap servers. Use -\&\-\-ssl1 (or \-\-tls1) and \-\-ssl2 (or \-\-tls2) to enable -encryption on host1 and host2. +Imapsync activates ssl or tls encryption by default, if possible. +What details are under this \*(L"if possible\*(R"? +Imapsync activates ssl if the well known port imaps port (993) is open +on the imap servers. If the imaps port is closed then it open a +normal (clear) connection on port 143 but it looks for \s-1TLS\s0 support +in the \s-1CAPABILITY\s0 list of the servers. If \s-1TLS\s0 is supported +then imapsync goes to encryption. .PP -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 \*(L"adminuser\*(R" to enable this on host1. In this -case, \-\-authmech1 \s-1PLAIN\s0 will be used by default since it -is the only way to go for now. So don't use \-\-authmech1 \s-1SOMETHING\s0 -with \-\-authuser1 \*(L"adminuser\*(R", it will not work. -Same behavior with the \-\-authuser2 option. -Authenticate with an admin account must be supported by your -imap server to work with imapsync. +If the automatic ssl/tls detection fails then imapsync will +not protect against sniffing activities on the +network, especially for passwords. .PP -When working on Sun/iPlanet/Netscape \s-1IMAP\s0 servers you must use -\&\-\-proxyauth1 to enable administrative user to masquerade as another user. -Can also be used on destination server with \-\-proxyauth2 -.PP -You can authenticate with \s-1OAUTH\s0 when transfering from Google Apps. -The consumer key will be the domain part of the \-\-user, and the -\&\-\-password will be used as the consumer secret. It does not work -with Google Apps free edition. +See also the document \s-1FAQ\s0.Security.txt in the \s-1FAQ\s0.d/ directory +or at https://imapsync.lamiral.info/FAQ.d/FAQ.Security.txt .SH "EXIT STATUS" .IX Header "EXIT STATUS" -imapsync will exit with a 0 status (return code) if everything went good. +Imapsync will exit with a 0 status (return code) if everything went good. Otherwise, it exits with a non-zero status. -.PP -So if you have an unreliable internet connection, you can use this loop -in a Bourne shell: -.PP -.Vb 3 -\& while ! imapsync ...; do -\& echo imapsync not complete -\& done -.Ve .SH "LICENSE AND COPYRIGHT" .IX Header "LICENSE AND COPYRIGHT" -imapsync is free, open, public but not always gratis software +Imapsync is free, open, public but not always gratis software cover by the \s-1NOLIMIT\s0 Public License. See the \s-1LICENSE\s0 file included in the distribution or just read this -simple sentence as it is the licence text: +simple sentence as it \s-1IS\s0 the licence text: .PP .Vb 1 \& "No limit to do anything with this work and this license." .Ve .PP -In case it is not long enough I repeat: +In case it is not long enough, I repeat: .PP .Vb 1 \& "No limit to do anything with this work and this license." .Ve -.SH "MAILING-LIST" -.IX Header "MAILING-LIST" -The public mailing-list may be the best way to get free support. .PP -To write on the mailing-list, the address is: - -.PP -To subscribe, send any message (even empty) to: - -then just reply to the confirmation message. -.PP -To unsubscribe, send a message to: - -.PP -To contact the person in charge for the list: - -.PP -The list archives are 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. -.PP -Thank you for your participation. +https://imapsync.lamiral.info/LICENSE .SH "AUTHOR" .IX Header "AUTHOR" Gilles \s-1LAMIRAL\s0 @@ -657,80 +628,22 @@ Feedback good or bad is very often welcome. .PP Gilles \s-1LAMIRAL\s0 earns his living by writing, installing, configuring and teaching free, open and often gratis -softwares. It used to be \*(L"always gratis\*(R" but now it is -\&\*(L"often\*(R" because imapsync is sold by its author, a good -way to stay maintening and supporting free open public -softwares (see the license) over decades. +software. Imapsync used to be \*(L"always gratis\*(R" but now it is +only \*(L"often gratis\*(R" because imapsync is sold by its author, +a good way to maintain and support free open public +software over decades. .SH "BUGS AND LIMITATIONS" .IX Header "BUGS AND LIMITATIONS" -Help me to help you: follow the following guidelines. -.PP -Report any bugs or feature requests to the public mailing-list -or to the author. -.PP -Before reporting bugs, read the FAQs, the \s-1README\s0 and the -\&\s-1TODO\s0 files. http://imapsync.lamiral.info/ -.PP -Upgrade to last imapsync release, maybe the bug -is already fixed. -.PP -Upgrade to last Mail-IMAPClient Perl module. -http://search.cpan.org/dist/Mail\-IMAPClient/ -maybe the bug is already fixed there. -.PP -Make a good title with word \*(L"imapsync\*(R" in it (my spam filters won't filter it), -Try to write an email title with more words than just \*(L"imapsync\*(R" or \*(L"problem\*(R", -a good title is made of keywords summary, but not too long (one visible line). -.PP -Help us to help you: in your report, please include: -.PP -.Vb 1 -\& \- imapsync version. -\& -\& \- output near the first failures, a few lines before is good to get the context -\& of the issue. First failures messages are often more significant than -\& the last ones. -\& -\& \- if the issue is always related to the same messages, include the output -\& with \-\-debug \-\-debugimap, near the failure point. For example, -\& Isolate a buggy message or two in a folder \*(AqBUG\*(Aq and use -\& -\& imapsync ... \-\-folder \*(AqBUG\*(Aq \-\-debug \-\-debugimap -\& -\& \- imap server softwares on both sides and their version number. -\& -\& \- imapsync with all the options you use, the full command line -\& you use (except the passwords of course). -\& -\& \- IMAPClient.pm version. -\& -\& \- the run context. Do you run imapsync.exe, a unix binary -\& or the perl script imapsync. -\& -\& \- operating system running imapsync. -\& -\& \- virtual software context (vmware, xen etc.) -\& -\& \- operating systems on both sides and the third side in case -\& you run imapsync on a foreign host from the both. -.Ve -.PP -Most of those values can be found as a copy/paste at the begining of the output, -so a carbon copy of the output is a very easy and very good debug report for me. -.PP -One time in your life, read the paper -\&\*(L"How To Ask Questions The Smart Way\*(R" -http://www.catb.org/~esr/faqs/smart\-questions.html -and then forget it. -.SH "IMAP SERVERS" -.IX Header "IMAP SERVERS" -See http://imapsync.lamiral.info/S/imapservers.shtml +See https://imapsync.lamiral.info/FAQ.d/FAQ.Reporting_Bugs.txt +.SH "IMAP SERVERS supported" +.IX Header "IMAP SERVERS supported" +See https://imapsync.lamiral.info/S/imapservers.shtml .SH "HUGE MIGRATION" .IX Header "HUGE MIGRATION" Pay special attention to options \&\-\-subscribed \&\-\-subscribe -\&\-\-delete +\&\-\-delete1 \&\-\-delete2 \&\-\-delete2folders \&\-\-maxage @@ -771,17 +684,43 @@ On Windows the batch program can be: .Ve .PP The ... have to be replaced by nothing or any imapsync option. -Welcome in shell programming ! +Welcome in shell or batch programming ! .PP You will find already written scripts at http://imapsync.lamiral.info/examples/ +.SH "INSTALL" +.IX Header "INSTALL" +.Vb 5 +\& Imapsync works under any Unix with perl. +\& Imapsync works under Windows (2000, XP, Vista, Seven) +\& as a standalone binary software called imapsync.exe +\& Imapsync works under OS X as a standalone binary +\& software called imapsync_bin_Darwin. +\& +\& Purchase latest imapsync at +\& http://imapsync.lamiral.info/ +\& +\& You\*(Aqll receive a link to a compressed tarball called imapsync\-x.xx.tgz +\& where x.xx is the version number. Untar the tarball where +\& you want (on Unix): +\& +\& tar xzvf imapsync\-x.xx.tgz +\& +\& Go into the directory imapsync\-x.xx and read the INSTALL file. +\& As mentioned at http://imapsync.lamiral.info/#install +\& the INSTALL file can also be found at +\& http://imapsync.lamiral.info/INSTALL +\& It is now split in several files for each system +\& http://imapsync.lamiral.info/INSTALL.d/ +.Ve +.SH "CONFIGURATION" +.IX Header "CONFIGURATION" +There is no specific configuration file for imapsync, +everything is specified by the command line parameters +and the default behavior. .SH "HACKING" .IX Header "HACKING" Feel free to hack imapsync as the \s-1NOLIMIT\s0 license permits it. -.SH "LINKS" -.IX Header "LINKS" -Entries for imapsync: -https://web.archive.org/web/20070202005121/http://www.imap.org/products/showall.php .SH "SIMILAR SOFTWARES" .IX Header "SIMILAR SOFTWARES" .Vb 10 @@ -803,5 +742,14 @@ https://web.archive.org/web/20070202005121/http://www.imap.org/products/showall. .Ve .PP Feedback (good or bad) will often be welcome. -.PP -\&\f(CW$Id:\fR imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ +.SH "HISTORY" +.IX Header "HISTORY" +I wrote imapsync because an enterprise (basystemes) paid me to install +a new imap server without losing huge old mailboxes located in 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 then delete it after a good +transfer. Imapsync started its life as a patch of the copy_folder.pl +script. The script copy_folder.pl comes from the Mail\-IMAPClient\-2.1.3 perl +module tarball source (more precisely in the examples/ directory of the +Mail-IMAPClient tarball). diff --git a/W/install_module_one.bat b/W/install_module_one.bat index 1ba4898..0080ae0 100644 --- a/W/install_module_one.bat +++ b/W/install_module_one.bat @@ -1,5 +1,5 @@ -@REM $Id: install_module_one.bat,v 1.4 2016/07/20 21:44:40 gilles Exp gilles $ +@REM $Id: install_module_one.bat,v 1.5 2017/07/08 00:11:49 gilles Exp gilles $ @ECHO OFF SET SHELL= @@ -13,13 +13,14 @@ IF ERRORLEVEL 1 ECHO Perl needed. Install Strawberry Perl. Get it at http://stra && EXIT /B @ECHO perl is here - +PAUSE +EXIT FOR %%M in ( - IO::Socket::SSL Net::SSLeay PAR::Packer^ + IO::Socket::SSL Net::SSLeay PAR::Packer ^ ) DO perl -m%%M -e "print qq{Updating %%M $%%M::VERSION \n}" ^ & cpanm --force %%M -REM IO::Socket::SSL +REM IO::Socket::SSL Net::SSLeay PAR::Packer @ECHO Perl modules for imapsync installed PAUSE diff --git a/W/install_modules.bat b/W/install_modules.bat index aa8af3f..85a280d 100644 --- a/W/install_modules.bat +++ b/W/install_modules.bat @@ -1,4 +1,4 @@ -REM $Id: install_modules.bat,v 1.27 2016/08/17 02:03:46 gilles Exp gilles $ +REM $Id: install_modules.bat,v 1.32 2017/08/31 01:57:50 gilles Exp gilles $ ::------------------------------------------------------ ::--------------- Main of install_modules.bat ---------- @@ -39,9 +39,9 @@ EXIT /B :update_modules @SETLOCAL FOR %%M in ( ^ + Sys::MemInfo ^ Test::MockObject ^ Readonly ^ - Filesys::DfPortable ^ Authen::NTLM ^ Crypt::SSLeay ^ Data::Uniqid ^ @@ -60,6 +60,7 @@ FOR %%M in ( ^ Net::SSL ^ Net::SSLeay ^ PAR::Packer ^ + Pod::Usage ^ Test::Pod ^ Unicode::String ^ URI::Escape ^ @@ -76,6 +77,8 @@ ECHO Perl modules for imapsync updated REM PAUSE @ENDLOCAL EXIT /B + + ::------------------------------------------------------ diff --git a/W/learn/digest b/W/learn/digest new file mode 100755 index 0000000..75ab593 --- /dev/null +++ b/W/learn/digest @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use strict ; +use warnings ; + + + + +require Digest ; + +my $digest ; +eval { $digest = Digest->new( 'Whirlpool' ) ; } ; +$digest->add( '' ) ; +print $digest->hexdigest( ) . "\n" ; diff --git a/W/learn/oauth2 b/W/learn/oauth2 new file mode 100755 index 0000000..e8bade9 --- /dev/null +++ b/W/learn/oauth2 @@ -0,0 +1,81 @@ +#!/usr/bin/perl + +use HTTP::Request::Common qw(POST); +use LWP::UserAgent; +use Data::Dumper; +use Mail::IMAPClient; +use URI::Escape; +use MIME::Base64; + +print "\n\nType your email address here: "; +$username = "gilles.lamiral@gmail.com" ; +chomp($username); + +print "\n\nPaste the client_id here: "; +$client_id = '108687549524-86sjq07f3ch8otl9fnr56mjnniltdrvn.apps.googleusercontent.com' ; +chomp($client_id); + +print "\n\nPaste the client_secret here: "; +$client_secret = 'zAJO4PLxzeJ4yOaiJRk6f69k' ; +chomp($client_secret); + +$scope_string = "https%3A%2F%2Fmail.google.com%2F"; + +print "Please open the following in your web browser:\n\nhttps://accounts.google.com/o/oauth2/auth?scope=$scope_string&redirect_uri=urn:ietf:wg:oauth:2.0:oob&response_type=code&client_id=$client_id"; + +print "\n\nPaste the code here: "; +$code = '4/-e6wojtOSXCjZnwZKKhvg3AdDqDjGLOF0nXxfAFcdmk'; +# +chomp($code); + +$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0; +my $ua = LWP::UserAgent->new; +$ua->timeout(10); +$ua->env_proxy; + +print "Exchanging the code for an access token and refresh token...\n"; +my $exchange_response = $ua->request(POST 'https://accounts.google.com/o/oauth2/token', +'Content_Type' => 'application/x-www-form-urlencoded', +'Content' => [ +'code' => $code, +'client_id' => $client_id, +'client_secret' => $client_secret, +'redirect_uri' => 'urn:ietf:wg:oauth:2.0:oob', +'grant_type' => 'authorization_code', +], +); + +my ($access_token) = ($exchange_response->decoded_content =~ m/access_token"."(.)"/); +my ($refresh_token) = ($exchange_response->decoded_content =~ m/refresh_token"."(.)"/); + + +print "exchange_response: ", $exchange_response->decoded_content, "\n" ; + +print "access token: $access_token\n"; +print "refresh token: $refresh_token\n"; + +print "Refreshing the access token...\n"; +my $auth_response = $ua->request(POST 'https://accounts.google.com/o/oauth2/token', +'Host' => 'accounts.google.com', +'Content_Type' => 'application/x-www-form-urlencoded', +'Content' => [ +'client_id' => $client_id, +'client_secret' => $client_secret, +'refresh_token' => $refresh_token, +'grant_type' => 'refresh_token', +], +); + +my ($access_token) = ($auth_response->decoded_content =~ m/access_token"."(.)"/); + +my $oauth_sign = encode_base64("user=". $username ."\x01auth=Bearer ". $access_token ."\x01\x01", ''); + +my $imap = Mail::IMAPClient->new( +Server => 'imap.gmail.com', +Port => 993, +Ssl => 1, +Uid => 1, +) or die("Can't connect to imap server."); +$imap->authenticate('XOAUTH2', sub { return $oauth_sign }) or die("Auth error: ". $imap->LastError); + +print join(", ",$imap->folders),".\n" or die("List folders error: ". $imap->LastError); diff --git a/W/learn/resolvme b/W/learn/resolvme new file mode 100755 index 0000000..aeb3d2f --- /dev/null +++ b/W/learn/resolvme @@ -0,0 +1,53 @@ +#!/usr/bin/perl + + +use strict ; +use warnings ; +use English ; + +use Socket qw( SOCK_STREAM AI_CANONNAME NI_NUMERICHOST NIx_NOSERV getaddrinfo getnameinfo ); +#use Socket::GetAddrInfo qw( getaddrinfo getnameinfo ); +use IO::Socket; + + +check_name_and_service( @ARGV ) ; + +sub check_name_and_service { + +my ( $name, $service ) = @ARG ; + +my %hints = ( socktype => SOCK_STREAM, flags => AI_CANONNAME ); +my ( $err, @res ) = getaddrinfo( $name, $service, \%hints ); + +print "Cannot resolve name - $err\n" if $err; + +my $sock; + +foreach my $ai ( @res ) { + my $candidate = IO::Socket->new(); + $candidate->timeout( 2 ) ; + + print "family: ", $ai->{family}, + "\nsocktype: ", $ai->{socktype}, + "\nprotocol: ", $ai->{protocol}, + "\ncanonname: ", $ai->{canonname}, + "\ntimeout: ", $candidate->timeout, + "\n" ; + $candidate->socket( $ai->{family}, $ai->{socktype}, $ai->{protocol} ) + or next ; + + $candidate->connect( $ai->{addr} ) or next ; + + $sock = $candidate; + + if( $sock ) { + my ( $err, $host, $service ) = getnameinfo( $sock->peername ); + print "Connected to $host:$service\n" if !$err; + my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV); + print "ipaddr: $ipaddr\n"; + $sock->close ; + #last ; + } +} + +} diff --git a/W/memo b/W/memo index 2c9ddbb..bbdea3c 100644 --- a/W/memo +++ b/W/memo @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: memo,v 1.63 2015/12/18 20:53:37 gilles Exp gilles $ +# $Id: memo,v 1.66 2017/04/12 20:57:37 gilles Exp gilles $ count_nice() { @@ -281,7 +281,7 @@ verify_month_year() { cd $HOME/imapsync_stats fmy="stats_imapsync_${year}_${month}.ip" test -f "$fmy" || { echo "No $fmy" ; statistics_VERSION_monthly_ip ${month} ${year} ; } - test -f "$fmy" || { echo "No $fmy" ; return 1 ; } + test -f "$fmy" || { echo "No $fmy" ; return 0 ; } fmy_YYYYmm=`date -r "$fmy" +%Y%m` diff_month=`expr $fmy_YYYYmm - ${year}${month}` || : echo -n $diff_month @@ -337,9 +337,10 @@ statistics_VERSION_yearly_os() { FreeBSD=`grep -i freebsd stats_imapsync_${year}.ip | wc -l` Solaris=`grep -i solaris stats_imapsync_${year}.ip | wc -l` OpenBSD=`grep -i openbsd stats_imapsync_${year}.ip | wc -l` - Other=`egrep -i -v 'linux|MSWin32|darwin|freebsd|solaris|openbsd' stats_imapsync_${year}.ip |wc -l` - Nb_All=`cat stats_imapsync_${year}.ip | wc -l` - for OS in Linux Win32 Darwin FreeBSD Solaris OpenBSD Other; do + Unknown=`grep -i '"-"' stats_imapsync_${year}.ip | wc -l` + Other=`egrep -i -v 'linux|MSWin32|darwin|freebsd|solaris|openbsd|"-"' stats_imapsync_${year}.ip |wc -l` + Nb_All=`cat stats_imapsync_${year}.ip | wc -l` + for OS in Linux Win32 Darwin FreeBSD Solaris OpenBSD Unknown Other; do #echo $OS `eval "echo \\$$OS"` / $Nb_All Nb_OS=`eval "echo \\$$OS"` PerCent=`echo "scale=2; 100*$Nb_OS/$Nb_All" | bc -l` @@ -416,7 +417,7 @@ wget http://download.maxmind.com/download/geoip/database/asnum/GeoIPASNum.dat.gz gunzip GeoIP.dat.gz gunzip GeoIPASNum.dat.gz gunzip GeoLiteCity.dat.gz -sudo cp GeoIP.dat GeoIPASNum.dat GeoLiteCity.dat /usr/share/GeoIP/ +sudo mv GeoIP.dat GeoIPASNum.dat GeoLiteCity.dat /usr/share/GeoIP/ EOF } @@ -469,6 +470,13 @@ statistics_releases_monthly() { ) } +statistics_releases_previous_month() { + month=${1:-`date '+%m' -d 'last month'`} + year=${2:-`date '+%Y' -d 'last month'`} + statistics_releases_monthly $month $year +} + + statistics_releases_yearly() { year=${1:-`date '+%Y'`} ( @@ -574,11 +582,15 @@ statistics_VERSION_synthesis() { echo && echo "==== % Operating systems in ${year} " statistics_VERSION_yearly_os $year echo && echo "==== Perl releases in ${year} " - statistics_perl_yearly $year | tail -9 + statistics_perl_yearly $year | tail -15 echo && echo "==== Biggest users in ${year} " - tail -n 9 stats_imapsync_${year}.ip + tail -n 15 stats_imapsync_${year}.ip echo && echo "==== Most releases used in ${year} " - statistics_releases_yearly ${year} | tail -9 + statistics_releases_yearly ${year} | tail -15 + echo && echo "==== Most releases used the previous month " + statistics_releases_previous_month | tail -10 + echo && echo "==== Most releases used this month " + statistics_releases_monthly | tail -10 echo && echo "==== Nb users each year " wc -l stats_imapsync_????.ip echo && echo "==== Nb runs each year : " @@ -593,8 +605,6 @@ statistics_VERSION_synthesis() { ) } - - } test X"`hostname`" = Xks2 && statistics_VERSION_ks @@ -632,54 +642,5 @@ niouzes_compil #' nedit sucks with syntax color -fm_init() { -software_version -NEWS_FILE_FM="./freshmeat_submition" -NEWS_FILE_FM_INP=${NEWS_FILE_FM}.inp -NEWS_FILE_FM_OUT=${NEWS_FILE_FM}.json -} - -fm_read_param() { -# read definitions -. $NEWS_FILE_FM_INP -} - - -fm_read_announce() { - - fm_init - fm_read_param - - cat << EOF -{ - "release": { - "tag_list": "stable, $RELEASE_FOCUS", - "version": "$VERSION", - "hidden_from_frontpage": false, - "changelog": "$TEXT_BODY" - } -} - -EOF -} - -fm_announce() { - fm_init - - if ! newer VERSION $NEWS_FILE_FM_OUT; then - echo "$VERSION already submitted on freshmeat" - else - if newer VERSION $NEWS_FILE_FM_INP; then - echo "Update $NEWS_FILE_FM_INP please" - return 1 - fi - - fm_read_announce > $NEWS_FILE_FM_OUT - curl -X PUT -d @../../var/pass/secret.freshmeat -d @$NEWS_FILE_FM_OUT \ - -H "Content-Type: application/json" \ - http://freshmeat.net/projects/imapsync.json - - fi -} diff --git a/W/ml_announce.in b/W/ml_announce.in index a8c652e..c963710 100644 --- a/W/ml_announce.in +++ b/W/ml_announce.in @@ -1,7 +1,6 @@ -m4_dnl $Id: ml_announce.in,v 1.16 2016/08/18 09:38:48 gilles Exp gilles $ +m4_dnl $Id: ml_announce.in,v 1.18 2017/09/07 00:42:57 gilles Exp gilles $ m4_dnl m4_define(`M4_imapsync_VERSION',m4_esyscmd(cat VERSION|tr -d '\n'))m4_dnl -m4_define(`M4_SECRET_PATH',m4_esyscmd(cat dist/path_last.txt|tr -d '\n'))m4_dnl m4_dnl From: Gilles LAMIRAL Bcc: gilles@lamiral.info @@ -11,29 +10,29 @@ To: imapsync_update@lists.lamiral.info Dear imapsync user, You're subscribed to the newsletter announcing imapsync new releases -(very few traffic) and the way to get them. Send me a note if you -don't want to receive those announces anymore. +(very few traffic) and the way to get them. +Send me a note if you don't want to receive those announces anymore. -You will find the latest imapsync.exe binary (release M4_imapsync_VERSION), -the latest imapsync source code (release M4_imapsync_VERSION), -OS X and Linux (i386) binaries at the following link: +You will find - https://imapsync.lamiral.info/dist/M4_SECRET_PATH + * imapsync.exe binary (release M4_imapsync_VERSION) + * Mac OS X binary + * imapsync perl source code (release M4_imapsync_VERSION) -or also more permanently from this page +at the following link: - https://imapsync.lamiral.info/paypal_return.shtml + https://imapsync.lamiral.info/dist/ Three important files are there: -* imapsync is directly the perl script (also found in the tarball and zip) for a fast upgrade. -* imapsync-M4_imapsync_VERSION.tgz is the tarball containing everything of the project (maybe too much) -* imapsync.M4_imapsync_VERSION.zip is the win32 zip archive including standalone binary imapsync.exe. +* imapsync is the perl script for a fast upgrade (also found in the tarball and zip). +* imapsync-M4_imapsync_VERSION.tgz is the tarball containing the most part of the project (maybe too much) +* imapsync.M4_imapsync_VERSION.zip is the win32 zip archive including standalone binary imapsync.exe What's new in this M4_imapsync_VERSION release can be found at https://imapsync.lamiral.info/S/news.shtml Vote for better imapsync and services at -http://imapsync.lamiral.info/poll.shtml +http://imapsync.lamiral.info/S/poll.shtml I thank you again for buying and using imapsync, I wish you successful imap transfers! diff --git a/W/paypal_reply/MapUTF8_bug b/W/paypal_reply/MapUTF8_bug new file mode 100755 index 0000000..cf2433e --- /dev/null +++ b/W/paypal_reply/MapUTF8_bug @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +# $Id: 8859_utf8,v 1.1 2010/10/01 13:00:09 gilles Exp gilles $ + +use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); +use strict ; +use warnings ; + +die unless (utf8_supported_charset('ISO-8859-1')); + +local $/ ; + +my $string = <> ; + +# print $string ; + +my $string_utf8 = to_utf8({ -string => $string, -charset => 'ISO-8859-1' }) ; + +print $string_utf8 ; + +#foreach my $string ( "A", "\xE9", "\xE9\x1A" ) { +# print to_utf8({ -string => $string, -charset => 'ISO-8859-1' }), "\n"; +#} + + diff --git a/W/paypal_reply/MapUTF8_bug2 b/W/paypal_reply/MapUTF8_bug2 new file mode 100755 index 0000000..f18f162 --- /dev/null +++ b/W/paypal_reply/MapUTF8_bug2 @@ -0,0 +1,26 @@ +#!/usr/bin/perl -w + +# $Id: 8859_utf8,v 1.1 2010/10/01 13:00:09 gilles Exp gilles $ + +use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); +use strict ; +use warnings ; + +die unless (utf8_supported_charset('ISO-8859-1')); + +#local $/ ; + +my @string = <> ; + +my $string = join( q{}, @string ) ; +# print $string ; + +my $string_utf8 = to_utf8({ -string => $string, -charset => 'ISO-8859-1' }) ; + +print $string_utf8 ; + +#foreach my $string ( "A", "\xE9", "\xE9\x1A" ) { +# print to_utf8({ -string => $string, -charset => 'ISO-8859-1' }), "\n"; +#} + + diff --git a/W/paypal_reply/imapsync_sold_by_country.txt b/W/paypal_reply/imapsync_sold_by_country.txt index 2541445..6e8f571 100644 --- a/W/paypal_reply/imapsync_sold_by_country.txt +++ b/W/paypal_reply/imapsync_sold_by_country.txt @@ -1,86 +1,92 @@ -1225 Etats-Unis______________ 24.84 % 25 % 1 -918 Allemagne_______________ 18.62 % 43 % 2 -454 Royaume-Uni_____________ 9.21 % 53 % 3 -253 Italie__________________ 5.13 % 58 % 4 -243 France__________________ 4.93 % 63 % 5 -219 Canada__________________ 4.44 % 67 % 6 -199 Suisse__________________ 4.04 % 71 % 7 -183 Pays-Bas________________ 3.71 % 75 % 8 -172 Australie_______________ 3.49 % 78 % 9 -98 Autriche________________ 1.99 % 80 % 10 -91 Espagne_________________ 1.85 % 82 % 11 -88 Belgique________________ 1.78 % 84 % 12 -71 Suede___________________ 1.44 % 85 % 13 -58 Danemark________________ 1.18 % 87 % 14 -51 Bresil__________________ 1.03 % 88 % 15 -43 Norvege_________________ 0.87 % 89 % 16 -36 Pologne_________________ 0.73 % 89 % 17 -33 Finlande________________ 0.67 % 90 % 18 -28 Republique_tcheque______ 0.57 % 91 % 19 -26 Russie__________________ 0.53 % 91 % 20 -26 Japon___________________ 0.53 % 92 % 21 -25 ________________________ 0.51 % 92 % 22 -23 Nouvelle-Zelande________ 0.47 % 93 % 23 -23 Irlande_________________ 0.47 % 93 % 24 -23 Hongrie_________________ 0.47 % 93 % 25 -19 Portugal________________ 0.39 % 94 % 26 -18 Hong-Kong_______________ 0.37 % 94 % 27 -18 Grece___________________ 0.37 % 95 % 28 -18 Afrique_du_Sud__________ 0.37 % 95 % 29 -14 Slovaquie_______________ 0.28 % 95 % 30 -14 Malaisie________________ 0.28 % 96 % 31 -13 Luxembourg______________ 0.26 % 96 % 32 -13 Inde____________________ 0.26 % 96 % 33 -12 Singapour_______________ 0.24 % 96 % 34 -12 Mexique_________________ 0.24 % 97 % 35 -12 Argentine_______________ 0.24 % 97 % 36 -11 Israel__________________ 0.22 % 97 % 37 -11 Chine___________________ 0.22 % 97 % 38 -11 Chili___________________ 0.22 % 97 % 39 -10 Roumanie________________ 0.20 % 98 % 40 -9 Slovenie________________ 0.18 % 98 % 41 -9 Lettonie________________ 0.18 % 98 % 42 -9 Emirats_Arabes_Unis_____ 0.18 % 98 % 43 -7 Croatie_________________ 0.14 % 98 % 44 -6 Thailande_______________ 0.12 % 98 % 45 -5 Malte___________________ 0.10 % 99 % 46 -5 Islande_________________ 0.10 % 99 % 47 -4 Turquie_________________ 0.08 % 99 % 48 -4 Indonesie_______________ 0.08 % 99 % 49 -4 Estonie_________________ 0.08 % 99 % 50 -4 Egypte__________________ 0.08 % 99 % 51 -4 Bulgarie________________ 0.08 % 99 % 52 -3 Venezuela_______________ 0.06 % 99 % 53 -3 Serbie__________________ 0.06 % 99 % 54 -3 Philippines_____________ 0.06 % 99 % 55 -2 Vietnam_________________ 0.04 % 99 % 56 -2 Uruguay_________________ 0.04 % 99 % 57 -2 Perou___________________ 0.04 % 99 % 58 -2 Lituanie________________ 0.04 % 99 % 59 -2 Costa_Rica______________ 0.04 % 99 % 60 -2 Chypre__________________ 0.04 % 99 % 61 -2 Antilles_neerlandaises__ 0.04 % 100 % 62 -1 Ukraine_________________ 0.02 % 100 % 63 -1 Trinite-et-Tobago_______ 0.02 % 100 % 64 -1 Tanzanie________________ 0.02 % 100 % 65 -1 Taiwan__________________ 0.02 % 100 % 66 -1 Senegal_________________ 0.02 % 100 % 67 -1 Saint_Christophe-Nevis-Anguilla__ 0.02 % 100 % 68 -1 Qatar___________________ 0.02 % 100 % 69 -1 Panama__________________ 0.02 % 100 % 70 -1 Nouvelle-Caledonie______ 0.02 % 100 % 71 -1 Nigeria_________________ 0.02 % 100 % 72 -1 Namibie_________________ 0.02 % 100 % 73 -1 Mongolie________________ 0.02 % 100 % 74 -1 Moldavie________________ 0.02 % 100 % 75 -1 Maldives________________ 0.02 % 100 % 76 -1 Koweit__________________ 0.02 % 100 % 77 -1 Jordanie________________ 0.02 % 100 % 78 -1 Iles_Vierges_britanniques__ 0.02 % 100 % 79 -1 Grenade_________________ 0.02 % 100 % 80 -1 Coree_du_Sud____________ 0.02 % 100 % 81 -1 Colombie________________ 0.02 % 100 % 82 -1 Cameroun________________ 0.02 % 100 % 83 -1 Burkina_Faso____________ 0.02 % 100 % 84 -1 Bahrein_________________ 0.02 % 100 % 85 -TOTAL = 4931 sales 219147 EUR over 85 countries on Tue Aug 16 19:44:43 CEST 2016 +1370 Etats-Unis______________ 23.66 % 24 % 1 +1108 Allemagne_______________ 19.14 % 43 % 2 +521 Royaume-Uni_____________ 9.00 % 52 % 3 +341 Italie__________________ 5.89 % 58 % 4 +282 France__________________ 4.87 % 63 % 5 +241 Canada__________________ 4.16 % 67 % 6 +232 Pays-Bas________________ 4.01 % 71 % 7 +231 Suisse__________________ 3.99 % 75 % 8 +195 Australie_______________ 3.37 % 78 % 9 +127 Autriche________________ 2.19 % 80 % 10 +119 Espagne_________________ 2.06 % 82 % 11 +96 Belgique________________ 1.66 % 84 % 12 +87 Suede___________________ 1.50 % 85 % 13 +77 Danemark________________ 1.33 % 87 % 14 +55 Bresil__________________ 0.95 % 88 % 15 +47 Pologne_________________ 0.81 % 89 % 16 +45 Norvege_________________ 0.78 % 89 % 17 +37 Republique_tcheque______ 0.64 % 90 % 18 +37 Finlande________________ 0.64 % 91 % 19 +31 Russie__________________ 0.54 % 91 % 20 +28 Nouvelle-Zelande________ 0.48 % 92 % 21 +28 Hongrie_________________ 0.48 % 92 % 22 +27 Japon___________________ 0.47 % 93 % 23 +25 ________________________ 0.43 % 93 % 24 +23 Irlande_________________ 0.40 % 93 % 25 +22 Grece___________________ 0.38 % 94 % 26 +21 Portugal________________ 0.36 % 94 % 27 +20 Afrique_du_Sud__________ 0.35 % 95 % 28 +19 Hong-Kong_______________ 0.33 % 95 % 29 +17 Slovaquie_______________ 0.29 % 95 % 30 +17 Inde____________________ 0.29 % 95 % 31 +16 Mexique_________________ 0.28 % 96 % 32 +16 Argentine_______________ 0.28 % 96 % 33 +15 Malaisie________________ 0.26 % 96 % 34 +15 Chili___________________ 0.26 % 97 % 35 +14 Singapour_______________ 0.24 % 97 % 36 +14 Luxembourg______________ 0.24 % 97 % 37 +14 Chine___________________ 0.24 % 97 % 38 +13 Roumanie________________ 0.22 % 97 % 39 +12 Slovenie________________ 0.21 % 98 % 40 +11 Israel__________________ 0.19 % 98 % 41 +10 Emirats_Arabes_Unis_____ 0.17 % 98 % 42 +9 Lettonie________________ 0.16 % 98 % 43 +7 Croatie_________________ 0.12 % 98 % 44 +6 Thailande_______________ 0.10 % 98 % 45 +6 Islande_________________ 0.10 % 99 % 46 +5 Malte___________________ 0.09 % 99 % 47 +5 Estonie_________________ 0.09 % 99 % 48 +5 Egypte__________________ 0.09 % 99 % 49 +4 Turquie_________________ 0.07 % 99 % 50 +4 Indonesie_______________ 0.07 % 99 % 51 +4 Chypre__________________ 0.07 % 99 % 52 +4 Bulgarie________________ 0.07 % 99 % 53 +3 Venezuela_______________ 0.05 % 99 % 54 +3 Serbie__________________ 0.05 % 99 % 55 +3 Philippines_____________ 0.05 % 99 % 56 +3 Lituanie________________ 0.05 % 99 % 57 +3 Ireland_________________ 0.05 % 99 % 58 +2 Vietnam_________________ 0.03 % 99 % 59 +2 Uruguay_________________ 0.03 % 99 % 60 +2 Ukraine_________________ 0.03 % 99 % 61 +2 Perou___________________ 0.03 % 99 % 62 +2 Nouvelle-Caledonie______ 0.03 % 99 % 63 +2 Costa_Rica______________ 0.03 % 100 % 64 +2 Antilles_neerlandaises__ 0.03 % 100 % 65 +1 Trinite-et-Tobago_______ 0.02 % 100 % 66 +1 Tanzanie________________ 0.02 % 100 % 67 +1 Taiwan__________________ 0.02 % 100 % 68 +1 Senegal_________________ 0.02 % 100 % 69 +1 Saint_Christophe-Nevis-Anguilla__ 0.02 % 100 % 70 +1 Qatar___________________ 0.02 % 100 % 71 +1 Panama__________________ 0.02 % 100 % 72 +1 Nigeria_________________ 0.02 % 100 % 73 +1 Namibie_________________ 0.02 % 100 % 74 +1 Mongolie________________ 0.02 % 100 % 75 +1 Monaco__________________ 0.02 % 100 % 76 +1 Moldavie________________ 0.02 % 100 % 77 +1 Maldives________________ 0.02 % 100 % 78 +1 Koweit__________________ 0.02 % 100 % 79 +1 Jordanie________________ 0.02 % 100 % 80 +1 Jamaique________________ 0.02 % 100 % 81 +1 Iles_Vierges_britanniques__ 0.02 % 100 % 82 +1 Grenade_________________ 0.02 % 100 % 83 +1 Coree_du_Sud____________ 0.02 % 100 % 84 +1 Colombie________________ 0.02 % 100 % 85 +1 Cameroun________________ 0.02 % 100 % 86 +1 Burkina_Faso____________ 0.02 % 100 % 87 +1 Bosnie-Herzegovine______ 0.02 % 100 % 88 +1 Bahrein_________________ 0.02 % 100 % 89 +1 Arabie_Saoudite_________ 0.02 % 100 % 90 +1 Albanie_________________ 0.02 % 100 % 91 +TOTAL = 5790 sales 267809 EUR over 91 countries on Thu Aug 31 17:19:20 CEST 2017 diff --git a/W/paypal_reply/memo b/W/paypal_reply/memo old mode 100644 new mode 100755 index f1f440c..2dd4b43 --- a/W/paypal_reply/memo +++ b/W/paypal_reply/memo @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: memo,v 1.19 2016/08/09 10:50:30 gilles Exp gilles $ +# $Id: memo,v 1.27 2017/08/13 18:27:35 gilles Exp gilles $ echo paypal_bilan_todo @@ -23,13 +23,270 @@ Hors Europe : Article 262 => Exoneration Europe a un autre assujetti : Article 262 ter => Exoneration - Article 262 ter-1 sur livraisons de biens expédiés. Question : oeuvre immaterielle, service ? - - EOF } -echo paypal_bilan_changefix_Commission_Frais +echo paypal_bilan_online_summary_bug2 +paypal_bilan_online_summary_bug2() { +# DID output diff between paypal_bilan_1.100 and next one +( +#set -x +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1 +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.100 || return 1 +cd /g/var/paypal_bilan_online_summary_bug2/ || return 1 +echo Working in `pwd` +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.100 \ + --first_in 147 --avoid_numbers '292 293 643 644 731 732 1093 +1330 1331 1332 1333 1334 1652 1653 2131 2132 +2295 2296 2297 2298 2625 2626 2970 2971 2972 +3093 3296 3411 3412 3450 3451 3614 3615 3616 3617 +3807 3808 3957 3958 4030 4194 4195 4381 4382 4449 4450 +4574 4641 5213 5214 5215 5355 5406 +5489 5650' \ + /g/paypal/paypal_201?_??_complet.csv \ + > all.out1 2>&1 || return 1 + + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --first_in 147 --avoid_numbers '292 293 643 644 731 732 1093 +1330 1331 1332 1333 1334 1652 1653 2131 2132 +2295 2296 2297 2298 2625 2626 2970 2971 2972 +3093 3296 3411 3412 3450 3451 3614 3615 3616 3617 +3807 3808 3957 3958 4030 4194 4195 4381 4382 4449 4450 +4574 4641 5213 5214 5215 5355 5406 +5489 5650' \ + /g/paypal/paypal_201?_??_complet.csv \ + > all.out2 2>&1 || return 1 + +echo diff all.out1 all.out2 + diff all.out1 all.out2 +) +} + + + +echo paypal_bilan_online_summary_bug +paypal_bilan_online_summary_bug() { +# DID output diff between paypal_bilan_1.100 and next one +( +#set -x +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1 +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.100 || return 1 +cd /g/var/paypal_bilan_online_summary_bug/ || return 1 +echo Working in `pwd` +test -f 2017_07.csv || { echo no 2017_07.csv; return 1; } +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.100 \ + --debug --debug_csv --debug_email --details --debug_invoice --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_online_summary_bug/ --first_in 52001 \ + 2017_07.csv \ + > 2017_07.out1 2>&1 || return 1 + +rm 52???/imapsync_var_manual.tex + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --debug --debug_csv --debug_email --details --debug_invoice --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_online_summary_bug/ --first_in 52001 \ + 2017_07.csv \ + > 2017_07.out2 2>&1 || return 1 + +echo diff 2017_07.out1 2017_07.out2 + diff 2017_07.out1 2017_07.out2 +) +} + + + +echo paypal_bilan_online +paypal_bilan_online() { +# DID output diff between paypal_bilan_1.96 and next one +( +#set -x +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1 +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.96 || return 1 +cd /g/var/paypal_bilan_online/ || return 1 +echo Working in `pwd` +test -f 2017_06.csv || { echo no 2017_06.csv; return 1; } +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.96 \ + --debug --debug_csv --debug_email --details --debug_invoice --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_online/ --write_invoices --first_in 51001 \ + 2017_06.csv \ + > 2017_06.out1 2>&1 || return 1 + +rm 51???/imapsync_var_manual.tex + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --debug --debug_csv --debug_email --details --debug_invoice --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_online/ --write_invoices --first_in 51001 \ + 2017_06.csv \ + > 2017_06.out2 2>&1 || return 1 + +echo diff 2017_06.out1 2017_06.out2 + diff 2017_06.out1 2017_06.out2 +) +} + + + +#echo paypal_bilan_invoices_utf8_bug +paypal_bilan_invoices_utf8_bug() { +# DID output diff between paypal_bilan_1.93 and next one +( +#set -x +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1 +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.93 || return 1 +cd /g/var/paypal_bilan_invoices_utf8_bug/ || return 1 +echo Working in `pwd` +test -f 2017_02.csv || { echo no 2017_02.csv; return 1; } +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.93 \ + --debug --debug_csv --debug_email --details --debug_invoice --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_invoices_utf8_bug/ --write_invoices --first_in 51001 \ + 2017_02.csv \ + > 2017_02.out1 2>&1 || return 1 + +rm 51???/imapsync_var_manual.tex + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --debug --debug_csv --debug_email --details --debug_invoice --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_invoices_utf8_bug/ --write_invoices --first_in 51001 \ + 2017_02.csv \ + > 2017_02.out2 2>&1 || return 1 + +echo diff 2017_02.out1 2017_02.out2 + diff 2017_02.out1 2017_02.out2 +) +} + + +#echo paypal_bilan_no_US_if_0_dollars +paypal_bilan_no_US_if_0_dollars() { +# DID output diff between paypal_bilan_1.92 and next one +( +#set -x +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1 +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.92 || return 1 +cd /g/var/paypal_bilan_no_US_if_0_dollars/ || return 1 +test -f /g/paypal/paypal_2017_03_complet.csv || { echo no /g/paypal/paypal_2017_03_complet.csv; return 1; } + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.92 --first_in 54001 \ + /g/paypal/paypal_2017_03_complet.csv \ + > 2017_03.out1 2>&1 || return 1 + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 54001 \ + /g/paypal/paypal_2017_03_complet.csv \ + > 2017_03.out2 2>&1 || return 1 + +echo diff 2017_03.out1 2017_03.out2 + diff 2017_03.out1 2017_03.out2 + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.92 --first_in 55001 \ + /g/paypal/paypal_201?_??_complet.csv \ + > all.out1 2>&1 || return 1 + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 55001 \ + /g/paypal/paypal_201?_??_complet.csv \ + > all.out2 2>&1 || return 1 + +echo diff all.out1 all.out2 + diff all.out1 all.out2 + +) + +} + + + +#echo paypal_bilan_client_type_VAT_imply_pro +paypal_bilan_client_type_VAT_imply_pro() { +# DID output diff between paypal_bilan_1.91 and next one +( +#set -x +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1 +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.91 || return 1 +cd /g/var/paypal_bilan_client_type_VAT_imply_pro/ || return 1 +cp /g/paypal/paypal_2017_03_complet.csv 2017_03.csv || return 1 +test -f 2017_03.csv || { echo no 2017_03.csv; return 1; } +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.91 \ + --debug --debug_csv --debug_email --details --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_client_type_VAT_imply_pro/ --first_in 52001 \ + 2017_03.csv \ + > 2017_03.out1 2>&1 || return 1 + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --debug --debug_csv --debug_email --details --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_client_type_VAT_imply_pro/ --first_in 52001 \ + 2017_03.csv \ + > 2017_03.out2 2>&1 || return 1 + +echo diff 2017_03.out1 2017_03.out2 + diff 2017_03.out1 2017_03.out2 + +cp /g/paypal/paypal_201[67]_??_complet.csv . +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.91 \ + --debug --debug_csv --debug_email --details --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_client_type_VAT_imply_pro/ --first_in 53001 \ + paypal_201[67]_??_complet.csv \ + > all.out1 2>&1 || return 1 + +#cp /g/paypal/paypal_201[67]_??_complet.csv . +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --debug --debug_csv --debug_email --details --debug_invoice_utf8 \ + --dir_invoices /g/var/paypal_bilan_client_type_VAT_imply_pro/ --first_in 53001 \ + paypal_201[67]_??_complet.csv \ + > all.out2 2>&1 || return 1 + +echo diff all.out1 all.out2 + diff all.out1 all.out2 + +) + +} + + + +#echo paypal_bilan_individual_or_france_bug +paypal_bilan_individual_or_france_bug() { +# DID output diff between paypal_bilan_1.84 and next +( +#set -x +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1 +perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.84 || return 1 +cd /g/var/paypal_bilan_individual_or_france_bug/ || return 1 +test -f 2016_10.csv || { echo no 2016_10.csv; return 1; } +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.84 \ + --debug --debug_csv --debug_email --details --debug_invoice \ + --dir_invoices /g/var/paypal_invoices_dev --write_invoices --first_in 50001 \ + 2016_10.csv \ + > 2016_10.out1 2>&1 || return 1 + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --debug --debug_csv --debug_email --details --debug_invoice \ + --dir_invoices /g/var/paypal_invoices_dev --write_invoices --first_in 50001 \ + 2016_10.csv \ + > 2016_10.out2 2>&1 || return 1 + +echo diff 2016_10.out1 2016_10.out2 + diff 2016_10.out1 2016_10.out2 + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.84 \ + --first_in 4575 --avoid_numbers '4574 4641 5213 5214 5215' \ + /g/paypal/paypal_2016_??_complet.csv > 2016.out1 2>&1 || return 1 + +/g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --first_in 4575 --avoid_numbers '4574 4641 5213 5214 5215' \ + /g/paypal/paypal_2016_??_complet.csv > 2016.out2 2>&1 || return 1 + + +echo diff 2016.out1 2016.out2 + diff 2016.out1 2016.out2 + +) +} + + + + +#echo paypal_bilan_changefix_Commission_Frais paypal_bilan_changefix_Commission_Frais() { # DID output diff between ( @@ -73,7 +330,7 @@ echo diff 2016_07_old.out3 2016_07_new.out3 -echo paypal_bilan_licence_support_only_csv +#echo paypal_bilan_licence_support_only_csv paypal_bilan_licence_support_only_csv() { # DID output diff between paypal_bilan_1.79 and next ( @@ -100,7 +357,7 @@ echo diff 2015_08.out1 2015_08.out2 -echo paypal_bilan_licence_support_same_button_04_2014_04_csv +#echo paypal_bilan_licence_support_same_button_04_2014_04_csv paypal_bilan_licence_support_same_button_04_2014_04_csv() { # DID output diff between paypal_bilan_1.78 and next ( @@ -126,7 +383,7 @@ echo diff 2014_04.out1 2014_04.out2 -echo paypal_bilan_licence_support_same_button_03_A_B_several_csv +#echo paypal_bilan_licence_support_same_button_03_A_B_several_csv paypal_bilan_licence_support_same_button_03_A_B_several_csv() { # DID output diff between paypal_bilan_1.78 and next ( @@ -152,7 +409,7 @@ echo diff several.out1 several.out2 -echo paypal_bilan_licence_support_same_button_02_A_B_one_line +#echo paypal_bilan_licence_support_same_button_02_A_B_one_line paypal_bilan_licence_support_same_button_02_A_B_one_line() { # DID output diff between paypal_bilan_1.78 and next ( @@ -180,7 +437,7 @@ done } -echo paypal_bilan_licence_support_same_button_01_ALL_before_B_C +#echo paypal_bilan_licence_support_same_button_01_ALL_before_B_C paypal_bilan_licence_support_same_button_01_ALL_before_B_C() { # DID output diff between paypal_bilan_1.77 and next ( @@ -206,7 +463,7 @@ echo diff /g/var/paypal_bilan/tests/paypal_invoice.out1 /g/var/paypal_bilan/test } -echo paypal_bilan_final_presentation_for_tva +#echo paypal_bilan_final_presentation_for_tva paypal_bilan_final_presentation_for_tva() { # DID output diff between paypal_bilan_1.72 and 1.73 ( diff --git a/W/paypal_reply/paypal_bilan b/W/paypal_reply/paypal_bilan index 284c0aa..5df223d 100755 --- a/W/paypal_reply/paypal_bilan +++ b/W/paypal_reply/paypal_bilan @@ -1,6 +1,6 @@ #!/usr/bin/perl -# $Id: paypal_bilan,v 1.83 2016/08/18 09:43:40 gilles Exp gilles $ +# $Id: paypal_bilan,v 1.104 2017/08/17 11:06:03 gilles Exp gilles $ use strict; use warnings; @@ -11,22 +11,31 @@ use Data::Dumper ; use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); use Test::More 'no_plan' ; +#print join( "\n", utf8_supported_charset( ) ) ; die unless (utf8_supported_charset('ISO-8859-1')); -my $rcs = '$Id: paypal_bilan,v 1.83 2016/08/18 09:43:40 gilles Exp gilles $ ' ; + +my $rcs = '$Id: paypal_bilan,v 1.104 2017/08/17 11:06:03 gilles Exp gilles $ ' ; $rcs =~ m/,v (\d+\.\d+)/ ; my $VERSION = ($1) ? $1: "UNKNOWN" ; my $total_usd_received = 0 ; my $total_usd_invoice = 0 ; + my $total_HT_EUR_logi_exo = 0 ; my $total_HT_EUR_logi_ass = 0 ; my $total_TVA_EUR_logi = 0 ; -my $total_HT_EUR_sup = 0 ; -my $total_TVA_EUR_sup = 0 ; my $total_HT_EUR_sup_exo = 0 ; +my $total_HT_EUR_sup_ass = 0 ; +my $total_TVA_EUR_sup = 0 ; + +my $total_HT_EUR_serv_exo = 0 ; +my $total_HT_EUR_serv_ass = 0 ; +my $total_TVA_EUR_serv = 0 ; + + my $total_eur_received = 0 ; my $total_eur_invoice = 0 ; @@ -149,7 +158,7 @@ foreach my $invoice ( @invoices_wanted ) { my $email_address = $action->{ "De l'adresse email" } ; my $invoice_sent = invoice_sent( $dir_invoices, $invoice, $email_address ) ; - #print "$invoice $invoice_sent\n" ; + #print "$invoice $invoice_sent $email_address\n" ; if ( $invoice_sent ) { $invoice_sent{ $invoice }++ ; @@ -173,9 +182,9 @@ print( "\n", "=" x 60, "\n" ) ; my $total_usd_paypal_cost ; $total_usd_paypal_cost = sprintf('%2.2f', $total_usd_invoice - $total_usd_received ) ; -print "USD received $total_usd_received\n" ; -print "USD invoice $total_usd_invoice\n" ; -print "USD costs $total_usd_paypal_cost\n" ; +if ( 0 < $total_usd_received ) { print "USD received $total_usd_received\n" ; } +if ( 0 < $total_usd_invoice ) { print "USD invoice $total_usd_invoice\n" ; } +if ( 0 < $total_usd_paypal_cost ) { print "USD costs $total_usd_paypal_cost\n" ; } my $total_eur_invoice_from_usd ; my $total_eur_received_from_usd ; @@ -189,7 +198,7 @@ $total_eur_paypal_cost_from_usd = sprintf('%2.2f', $total_usd_paypal_cost / $ # EUR $total_eur_received = sprintf('%2.2f', $total_eur_received) ; $total_eur_invoice = sprintf('%2.2f', $total_eur_invoice) ; -print "EUR invoice from USD $total_eur_invoice_from_usd\n" ; +if ( 0 < $total_eur_invoice_from_usd ) { print "EUR invoice from USD $total_eur_invoice_from_usd\n" ; } print "EUR received from EUR $total_eur_received\n" ; print "EUR invoice from EUR $total_eur_invoice\n" ; @@ -202,10 +211,18 @@ $total_HT_EUR_logi_exo = sprintf('%2.2f', $total_HT_EUR_logi_exo) ; $total_HT_EUR_logi_ass = sprintf('%2.2f', $total_HT_EUR_logi_ass) ; $total_TVA_EUR_logi = sprintf('%2.2f', $total_TVA_EUR_logi) ; -$total_HT_EUR_sup = sprintf('%2.2f', $total_HT_EUR_sup) ; +$total_HT_EUR_sup_ass = sprintf('%2.2f', $total_HT_EUR_sup_ass) ; $total_TVA_EUR_sup = sprintf('%2.2f', $total_TVA_EUR_sup) ; $total_HT_EUR_sup_exo = sprintf('%2.2f', $total_HT_EUR_sup_exo) ; +$total_HT_EUR_serv_exo = sprintf('%2.2f', $total_HT_EUR_serv_exo) ; +$total_HT_EUR_serv_ass = sprintf('%2.2f', $total_HT_EUR_serv_ass) ; +$total_TVA_EUR_serv = sprintf('%2.2f', $total_TVA_EUR_serv) ; + + +my $total_HT_EUR_exo = $total_HT_EUR_sup_exo + $total_HT_EUR_logi_exo + $total_HT_EUR_serv_exo ; +$total_HT_EUR_exo = sprintf('%2.2f', $total_HT_EUR_exo) ; + $total_eur_invoice_from_eur_usd = sprintf('%2.2f', $total_eur_invoice_from_eur_usd) ; $total_eur_paypal_cost = sprintf('%2.2f', $total_eur_paypal_cost) ; @@ -215,14 +232,16 @@ print "EUR total received $total_eur_received_from_eur_usd\n" ; print "EUR total paypal cost $total_eur_paypal_cost\n" ; print ; print( "---- Assujeti TVA ----\n" ) ; -print "EUR total HT licen assuj $total_HT_EUR_logi_ass (autres operations imposables)\n" ; -#print "EUR total TVA licen assuj $total_TVA_EUR_logi\n" ; -print "EUR total HT supp assuj $total_HT_EUR_sup (ventes, prestations)\n" ; -#print "EUR total TVA supp assuj $total_TVA_EUR_sup\n" ; +#print "EUR total HT supp assuj $total_HT_EUR_sup_ass (ventes, prestations)\n" ; +print "EUR total HT serv+supp assuj ", $total_HT_EUR_serv_ass + $total_HT_EUR_sup_ass, " (ventes, prestations)\n" ; +print "EUR total HT licences assuj $total_HT_EUR_logi_ass (autres operations imposables)\n" ; + print( "---- Exonere TVA ----\n" ) ; -print "EUR total HT licen exo $total_HT_EUR_logi_exo (autres operations NON imposables)\n" ; -print "EUR total HT suppo exo $total_HT_EUR_sup_exo (autres operations NON imposables)\n" ; +#print "EUR total HT suppo exo $total_HT_EUR_sup_exo (autres operations NON imposables)\n" ; +print "EUR total HT serv+supp exo ", $total_HT_EUR_serv_exo + $total_HT_EUR_sup_exo, " (autres operations NON imposables)\n" ; +print "EUR total HT licences exo $total_HT_EUR_logi_exo (autres operations NON imposables)\n" ; +print "EUR total HT autres operations NON imposables: $total_HT_EUR_serv_exo + $total_HT_EUR_sup_exo + $total_HT_EUR_logi_exo = $total_HT_EUR_exo\n" ; print( "---- Invoices ----\n" ) ; @@ -233,9 +252,12 @@ print "Nb invoice refund ($nb_invoice_refund) @invoice_refund\n" ; print "Nb invoice sent $nb_invoice_sent\n" ; print "Have to send invoices @invoice_not_sent\n" if ( @invoice_not_sent ) ; -my $total_eur2 = $total_HT_EUR_logi_exo + $total_HT_EUR_logi_ass + $total_TVA_EUR_logi + $total_HT_EUR_sup + $total_TVA_EUR_sup + $total_HT_EUR_sup_exo ; +my $total_eur2 = $total_HT_EUR_logi_exo + $total_HT_EUR_logi_ass + $total_TVA_EUR_logi + + $total_HT_EUR_sup_exo + $total_HT_EUR_sup_ass + $total_TVA_EUR_sup + + $total_HT_EUR_serv_exo + $total_HT_EUR_serv_ass + $total_TVA_EUR_serv ; + $total_eur2 = sprintf('%2.2f', $total_eur2) ; -print "$total_eur_invoice_from_eur_usd != $total_eur2 = $total_HT_EUR_logi_exo + $total_HT_EUR_logi_ass + $total_TVA_EUR_logi + $total_HT_EUR_sup + $total_TVA_EUR_sup + $total_HT_EUR_sup_exo\n" +print "$total_eur_invoice_from_eur_usd != $total_eur2 = $total_HT_EUR_logi_exo + $total_HT_EUR_logi_ass + $total_TVA_EUR_logi + $total_HT_EUR_sup_ass + $total_TVA_EUR_sup + $total_HT_EUR_sup_exo\n" if ( $total_eur_invoice_from_eur_usd != $total_eur2 ) ; sub parse_one_line_io { @@ -490,9 +512,15 @@ sub paiement_eur_termine { $total_HT_EUR_logi_exo += $A->{montant_HT_EUR_logi_exo} ; $total_HT_EUR_logi_ass += $A->{montant_HT_EUR_logi_ass} ; $total_TVA_EUR_logi += $A->{montant_TVA_EUR_logi} ; - $total_HT_EUR_sup += $A->{montant_HT_EUR_sup} ; - $total_TVA_EUR_sup += $A->{montant_TVA_EUR_sup} ; - $total_HT_EUR_sup_exo += $A->{montant_HT_EUR_sup_exo} ; + + $total_HT_EUR_sup_ass += $A->{montant_HT_EUR_sup} ; + $total_TVA_EUR_sup += $A->{montant_TVA_EUR_sup} ; + $total_HT_EUR_sup_exo += $A->{montant_HT_EUR_sup_exo} ; + + $total_HT_EUR_serv_exo += $A->{montant_HT_EUR_serv_exo} ; + $total_HT_EUR_serv_ass += $A->{montant_HT_EUR_serv_ass} ; + $total_TVA_EUR_serv += $A->{montant_TVA_EUR_serv} ; + $A->{invoice} = next_invoice( ) ; $nb_invoice++ ; @@ -597,11 +625,6 @@ sub compute_line { ( $A->{N_de_transaction} ) = @action{ ( 'N° de transaction' ) } || @action{ ( 'Numéro de transaction' ) } ; #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; - #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; - #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; - #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; - #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; - #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; # $A->{Impact_sur_le_solde} ||= '' ; @@ -631,7 +654,7 @@ sub compute_line { } sub BNC_output { -# FE 1359 FR IND imapsync Bougon Edouard +# FE 1359 FR IND imapsync HisName # [12/01/2012] FR IND 28.73 EUR my( $invoice, $FR_flag, $IND_flag, $SUPPORT_flag, $Nom, $Date, $MontantEUR, $Devise, $Titre_de_l_objet, $Impact_sur_le_solde, $Type ) = @_ ; @@ -718,9 +741,7 @@ sub build_invoice { $F->{Adresse_1} = $action->{'Adresse 1'} || $action->{'Adresse (ligne 1)'} ; #$F->{} = $action->{''} || $action->{''} ; #$F->{} = $action->{''} || $action->{''} ; - #$F->{} = $action->{''} || $action->{''} ; - #$F->{} = $action->{''} || $action->{''} ; - # + #etc $F->{Etat_Province} = $action->{'Etat/Province/Région/Comté/Territoire/Préfecture/République'} || $action->{'État/Province/Région/Comté/Territoire/Préfecture/République'} @@ -743,25 +764,60 @@ sub build_invoice { write_csv_info( $dir_invoices, $F->{invoice}, $F->{file_csv}, $F->{line_number}, $F->{line_csv} ) ; } - + $F->{date_aaaa_mm_jj} = date_aaaa_mm_jj( $F->{Date} ) ; build_address( $F ) ; escape_for_tex( $F ) ; + clientVAT( $F ) ; client_type( $F ) ; object_type( $F ) ; + vat_type( $F ) ; description_stuff( $F ) ; tva_stuff( $F ) ; $F->{quantity} = '1' ; download_urls( $F ) ; ( $F->{Nom1} ) = cut( $F->{Nom}, 42 ) ; - $F->{clientVAT} = '' ; - - if ( ( 'VAT if professional in Europe' eq $F->{Nom_Option_2} ) and $F->{Option_2_Valeur} ) { - $F->{clientVAT} = $F->{Option_2_Valeur} ; - } - + foreach my $key ( keys( %{ $F } ) ) { + #if ( not defined $F->{ $key } ) { print "$key\n" ; } + } + foreach my $key ( qw{ +invoice +Nom1 +De_l_adresse_email +clientAdrA +clientAdrB +clientAdrC +clientAdrD +clientAdrE +clientAdrF +clientVAT +Date +Heure +descriptionFR +descriptionEN +descriptionBFR +descriptionBEN +usageFR +usageEN +quantity +quantityB +priceHT +priceBHT +priceZHT +tvaFR +priceZTVA +HTorTTC +priceZTTC +messageTVAFR +messageTVAEN +urlSrc +} ) { + #if ( not defined $F->{ $key } ) { print "$key $F->{invoice}\n" ; } +} + + my $tex_variables = qq{ -%% Begin input from paypal_bilan $VERSION +%% Begin input from paypal_bilan $VERSION éèàù \\providecommand{\\invoiceNumber}{$F->{invoice}} \\providecommand{\\clientName}{$F->{Nom1}} \\providecommand{\\clientEmail}{$F->{De_l_adresse_email}} @@ -797,14 +853,15 @@ sub build_invoice { %% End input from paypal_bilan } ; - my $tex_variables_utf8 = to_utf8( { -string => $tex_variables, -charset => 'ISO-8859-1' } ) ; - + my $tex_variables_utf8 = Unicode::MapUTF8::to_utf8( { -string => $tex_variables, -charset => 'ISO-8859-1' } ) ;# + $debug_invoice_utf8 and print $tex_variables_utf8 ; $debug_invoice and print $tex_variables ; #print "$F->{invoice} ", invoice_sent( $dir_invoices, $F->{invoice}, $F->{De_l_adresse_email} ), "\n" ; - if ( $write_invoices and ! invoice_sent( $dir_invoices, $F->{invoice}, $F->{De_l_adresse_email} ) ) { - write_tex_variables_file( $dir_invoices, $F->{invoice}, $F->{Date}, $tex_variables_utf8 ) ; + if ( $write_invoices + and ! invoice_sent( $dir_invoices, $F->{invoice}, $F->{De_l_adresse_email} ) ) { + write_tex_variables_file( $dir_invoices, $F->{invoice}, $F->{Date}, $tex_variables_utf8, $tex_variables ) ; } } @@ -823,26 +880,33 @@ sub description_stuff { $F->{descriptionEN} = '(Imapsync software. ALL rights conceded, allowed.)' ; } - if ( 'professional' eq $F->{clientTypeEN} + if ( 'professional' eq $F->{client_type} and 'software' eq $F->{object_type} ) { $F->{usageFR} = 'Usage à titre professionnel.' ; $F->{usageEN} = '(professional usage.)' ; } - if ( 'individual' eq $F->{clientTypeEN} + if ( 'individual' eq $F->{client_type} and 'software' eq $F->{object_type} ) { $F->{usageFR} = 'Usage à titre individuel.' ; $F->{usageEN} = '(individual usage.)' ; } if ( 'support' eq $F->{object_type} ) { - $F->{usageFR} = '' ; - $F->{usageEN} = '' ; + $F->{usageFR} = 'Usage à titre professionnel.' ; + $F->{usageEN} = '(professional usage.)' ; $F->{descriptionFR} = 'Support sur le logiciel imapsync.' ; $F->{descriptionEN} = '(Imapsync support.)' ; } + + if ( 'service' eq $F->{object_type} ) { + $F->{usageFR} = 'Usage à titre professionnel.' ; + $F->{usageEN} = '(professional usage.)' ; + $F->{descriptionFR} = 'Service en ligne avec le logiciel imapsync.' ; + $F->{descriptionEN} = '(Imapsync software online service.)' ; + } - if ( 'professional' eq $F->{clientTypeEN} + if ( 'professional' eq $F->{client_type} and 'software + support' eq $F->{object_type} ) { $F->{usageFR} = 'Usage à titre professionnel.' ; $F->{usageEN} = '(professional usage.)' ; @@ -887,6 +951,21 @@ sub object_type { }elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} ) and ( 'Support only. For professional use.' eq $F->{Valeur_Option_1} ) ) { $F->{object_type} = 'support' ; + }elsif ( ( + 'imapsync any' eq $F->{Titre_de_l_objet} + or 'imapsync online' eq $F->{Titre_de_l_objet} + ) + and ( + ( 'Tiny' eq $F->{Valeur_Option_1} ) + or ( 'Small' eq $F->{Valeur_Option_1} ) + or ( 'Normal' eq $F->{Valeur_Option_1} ) + or ( 'High' eq $F->{Valeur_Option_1} ) + ) ) { + $F->{object_type} = 'service' ; + }elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} ) + and ( '' eq $F->{Valeur_Option_1} ) ) { + # one is like this: 2 oct 2016 00:04:12 CEST 50 EUR + $F->{object_type} = 'software' ; } } @@ -911,19 +990,36 @@ Hello $F->{Nom}, First of all, I'm sorry for the delay in getting back to you. Last imapsync release is available from the page -http://imapsync.lamiral.info/paypal_return.shtml +https://imapsync.lamiral.info/paypal_return.shtml -Help me improving imapsync and its services by voting at -http://imapsync.lamiral.info/#poll +You're also free to use the online imapsync GUI as you wish: +https://imapsync.lamiral.info/X/ You'll find in the attachment the invoice of imapsync -$F->{object_type} you bought and paid (dd/mm/yyyy $F->{Date}). +$F->{object_type} that you bought and you paid (dd/mm/yyyy $F->{Date}). The invoice file is named facture_imapsync-${invoice}.pdf This invoice is in PDF format, ready to be print. -Should you need a hardcopy of this invoice, +Should you need a hard-copy of this invoice, I'll send it to you upon request by regular mail. +Once more, thank you for buying and using imapsync $F->{object_type}. + +Any feedback is welcome! +Best Regards. + +-- +Gilles Lamiral. +add: 22 La Billais 35580 Baulon, France +mob: +33 6 19 22 03 54 +fix: +33 9 51 84 42 42 +} ; + + + my $message_body_blabla = qq{ +Help me improving imapsync and its services via the pole +http://imapsync.lamiral.info/S/poll.shtml + As the law requires, this numeric invoice PDF file is signed with my private gpg key. @@ -938,20 +1034,6 @@ this invoice with the following command line: or any other gpg graphical tool. -Once more, thank you for buying and using imapsync $F->{object_type}. - -Any feedback is welcome! -Best Regards. - --- -Gilles Lamiral. -add: La Billais 35580 Baulon, France -mob: +33 6 19 22 03 54 -fix: +33 9 51 84 42 42 -} ; - - - my $message_body_blabla = qq{ Here is the fingerprint of my public key pub 1024D/FDA2B3DC 2002-05-08 Key fingerprint = 7906 F53D 0D62 0C67 304A 4CF0 6928 869B FDA2 B3DC @@ -1001,7 +1083,7 @@ sub invoice_sent { sub write_email_message { my ( $dir_invoices, $invoice, $message_header, $message_body, $email_address ) = @_ ; - my $message_body_utf8 = to_utf8({ -string => $message_body, -charset => 'ISO-8859-1' }); + my $message_body_utf8 = Unicode::MapUTF8::to_utf8({ -string => $message_body, -charset => 'ISO-8859-1' }); my $invoice_00000 = invoice_00000( $invoice ) ; @@ -1027,7 +1109,7 @@ sub write_email_message { sub write_tex_variables_file { - my ( $dir_invoices, $invoice, $Date, $tex_variables_utf8 ) = @_ ; + my ( $dir_invoices, $invoice, $Date, $tex_variables_utf8, $tex_variables ) = @_ ; my $invoice_00000 = invoice_00000( $invoice ) ; @@ -1039,16 +1121,20 @@ sub write_tex_variables_file { $debug and print "Writing imapsync_var.tex $dir_invoices/$invoice_00000/imapsync_var.tex\n" ; $dry and return( ) ; - open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var.tex") or die ; + # original input + open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_latin1.tex") or die ; + print FILE $tex_variables ; + close( FILE ) ; + + # utf8 conversion + open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_utf8.tex") or die ; print FILE $tex_variables_utf8 ; close( FILE ) ; + + system( "cat $dir_invoices/$invoice_00000/imapsync_var_latin1.tex | 8859_utf8 > $dir_invoices/$invoice_00000/imapsync_var.tex" ) ; if ( ! -f "$dir_invoices/$invoice_00000/imapsync_var_manual.tex" ) { - open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_manual.tex") or die ; - print FILE "%% $0 created this file -%% Can be used to override imapsync_var.tex definitions\n" ; - print FILE $tex_variables_utf8 ; - close( FILE ) ; + system( "cp $dir_invoices/$invoice_00000/imapsync_var.tex $dir_invoices/$invoice_00000/imapsync_var_manual.tex" ) ; } } @@ -1064,6 +1150,8 @@ sub download_urls { ( 'software + support' eq $F->{object_type} ) or ( 'support' eq $F->{object_type} ) + or + ( 'service' eq $F->{object_type} ) ) ) { $F->{urlSrc} = 'http://imapsync.lamiral.info/paypal_return.shtml' ; @@ -1202,36 +1290,34 @@ sub tva_line_one_button_for_the_software { or 'imapsync source code' eq $A->{Titre_de_l_objet} ) { - if ( - ( 'individual' eq $A->{client_type} ) - or - ( 'France' eq $A->{Pays} ) - ) { + $debug and print "tva_line_one_button_for_the_software $A->{Titre_de_l_objet}\n" ; + if ( 'TAXED' eq $A->{vat_type} ) { $A->{montant_HT_EUR_logi_ass} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; $A->{montant_TVA_EUR_logi} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; }else{ $A->{montant_HT_EUR_logi_exo} = $A->{Montant2} ; } } - } sub tva_line_one_button_for_the_support { my $A = shift ; - + + if ( 'single' ne $A->{button_type} ) { return ; } + if ( 'support' eq $A->{object_type} ) { if ( - ( 'individual' eq $A->{client_type} ) - or - ( 'France' eq $A->{Pays} ) + ( 'TAXED' eq $A->{vat_type} ) or ( '2013_02_19' gt $A->{date_aaaa_mm_jj} ) - ) + ) { + $debug and print "tva_line_one_button_for_the_support $A->{Montant2} $A->{date_aaaa_mm_jj} $A->{Titre_de_l_objet}\n" ; $A->{montant_HT_EUR_sup} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; $A->{montant_TVA_EUR_sup} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; }else{ + $debug and print "tva_line_one_button_for_the_support $A->{Montant2} $A->{date_aaaa_mm_jj} $A->{Titre_de_l_objet}\n" ; $A->{montant_HT_EUR_sup_exo} = $A->{Montant2} ; } } @@ -1251,20 +1337,53 @@ sub button_type { } } -sub tva_line_one_button_for_support_and_software { +sub tva_line_one_button_for_support_and_software_and_service { my $A = shift ; - $A->{Montant2_logi} = software_price( $A->{date_aaaa_mm_jj} ) ; - $A->{Montant2_supp} = $A->{Montant2} - $A->{Montant2_logi} ; + if ( 'mixed' ne $A->{button_type} ) { return ; } + + $debug and print "tva_line_one_button_for_support_and_software_and_service $A->{object_type} $A->{Titre_de_l_objet}\n" ; + + if ( 'service' eq $A->{object_type} ) { + $A->{Montant2_serv} = $A->{Montant2} ; + if ( 'TAXED' eq $A->{vat_type} ) { + $A->{montant_HT_EUR_serv_ass} = $A->{Montant2_serv} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + $A->{montant_TVA_EUR_serv} = $A->{Montant2_serv} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; + }else{ + $A->{montant_HT_EUR_serv_exo} = $A->{Montant2_serv} ; + } + return ; + } + + if ( 'support' eq $A->{object_type} ) { + $A->{Montant2_supp} = $A->{Montant2} ; + if ( 'TAXED' eq $A->{vat_type} ) { + $A->{montant_HT_EUR_sup} = $A->{Montant2_supp} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + $A->{montant_TVA_EUR_sup} = $A->{Montant2_supp} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; + }else{ + $A->{montant_HT_EUR_sup_exo} = $A->{Montant2_supp} ; + } + return ; + } + + if ( 'software' eq $A->{object_type} ) { + $A->{Montant2_logi} = $A->{Montant2} ; + if ( 'TAXED' eq $A->{vat_type} ) { + $A->{montant_HT_EUR_logi_ass} = $A->{Montant2_logi} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + $A->{montant_TVA_EUR_logi} = $A->{Montant2_logi} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; + }else{ + $A->{montant_HT_EUR_logi_exo} = $A->{Montant2_logi} ; + } + return ; + } + + if ( 'software + support' eq $A->{object_type} ) { + $A->{Montant2_logi} = software_price( $A->{date_aaaa_mm_jj} ) ; + $A->{Montant2_supp} = $A->{Montant2} - $A->{Montant2_logi} ; - if ( 'mixed' eq $A->{button_type} ) { - if ( 'individual' eq $A->{client_type} - or - 'France' eq $A->{Pays} - ) - { - $A->{montant_HT_EUR_sup} = $A->{Montant2_supp} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + if ( 'TAXED' eq $A->{vat_type} ) { + $A->{montant_HT_EUR_sup} = $A->{Montant2_supp} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; $A->{montant_TVA_EUR_sup} = $A->{Montant2_supp} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; $A->{montant_HT_EUR_logi_ass} = $A->{Montant2_logi} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; $A->{montant_TVA_EUR_logi} = $A->{Montant2_logi} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; @@ -1272,7 +1391,11 @@ sub tva_line_one_button_for_support_and_software { $A->{montant_HT_EUR_logi_exo} = $A->{Montant2_logi} ; $A->{montant_HT_EUR_sup_exo} = $A->{Montant2_supp} ; } + return ; } + + print "tva_line_one_button_for_support_and_software_and_service type $A->{object_type} title $A->{Titre_de_l_objet} mont $A->{Montant2} Option_1 $A->{Valeur_Option_1} Option_2 $A->{Option_2_Valeur}\n" ; + print Data::Dumper->Dump( [$A] ) ; } @@ -1282,19 +1405,53 @@ sub tva_line { $A->{montant_HT_EUR_logi_exo} = $A->{montant_HT_EUR_logi_ass} = $A->{montant_TVA_EUR_logi} = 0 ; $A->{montant_HT_EUR_sup} = $A->{montant_TVA_EUR_sup} = $A->{montant_HT_EUR_sup_exo} = 0 ; + $A->{montant_HT_EUR_serv_exo} = $A->{montant_HT_EUR_serv_ass} = $A->{montant_TVA_EUR_serv} = 0 ; + $A->{date_aaaa_mm_jj} = date_aaaa_mm_jj( $A->{Date} ) ; + clientVAT( $A ) ; client_type( $A ) ; object_type( $A ) ; button_type( $A ) ; - $A->{date_aaaa_mm_jj} = date_aaaa_mm_jj( $A->{Date} ) ; + vat_type( $A ) ; $A->{Montant2} = $A->{Montant2}/$usdeur if 'USD' eq $A->{Devise} ; tva_line_one_button_for_the_software( $A ) ; tva_line_one_button_for_the_support( $A ) ; - tva_line_one_button_for_support_and_software( $A ) ; - return( ) ; + tva_line_one_button_for_support_and_software_and_service( $A ) ; + return ; } +sub vat_type { + my $F = shift ; + + if ( + ( 'individual' eq $F->{client_type} ) + or ( 'France' eq $F->{Pays} ) + ) { + $F->{vat_type} = 'TAXED' ; + }else{ + $F->{vat_type} = 'EXEMPT' ; + } + return ; + +} + +sub clientVAT { + + my $F = shift ; + $F->{clientVAT} = '' ; + + if ( + ( 'VAT if professional in Europe' eq $F->{Nom_Option_2} ) + and ( $F->{Option_2_Valeur} ) + and ( $F->{Option_2_Valeur} !~ /^\s+$/ ) + and ( 'N/A' ne $F->{Option_2_Valeur} ) + ) { + $F->{clientVAT} = $F->{Option_2_Valeur} ; + } + return ; +} + sub tva_stuff_one_button_for_support_xor_software { @@ -1302,14 +1459,13 @@ sub tva_stuff_one_button_for_support_xor_software { if ( not ( 'software' eq $F->{object_type} or 'support' eq $F->{object_type} + or 'service' eq $F->{object_type} ) ) { - return( ) ; + return ; } - - if ( ( 'individual' eq $F->{clientTypeEN}) - or - ( 'France' eq $F->{Pays} ) - ) { + + + if ( 'TAXED' eq $F->{vat_type} ) { $F->{priceHT} = sprintf('%2.2f', $F->{Hors_taxe} / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) ) ; $F->{priceBHT} = '' ; $F->{priceZHT} = $F->{priceHT} ; @@ -1336,25 +1492,34 @@ sub tva_stuff_one_button_for_support_xor_software { $price =~ s{\.}{, } ; } - return( ) ; + return ; } sub tva_stuff_one_button_for_support_and_software { my $F = shift ; - if ( not ( 'software + support' eq $F->{object_type} ) ) { - return( ) ; + if ( ! ( 'software + support' eq $F->{object_type} ) ) { + return ; } + # Default values + $F->{priceHT} = '' ; + $F->{priceBHT} = '' ; + $F->{priceZHT} = '' ; + $F->{tvaFR} = '' ; + $F->{priceZTVA} = '' ; + $F->{priceZTTC} = '' ; + $F->{HTorTTC} = '' ; + $F->{messageTVAFR} = '' ; + $F->{messageTVAEN} = '' ; + + # Now the stuff my $amountZ = $F->{Hors_taxe} ; my $amountA = software_price( $F->{date_aaaa_mm_jj} ) ; my $amountB = $amountZ - $amountA ; - if ( ( 'individual' eq $F->{clientTypeEN}) - or - ( 'France' eq $F->{Pays} ) - ) { + if ( 'TAXED' eq $F->{vat_type} ) { $F->{priceHT} = sprintf('%2.2f', $amountA / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) ) ; $F->{priceBHT} = sprintf('%2.2f', $amountB / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) ) ; $F->{priceZHT} = $F->{Hors_taxe} ; @@ -1392,8 +1557,6 @@ sub tva_stuff { $F->{priceTTCusd} = '' ; $F->{Hors_taxe} =~ s{,}{.} ; - $F->{date_aaaa_mm_jj} = date_aaaa_mm_jj( $F->{Date} ) ; - tva_stuff_one_button_for_support_xor_software( $F ) ; tva_stuff_one_button_for_support_and_software( $F ) ; return( ) ; @@ -1401,11 +1564,15 @@ sub tva_stuff { sub client_type { my $F = shift ; + #print "$F->{date_aaaa_mm_jj} $F->{Date}\n" ; + + # Default to professional $F->{client_type} = 'professional' ; $F->{clientTypeEN} = 'professional' ; $F->{clientTypeFR} = 'professionnel' ; + # Otherwise if ('imapsync usage' eq $F->{Nom_Option_1} and 'individual' eq $F->{Valeur_Option_1} ) { $F->{client_type} = 'individual' ; $F->{clientTypeEN} = 'individual' ; @@ -1418,6 +1585,16 @@ sub client_type { $F->{client_type} = 'individual' ; $F->{clientTypeEN} = 'individual' ; $F->{clientTypeFR} = 'individuel' ; + }elsif ( + 'imapsync choice' eq $F->{Nom_Option_1} + and ( $F->{Valeur_Option_1} =~ /individual/ ) + and ( '2016_10_01' le $F->{date_aaaa_mm_jj} ) + and ( not $F->{clientVAT} ) + + ) { + $F->{client_type} = 'individual' ; + $F->{clientTypeEN} = 'individual' ; + $F->{clientTypeFR} = 'individuel' ; } return( ) ; diff --git a/W/paypal_reply/paypal_bilan_1.100 b/W/paypal_reply/paypal_bilan_1.100 new file mode 100755 index 0000000..f238d6e --- /dev/null +++ b/W/paypal_reply/paypal_bilan_1.100 @@ -0,0 +1,1581 @@ +#!/usr/bin/perl + +# $Id: paypal_bilan,v 1.100 2017/08/10 14:43:06 gilles Exp gilles $ + +use strict; +use warnings; +use Getopt::Long; +use Text::CSV_XS ; +use IO::Handle ; +use Data::Dumper ; +use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); +use Test::More 'no_plan' ; + +#print join( "\n", utf8_supported_charset( ) ) ; +die unless (utf8_supported_charset('ISO-8859-1')); + + +my $rcs = '$Id: paypal_bilan,v 1.100 2017/08/10 14:43:06 gilles Exp gilles $ ' ; +$rcs =~ m/,v (\d+\.\d+)/ ; +my $VERSION = ($1) ? $1: "UNKNOWN" ; + + +my $total_usd_received = 0 ; +my $total_usd_invoice = 0 ; +my $total_HT_EUR_logi_exo = 0 ; +my $total_HT_EUR_logi_ass = 0 ; +my $total_TVA_EUR_logi = 0 ; + +my $total_HT_EUR_sup = 0 ; +my $total_TVA_EUR_sup = 0 ; +my $total_HT_EUR_sup_exo = 0 ; + +my $total_eur_received = 0 ; +my $total_eur_invoice = 0 ; +my $nb_invoice = 0 ; +my $nb_invoice_refund = 0 ; +my $nb_invoice_suspended = 0 ; +my $nb_invoice_canceled = 0 ; + +my ( $tests, $testeur ) ; +my $dry ; +my $debug ; +my $debug_csv ; +my $debug_dev ; +my $debug_invoice ; +my $debug_invoice_utf8 ; +my $debug_email; + +my $first_invoice = 1 ; +my $print_details = '' ; +my $bnc = '' ; +my $exportbnc = '' ; + +my $usdeur = 1.2981 ; +my $invoices ; +my %invoice_refund ; +my %invoice_canceled ; +my %invoice_suspended ; +my $write_invoices = 0 ; +my $avoid_numbers ; + +my $dir_invoices ; + +my $option_ret = GetOptions ( + 'tests' => \$tests, + 'dry' => \$dry, + 'debug' => \$debug, + 'debug_csv' => \$debug_csv, + 'debug_dev' => \$debug_dev, + 'debug_invoice' => \$debug_invoice, + 'debug_invoice_utf8' => \$debug_invoice_utf8, + 'debug_email' => \$debug_email, + + 'first_invoice=i' => \$first_invoice, + 'print_details|details' => \$print_details, + 'bnc' => \$bnc, + 'exportbnc=s' => \$exportbnc, + 'usdeur=f' => \$usdeur, + 'invoices=s' => \$invoices, + 'write_invoices!' => \$write_invoices, + 'dir_invoices=s' => \$dir_invoices, + 'avoid_numbers=s' => \$avoid_numbers, +); + +$dir_invoices ||= '/g/var/paypal_invoices' ; +if ( $write_invoices and not -d "$dir_invoices" ) { + $debug and print "mkdir $dir_invoices\n" ; + $dry or mkdir( $dir_invoices ) or die ; +} + + + +$debug and print "dir_invoices = $dir_invoices\n" ; + +$testeur = Test::More->builder ; +$testeur->no_ending(1) ; + +if ( $tests ) { + $testeur->no_ending( 0 ) ; + exit( tests( ) ) ; +} + + +my @files = @ARGV ; +my %action_invoice ; + +my %invoice_paypal ; + +my @invoices_wanted = split( /\s+/, $invoices ) if $invoices ; + +my @avoid_numbers = split( /\s+/, $avoid_numbers ) if $avoid_numbers ; +my %avoid_numbers ; +@avoid_numbers{ @avoid_numbers } = ( ) if @avoid_numbers ; + +#print "@invoices\n" ; + +my @actions ; + +foreach my $file ( @files ) { + + my @actions_file = parse_file( $file ) ; + push( @actions, @actions_file ) ; +} + +foreach my $action (@actions) { + # compute_line() adds $action->{ 'invoice' } if needed + compute_line( $action ) ; + + # index by invoice number + $action_invoice{ $action->{ 'invoice' } } = $action ; +} +delete $action_invoice{ 'NONE' } ; + + +my $last_invoice ; +my @invoice_paypal = sort { $a <=> $b } keys %invoice_paypal ; +$last_invoice = $invoice_paypal[-1] || 0 ; +my $first_invoice_paypal = $invoice_paypal[0] || 0 ; + +@invoices_wanted = ( $first_invoice .. $last_invoice ) if ( ! @invoices_wanted ) ; + +my @invoice_sent ; +my %invoice_sent ; +my @invoice_not_sent ; +my %invoice_not_sent ; + +foreach my $invoice ( @invoices_wanted ) { + + my $action = $action_invoice{ $invoice } ; + next if ! $action ; + my $email_address = $action->{ "De l'adresse email" } ; + + my $invoice_sent = invoice_sent( $dir_invoices, $invoice, $email_address ) ; + #print "$invoice $invoice_sent $email_address\n" ; + + if ( $invoice_sent ) { + $invoice_sent{ $invoice }++ ; + build_invoice( $invoice ) if ( $debug_invoice or $debug_invoice_utf8 ) ; + }elsif( not ( $invoice_canceled{ $invoice } or $invoice_refund{ $invoice } ) ) { + $invoice_not_sent{ $invoice }++ ; + build_invoice( $invoice ) ; + } +} + +@invoice_sent = sort { $a <=> $b } keys( %invoice_sent ) ; +my $nb_invoice_sent = scalar( @invoice_sent ) ; +@invoice_not_sent = sort { $a <=> $b } keys( %invoice_not_sent ) ; + +my @invoice_canceled = sort { $a <=> $b } keys( %invoice_canceled ) ; +my @invoice_suspended = sort { $a <=> $b } keys( %invoice_suspended ) ; +my @invoice_refund = sort { $a <=> $b } keys( %invoice_refund ) ; + + +print( "\n", "=" x 60, "\n" ) ; + +my $total_usd_paypal_cost ; +$total_usd_paypal_cost = sprintf('%2.2f', $total_usd_invoice - $total_usd_received ) ; +if ( 0 < $total_usd_received ) { print "USD received $total_usd_received\n" ; } +if ( 0 < $total_usd_invoice ) { print "USD invoice $total_usd_invoice\n" ; } +if ( 0 < $total_usd_paypal_cost ) { print "USD costs $total_usd_paypal_cost\n" ; } + +my $total_eur_invoice_from_usd ; +my $total_eur_received_from_usd ; +my $total_eur_paypal_cost_from_usd ; + +# au 30 nov 2010 http://fr.finance.yahoo.com/devises/convertisseur/#from=EUR;to=USD;amt=1 +$total_eur_invoice_from_usd = sprintf('%2.2f', $total_usd_invoice / $usdeur ) ; +$total_eur_received_from_usd = sprintf('%2.2f', $total_usd_received / $usdeur ) ; +$total_eur_paypal_cost_from_usd = sprintf('%2.2f', $total_usd_paypal_cost / $usdeur ) ; + +# EUR +$total_eur_received = sprintf('%2.2f', $total_eur_received) ; +$total_eur_invoice = sprintf('%2.2f', $total_eur_invoice) ; +if ( 0 < $total_eur_invoice_from_usd ) { print "EUR invoice from USD $total_eur_invoice_from_usd\n" ; } +print "EUR received from EUR $total_eur_received\n" ; +print "EUR invoice from EUR $total_eur_invoice\n" ; + +my $total_eur_invoice_from_eur_usd = $total_eur_invoice_from_usd + $total_eur_invoice ; +my $total_eur_received_from_eur_usd = $total_eur_received_from_usd + $total_eur_received ; +my $total_eur_paypal_cost = $total_eur_invoice - $total_eur_received + $total_eur_paypal_cost_from_usd ; + + +$total_HT_EUR_logi_exo = sprintf('%2.2f', $total_HT_EUR_logi_exo) ; +$total_HT_EUR_logi_ass = sprintf('%2.2f', $total_HT_EUR_logi_ass) ; +$total_TVA_EUR_logi = sprintf('%2.2f', $total_TVA_EUR_logi) ; + +$total_HT_EUR_sup = sprintf('%2.2f', $total_HT_EUR_sup) ; +$total_TVA_EUR_sup = sprintf('%2.2f', $total_TVA_EUR_sup) ; +$total_HT_EUR_sup_exo = sprintf('%2.2f', $total_HT_EUR_sup_exo) ; +my $total_HT_EUR_exo = $total_HT_EUR_sup_exo + $total_HT_EUR_logi_exo ; +$total_HT_EUR_exo = sprintf('%2.2f', $total_HT_EUR_exo) ; + +$total_eur_invoice_from_eur_usd = sprintf('%2.2f', $total_eur_invoice_from_eur_usd) ; +$total_eur_paypal_cost = sprintf('%2.2f', $total_eur_paypal_cost) ; + +print( "---- USD + EUR ----\n" ) ; +print "EUR total invoice $total_eur_invoice_from_eur_usd\n" ; +print "EUR total received $total_eur_received_from_eur_usd\n" ; +print "EUR total paypal cost $total_eur_paypal_cost\n" ; +print ; +print( "---- Assujeti TVA ----\n" ) ; +print "EUR total HT supp assuj $total_HT_EUR_sup (ventes, prestations)\n" ; +#print "EUR total TVA supp assuj $total_TVA_EUR_sup\n" ; +print "EUR total HT licen assuj $total_HT_EUR_logi_ass (autres operations imposables)\n" ; +#print "EUR total TVA licen assuj $total_TVA_EUR_logi\n" ; + +print( "---- Exonere TVA ----\n" ) ; +print "EUR total HT suppo exo $total_HT_EUR_sup_exo (autres operations NON imposables)\n" ; +print "EUR total HT licen exo $total_HT_EUR_logi_exo (autres operations NON imposables)\n" ; +print "EUR total HT autres operations NON imposables: $total_HT_EUR_sup_exo + $total_HT_EUR_logi_exo = $total_HT_EUR_exo\n" ; + +print( "---- Invoices ----\n" ) ; + +print "Nb invoice $nb_invoice ( from $first_invoice_paypal to $last_invoice )\n" ; +print "Nb invoice canceled ($nb_invoice_canceled) @invoice_canceled\n" ; +print "Nb invoice suspended ($nb_invoice_suspended) @invoice_suspended\n" ; +print "Nb invoice refund ($nb_invoice_refund) @invoice_refund\n" ; +print "Nb invoice sent $nb_invoice_sent\n" ; +print "Have to send invoices @invoice_not_sent\n" if ( @invoice_not_sent ) ; + +my $total_eur2 = $total_HT_EUR_logi_exo + $total_HT_EUR_logi_ass + $total_TVA_EUR_logi + $total_HT_EUR_sup + $total_TVA_EUR_sup + $total_HT_EUR_sup_exo ; +$total_eur2 = sprintf('%2.2f', $total_eur2) ; +print "$total_eur_invoice_from_eur_usd != $total_eur2 = $total_HT_EUR_logi_exo + $total_HT_EUR_logi_ass + $total_TVA_EUR_logi + $total_HT_EUR_sup + $total_TVA_EUR_sup + $total_HT_EUR_sup_exo\n" +if ( $total_eur_invoice_from_eur_usd != $total_eur2 ) ; + +sub parse_one_line_io { + my $csv = shift ; + my $io = shift ; + + my $line = $csv->getline($io) ; + + return if ( $csv->eof( ) ) ; + if ( not defined( $line ) ) { + my($cde, $str, $pos) = $csv->error_diag () ; + print "[$cde] [$str] [$pos]\n" ; + + } + return( $line ) ; +} + +sub hash_and_count_dupplicate { + my @columns = @_ ; + my %columns ; + + #@columns_def{ @columns_def } = ( ) ; + foreach my $col ( @columns ) { + $columns{ $col } += 1 ; + } + $debug_csv and print "Nb columns: ", scalar( keys %columns ), " ", scalar( @columns ), "\n" ; + # debug how many time a title is defined + foreach my $col (1 .. scalar( @columns )) { + $debug_csv and print "$col | ", + deci_to_AA( $col ) , " | ", + $columns{ $columns[ $col - 1 ] }, " | ", + $columns[ $col - 1 ], "\n" ; + } + + # exit in case two columns have the same name + die "Erreur : doublons dans les titres\n" if ( scalar( keys %columns ) != scalar( @columns ) ) ; + + return( %columns ) ; +} + +sub deci_to_AA { + my $deci = shift ; + my $AA = ''; + + while ( $deci > 0 ) { + my $quot = int( ( $deci - 1 ) / 26 ) ; + my $rest = $deci - 1 - ( 26 * $quot ) ; + my $char = chr ( ord('A') + $rest ) ; + $AA = $char . $AA ; + $deci = $quot ; + } + #print "col=$AA\n" ; + return( $AA ) ; +} + +sub remove_first_blank { + my $string = shift ; + + $string =~ s/^ +// ; + return( $string ) ; + +} + +sub parse_file { + my $file = shift ; + + open my $io, "<", $file or die "$file: $!" ; + + my $csv = Text::CSV_XS->new( { + sep_char => ',', + binary => 1, + keep_meta_info => 1, + eol => $/, + } ) ; + + my $line_1 = parse_one_line_io( $csv, $io ) ; + die if ( not defined $line_1 ) ; # first line must have no problem + + my @columns_def_orig = @$line_1 ; + my @columns_def = map { remove_first_blank( $_ ) } @columns_def_orig ; + $debug_csv and print "columns_def = ", map( { "[$_]" } @columns_def ), "\n"; + + my %columns_def = hash_and_count_dupplicate( @columns_def ) ; + my $nb_columns_def = scalar @columns_def ; + + my $line_counter = 2 ; + my @actions ; + while ( 1 ) { + $debug_csv and print "ligne $line_counter ", $csv->eof( ), "\n" ; + my $line = parse_one_line_io( $csv, $io ) ; + last if ( $csv->eof( ) ) ; + if ( not defined $line ) { + print "Erreur ligne $line_counter : ", $csv->error_diag, "\n\n"; + ++$line_counter ; + next ; + } + my @columns = @$line ; + + if ( $nb_columns_def != scalar @columns ) { + print "Erreur ligne $line_counter : nombre de colonnes = ", scalar @columns, " != $nb_columns_def\n" ; + ++$line_counter ; + next ; + } + my %columns ; + @columns{ @columns_def } = @columns ; + $columns{ 'file_csv' } = $file ; + $columns{ 'line_number' } = $line_counter ; + $csv->combine( @columns ) ; + my $line_csv = $csv->string(); + $columns{ 'line_csv' } = $line_csv ; + $debug_csv and print map( { "[$_] = [" . $columns{$_} . "]\n" } + @columns_def, 'line_number', 'line_csv', 'file_csv' ), + "\n"; + ++$line_counter ; + push( @actions, \%columns ) ; + } + close( $io ); + return( reverse @actions ) ; +} + +sub next_invoice { + my @current_numbers = sort { $a <=> $b } ( $first_invoice - 1, keys( %invoice_paypal ) ) ; + my $last_invoice = $current_numbers[ -1 ] || 0 ; + + #keys( %avoid_numbers ), + my $next_invoice = $last_invoice + 1 ; + while ( exists( $avoid_numbers{ $next_invoice } ) ) { $next_invoice++ ; } + $invoice_paypal{ $next_invoice } = 1 ; + #print "AAA [@current_numbers] [$last_invoice] [$next_invoice]\n" ; + + return( $next_invoice ) ; +} + +sub keyval { + my %hash = @_ ; + return( join( " ", map( { "$_ => " . $hash{ $_ } } keys %hash ) ) . "\n" ) ; +} + + +sub invoice_00000 { + my $invoice = shift ; + + return( sprintf( "%04d", $invoice ) ) ; +} + +sub tests_invoice_00000 { + + ok( '0000' eq invoice_00000( 0 ), 'invoice_00000: 0 -> 0000' ) ; + ok( '0147' eq invoice_00000( 147 ), 'invoice_00000: 147 -> 0147' ) ; + ok( '99999' eq invoice_00000( 99999 ), 'invoice_00000: 99999 -> 99999' ) ; +} + +sub tests_next_invoice { + ok( 1 == next_invoice( ), 'next_invoice: 1' ) ; + ok( 2 == next_invoice( ), 'next_invoice: 2' ) ; + @avoid_numbers{ (3, 4, 6, 8 ) } = ( ) ; + ok( 5 == next_invoice( ), 'next_invoice: 7' ) ; + ok( 7 == next_invoice( ), 'next_invoice: 8' ) ; + ok( 9 == next_invoice( ), 'next_invoice: 9' ) ; + %invoice_paypal = () ; + $first_invoice = 7 ; + ok( 7 == next_invoice( ), 'next_invoice: 7' ) ; +} + + +sub tests_exportbnc { + ok( 1 == 1, '1 == 1' ) ; + +} + + + +sub tests { + tests_next_invoice( ) ; + tests_cut( ) ; + tests_invoice_00000( ) ; + #tests_exportbnc( ) ; + tests_tva_rate( ) ; + tests_tva_rate_str( ) ; + tests_software_price( ) ; +} + +sub compute_line_debug { + + my $A = shift ; + + return( "#" x 78, "\n", + "[$A->{Date}] [$A->{Heure}] [$A->{Fuseau_horaire}] [$A->{Nom}] [$A->{Type}] [$A->{Etat}] ", + "[$A->{Devise}] [$A->{Hors_taxe_paypal}] [$A->{Montant}] [$A->{N_de_transaction}] [$A->{Solde}] [$A->{Impact_sur_le_solde}] ", + "[$A->{Pays}] [$A->{Nom_Option_1}] [$A->{Valeur_Option_1}] [$A->{Titre_de_l_objet}]\n" ) ; + +} + +sub bnc_first_line { + my $A = shift ; + $A->{MontantEUR} = $A->{Montant} ; + $A->{MontantEUR} = sprintf( "%.4f", $A->{Montant}/$usdeur ) if ($A->{Devise} eq 'USD') ; + return( "\n", "=" x 60, "\n", + "[$A->{Date}] [$A->{Nom}] [$A->{Type}] [$A->{Etat}] [$A->{Devise}] ", + "[$A->{Hors_taxe_paypal}] [$A->{Montant}] [EUR $A->{MontantEUR}] [$A->{Impact_sur_le_solde}]\n", + "[$A->{Pays}] [$A->{Nom_Option_1}] [$A->{Valeur_Option_1}] [$A->{Titre_de_l_objet}]\n" ) ; +} + +sub details { + + my $A = shift ; + + return( "[$A->{invoice}] [$A->{Date}] [$A->{Heure}] [$A->{Fuseau_horaire}] ", + "[$A->{Nom}] [$A->{Type}] [$A->{Etat}] [$A->{Devise}] [$A->{Montant}] ", + "[$A->{N_de_transaction}] [$A->{Solde}] [$A->{Impact_sur_le_solde}]\n" ) ; + +} + +sub paiement_usd_termine{ + + my $A = shift ; + + if ( + 'Paiement sur site marchand reçu' eq $A->{Type} + and 'USD' eq $A->{Devise} + and ( 'Terminé' eq $A->{Etat} or 'Compensé' eq $A->{Etat} ) + ) { + $A->{Montant} =~tr/,/./; + $A->{Montant2} = $A->{Hors_taxe_paypal} ; + $total_usd_received += $A->{Montant} ; + $total_usd_invoice += $A->{Montant2} ; + tva_line( $A ) ; + $total_HT_EUR_logi_exo += $A->{montant_HT_EUR_logi_exo} ; + $total_HT_EUR_logi_ass += $A->{montant_HT_EUR_logi_ass} ; + $total_TVA_EUR_logi += $A->{montant_TVA_EUR_logi} ; + + $A->{invoice} = next_invoice( ) ; + $nb_invoice++ ; + $print_details and print( details( $A ) ) ; + } +} + +sub paiement_eur_termine { + + my $A = shift ; + + if ( + 'Paiement sur site marchand reçu' eq $A->{Type} + and 'EUR' eq $A->{Devise} + and ( 'Terminé' eq $A->{Etat} or 'Compensé' eq $A->{Etat} ) + ) { + $A->{Montant} =~tr/,/./; + $A->{Montant2} = $A->{Hors_taxe_paypal} ; + $total_eur_received += $A->{Montant} ; + $total_eur_invoice += $A->{Montant2} ; + tva_line( $A ) ; + $total_HT_EUR_logi_exo += $A->{montant_HT_EUR_logi_exo} ; + $total_HT_EUR_logi_ass += $A->{montant_HT_EUR_logi_ass} ; + $total_TVA_EUR_logi += $A->{montant_TVA_EUR_logi} ; + $total_HT_EUR_sup += $A->{montant_HT_EUR_sup} ; + $total_TVA_EUR_sup += $A->{montant_TVA_EUR_sup} ; + $total_HT_EUR_sup_exo += $A->{montant_HT_EUR_sup_exo} ; + + $A->{invoice} = next_invoice( ) ; + $nb_invoice++ ; + $print_details and print( details( $A ) ) ; + } +} + +sub paiement_eur_rembourse { + + my $A = shift ; + + if ( + 'Paiement sur site marchand reçu' eq $A->{Type} + and 'EUR' eq $A->{Devise} + and 'Remboursé' eq $A->{Etat} + ) { + $A->{invoice} = next_invoice( ) ; + $nb_invoice++ ; + $nb_invoice_refund++; + $invoice_refund{ $A->{invoice} }++ ; + + $print_details and print( details( $A ) ) ; + } +} + +sub paiement_eur_annule { + + my $A = shift ; + + if ( + 'Paiement sur site marchand reçu' eq $A->{Type} + and 'EUR' eq $A->{Devise} + and 'Annulé' eq $A->{Etat} + ) { + $A->{invoice} = next_invoice( ) ; + $nb_invoice++ ; + $nb_invoice_canceled++; + $invoice_canceled{ $A->{invoice} }++ ; + + $print_details and print( details( $A ) ) ; + } +} + +sub paiement_eur_suspendu { + + my $A = shift ; + + if ( + 'Paiement sur site marchand reçu' eq $A->{Type} + and 'EUR' eq $A->{Devise} + and 'Suspendu' eq $A->{Etat} + ) { + $A->{invoice} = next_invoice( ) ; + $nb_invoice++ ; + $nb_invoice_suspended++; + $invoice_suspended{ $A->{invoice} }++ ; + + $print_details and print( details( $A ) ) ; + } +} + +sub paiement_eur_non_compense { + + my $A = shift ; + + if ( + 'Paiement sur site marchand reçu' eq $A->{Type} + and 'EUR' eq $A->{Devise} + and 'Non compensé' eq $A->{Etat} + ) { + $A->{invoice} = next_invoice( ) ; + $nb_invoice++ ; + $print_details and print( details( $A ) ) ; + } +} + + + +sub compute_line { + + my $action = shift ; + my %action = %$action ; + my $A ; + + @{$A}{ qw( + Date Heure Fuseau_horaire Nom Type Etat + Devise Montant N_de_transaction Solde + Pays Nom_Option_1 Valeur_Option_1 Hors_taxe_paypal + Titre_de_l_objet Nom_Option_2 Option_2_Valeur + Impact_sur_le_solde + ) } + = @action{ ( 'Date', 'Heure', 'Fuseau horaire', 'Nom', 'Type', 'Etat', + 'Devise', 'Montant', "N° de transaction", 'Solde', + 'Pays', 'Nom Option 1', 'Valeur Option 1', 'Hors taxe', + "Titre de l'objet", 'Nom Option 2', 'Option 2 Valeur', + 'Impact sur le solde') } ; + + ( $A->{Etat} ) = @action{ ( 'Etat' ) } || @action{ ( 'État' ) } ; + ( $A->{Hors_taxe_paypal} ) = @action{ ( 'Hors taxe' ) } || @action{ ( 'Avant commission' ) } ; + + # August 2016 + ( $A->{N_de_transaction} ) = @action{ ( 'N° de transaction' ) } || @action{ ( 'Numéro de transaction' ) } ; + #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; + #( $A->{} ) = @action{ ( '' ) } || @action{ ( '' ) } ; + + # + $A->{Impact_sur_le_solde} ||= '' ; + $A->{invoice} = 'NONE' ; + $A->{Montant} = $action->{ 'Net' } if not defined $A->{Montant}; + + $debug and print( compute_line_debug( $A ) ) ; + + $A->{Montant} =~ s/[^0-9-,.]//g ; + $A->{Montant} =~ s/,/./g ; + $A->{Hors_taxe_paypal} =~ s/,/./g ; + + $bnc and print( bnc_first_line( $A ) ) ; + paiement_usd_termine( $A ) ; + paiement_eur_termine( $A ) ; + paiement_eur_rembourse( $A ) ; + paiement_eur_annule( $A ) ; + paiement_eur_suspendu( $A ) ; + paiement_eur_non_compense( $A ) ; + $bnc and print( BNC_output( $A->{invoice}, FR_flag( $A->{Pays} ), + IND_flag( $A->{Nom_Option_1}, $A->{Valeur_Option_1} ), + SUPPORT_flag( $A->{Titre_de_l_objet} ), + $A->{Nom}, $A->{Date}, $A->{MontantEUR}, $A->{Devise}, + $A->{Titre_de_l_objet}, $A->{Impact_sur_le_solde}, $A->{Type} ) ) ; + + $action->{ 'invoice' } = $A->{invoice} ; +} + +sub BNC_output { +# FE 1359 FR IND imapsync Bougon Edouard +# [12/01/2012] FR IND 28.73 EUR + my( $invoice, $FR_flag, $IND_flag, $SUPPORT_flag, + $Nom, $Date, $MontantEUR, $Devise, $Titre_de_l_objet, $Impact_sur_le_solde, $Type ) = @_ ; + + my $BNC_output ; + + if ( 'NONE' eq $invoice ) { + $BNC_output = "[$Date] $MontantEUR $Devise $Nom $Titre_de_l_objet [$Impact_sur_le_solde] [$Type]\n" ; + }else{ + $BNC_output = + "FE $invoice$FR_flag$IND_flag imapsync$SUPPORT_flag $Nom\n" + . "[$Date]$FR_flag$IND_flag $MontantEUR $Devise \n" ; + } + return( $BNC_output ) ; +} + +sub SUPPORT_flag { + my $Titre_de_l_objet = shift ; + my $SUPPORT_flag = '' ; + $SUPPORT_flag = ' support' if ( 'imapsync support' eq $Titre_de_l_objet ) ; +} + +sub IND_flag { + my( $Nom_Option_1, $Valeur_Option_1 ) = @_ ; + my $IND_flag = '' ; + $IND_flag = ' IND' if ('imapsync usage' eq $Nom_Option_1 and 'individual' eq $Valeur_Option_1 ) ; + return( $IND_flag ) ; +} + +sub FR_flag { + my $Pays = shift ; + my $FR_flag = '' ; + + $FR_flag = ' FR' if $Pays eq 'France' ; + return( $FR_flag ) ; +} + +sub escape_for_tex { + + my $F = shift ; + foreach my $str ( + $F->{De_l_adresse_email}, + $F->{Nom}, + $F->{clientAdrA}, + $F->{clientAdrB}, + $F->{clientAdrC}, + $F->{clientAdrD}, + $F->{clientAdrE}, + $F->{clientAdrF}, + ) { + $str =~ s{#}{\\#}g ; + $str =~ s{_}{\\_}g ; + $str =~ s{&}{\\&}g ; + } +} + +sub build_invoice { + my $invoice = shift ; + + return if ! $invoice ; + + my $F ; + $F->{invoice} = $invoice ; + + my $action = $action_invoice{ $F->{invoice} } ; + #print Data::Dumper->Dump( [$action] ) ; + + @{$F}{ qw( Date Heure Nom Type Etat Devise Hors_taxe Commission Net + De_l_adresse_email A_l_adresse_email N_de_transaction Titre_de_l_objet + TVA Nom_Option_1 Valeur_Option_1 N_de_transaction_de_reference + Adresse_1 Adresse_2_district_quartier Ville + Etat_Province Code_postal Pays line_number line_csv file_csv + Nom_Option_2 Option_2_Valeur ) } + = @{$action}{ ( 'Date', 'Heure', 'Nom', 'Type', 'Etat', 'Devise', 'Hors taxe', 'Commission', 'Net', + "De l'adresse email", "A l'adresse email", 'N° de transaction', "Titre de l'objet", + 'TVA', 'Nom Option 1', 'Valeur Option 1', 'Nº de transaction de référence', + 'Adresse 1', 'Adresse 2/district/quartier', 'Ville', + 'Etat/Province/Région/Comté/Territoire/Préfecture/République', 'Code postal', 'Pays', 'line_number', 'line_csv', 'file_csv', + 'Nom Option 2', 'Option 2 Valeur' ) } ; + + # August 2016 + $F->{Commission} = $action->{'Commission'} || $action->{'Frais'} ; + $F->{N_de_transaction} = $action->{'N° de transaction'} || $action->{'Numéro de transaction'} ; + $F->{Adresse_1} = $action->{'Adresse 1'} || $action->{'Adresse (ligne 1)'} ; + #$F->{} = $action->{''} || $action->{''} ; + #$F->{} = $action->{''} || $action->{''} ; + #etc + + $F->{Etat_Province} = $action->{'Etat/Province/Région/Comté/Territoire/Préfecture/République'} + || $action->{'État/Province/Région/Comté/Territoire/Préfecture/République'} + || '' ; + $F->{Hors_taxe} = $action->{'Hors taxe'} || $action->{'Avant commission'} ; + $F->{Hors_taxe_num} = $F->{Hors_taxe} ; + $F->{Hors_taxe_num} =~ s{,}{.} ; + if ($F->{Hors_taxe_num} > 100) { + print "invoice $F->{invoice} $F->{Hors_taxe_num} > 100\n" ; + #return() ; + } + + build_email_message( $F ) ; + $debug_email and print( "\n", $F->{email_message_header}, $F->{email_message_body} ) ; + + if ( $write_invoices and ! invoice_sent( $dir_invoices, $F->{invoice}, $F->{De_l_adresse_email} ) ) { + write_email_message( $dir_invoices, $F->{invoice}, + $F->{email_message_header}, $F->{email_message_body}, + $F->{De_l_adresse_email} ) ; + write_csv_info( $dir_invoices, $F->{invoice}, $F->{file_csv}, $F->{line_number}, $F->{line_csv} ) ; + } + + $F->{date_aaaa_mm_jj} = date_aaaa_mm_jj( $F->{Date} ) ; + build_address( $F ) ; + escape_for_tex( $F ) ; + clientVAT( $F ) ; + client_type( $F ) ; + object_type( $F ) ; + vat_type( $F ) ; + description_stuff( $F ) ; + tva_stuff( $F ) ; + $F->{quantity} = '1' ; + + download_urls( $F ) ; + ( $F->{Nom1} ) = cut( $F->{Nom}, 42 ) ; + foreach my $key ( keys( %{ $F } ) ) { + #if ( not defined $F->{ $key } ) { print "$key\n" ; } + } + foreach my $key ( qw{ +invoice +Nom1 +De_l_adresse_email +clientAdrA +clientAdrB +clientAdrC +clientAdrD +clientAdrE +clientAdrF +clientVAT +Date +Heure +descriptionFR +descriptionEN +descriptionBFR +descriptionBEN +usageFR +usageEN +quantity +quantityB +priceHT +priceBHT +priceZHT +tvaFR +priceZTVA +HTorTTC +priceZTTC +messageTVAFR +messageTVAEN +urlSrc +} ) { + #if ( not defined $F->{ $key } ) { print "$key $F->{invoice}\n" ; } +} + + + my $tex_variables = qq{ +%% Begin input from paypal_bilan $VERSION éèàù +\\providecommand{\\invoiceNumber}{$F->{invoice}} +\\providecommand{\\clientName}{$F->{Nom1}} +\\providecommand{\\clientEmail}{$F->{De_l_adresse_email}} +\\providecommand{\\clientAdrA}{$F->{clientAdrA}} +\\providecommand{\\clientAdrB}{$F->{clientAdrB}} +\\providecommand{\\clientAdrC}{$F->{clientAdrC}} +\\providecommand{\\clientAdrD}{$F->{clientAdrD}} +\\providecommand{\\clientAdrE}{$F->{clientAdrE}} +\\providecommand{\\clientAdrF}{$F->{clientAdrF}} +\\providecommand{\\clientVAT}{$F->{clientVAT}} +\\providecommand{\\invoiceDate}{$F->{Date}} +\\providecommand{\\invoiceHour}{$F->{Heure}} + +\\providecommand{\\descriptionFR}{$F->{descriptionFR}} +\\providecommand{\\descriptionEN}{$F->{descriptionEN}} +\\providecommand{\\descriptionBFR}{$F->{descriptionBFR}} +\\providecommand{\\descriptionBEN}{$F->{descriptionBEN}} +\\providecommand{\\usageFR}{$F->{usageFR}} +\\providecommand{\\usageEN}{$F->{usageEN}} +\\providecommand{\\quantity}{$F->{quantity}} +\\providecommand{\\quantityB}{$F->{quantityB}} + +\\providecommand{\\priceHT}{$F->{priceHT}} +\\providecommand{\\priceBHT}{$F->{priceBHT}} +\\providecommand{\\priceZHT}{$F->{priceZHT}} +\\providecommand{\\tvaFR}{$F->{tvaFR}} +\\providecommand{\\priceZTVA}{$F->{priceZTVA}} +\\providecommand{\\HTorTTC}{$F->{HTorTTC}} +\\providecommand{\\priceZTTC}{$F->{priceZTTC}} +\\providecommand{\\messageTVAFR}{$F->{messageTVAFR}} +\\providecommand{\\messageTVAEN}{$F->{messageTVAEN}} +\\providecommand{\\urlSrc}{\\url{$F->{urlSrc}}} +%% End input from paypal_bilan +} ; + + my $tex_variables_utf8 = Unicode::MapUTF8::to_utf8( { -string => $tex_variables, -charset => 'ISO-8859-1' } ) ;# + + $debug_invoice_utf8 and print $tex_variables_utf8 ; + $debug_invoice and print $tex_variables ; + + #print "$F->{invoice} ", invoice_sent( $dir_invoices, $F->{invoice}, $F->{De_l_adresse_email} ), "\n" ; + if ( $write_invoices + and ! invoice_sent( $dir_invoices, $F->{invoice}, $F->{De_l_adresse_email} ) ) { + write_tex_variables_file( $dir_invoices, $F->{invoice}, $F->{Date}, $tex_variables_utf8, $tex_variables ) ; + } + +} + +sub description_stuff { + my $F = shift ; + + $F->{descriptionFR} = $F->{descriptionEN} = '' ; + $F->{descriptionBFR} = $F->{descriptionBEN} = '' ; + $F->{quantityB} = '' ; + $F->{usageFR} = $F->{usageEN} = '' ; + + + if ( 'software' eq $F->{object_type} ) { + $F->{descriptionFR} = 'Logiciel imapsync. TOUS droits cédés, autorisés.' ; + $F->{descriptionEN} = '(Imapsync software. ALL rights conceded, allowed.)' ; + } + + if ( 'professional' eq $F->{client_type} + and 'software' eq $F->{object_type} ) { + $F->{usageFR} = 'Usage à titre professionnel.' ; + $F->{usageEN} = '(professional usage.)' ; + } + + if ( 'individual' eq $F->{client_type} + and 'software' eq $F->{object_type} ) { + $F->{usageFR} = 'Usage à titre individuel.' ; + $F->{usageEN} = '(individual usage.)' ; + } + + if ( 'support' eq $F->{object_type} ) { + $F->{usageFR} = 'Usage à titre professionnel.' ; + $F->{usageEN} = '(professional usage.)' ; + $F->{descriptionFR} = 'Support sur le logiciel imapsync.' ; + $F->{descriptionEN} = '(Imapsync support.)' ; + } + + if ( 'service' eq $F->{object_type} ) { + $F->{usageFR} = 'Usage à titre professionnel.' ; + $F->{usageEN} = '(professional usage.)' ; + $F->{descriptionFR} = 'Service en ligne avec le logiciel imapsync.' ; + $F->{descriptionEN} = '(Imapsync software online service.)' ; + } + + if ( 'professional' eq $F->{client_type} + and 'software + support' eq $F->{object_type} ) { + $F->{usageFR} = 'Usage à titre professionnel.' ; + $F->{usageEN} = '(professional usage.)' ; + $F->{descriptionFR} = 'Logiciel imapsync. TOUS droits cédés, autorisés.' ; + $F->{descriptionEN} = '(Imapsync software. ALL rights conceded, allowed.)' ; + $F->{descriptionBFR} = 'Support sur le logiciel imapsync.' ; + $F->{descriptionBEN} = '(Imapsync support.)' ; + $F->{quantityB} = '1' ; + } +} + + + +sub object_type { + my $F = shift ; + + $F->{object_type} = '' ; + + if ( 'imapsync' eq $F->{Titre_de_l_objet} + or 'imapsync.exe' eq $F->{Titre_de_l_objet} + or 'imapsync source' eq $F->{Titre_de_l_objet} + or 'imapsync source code' eq $F->{Titre_de_l_objet} + ) { + $F->{object_type} = 'software' ; + }elsif ( 'imapsync support' eq $F->{Titre_de_l_objet} ) { + $F->{object_type} = 'support' ; + }elsif ( ( 'imapsync all' eq $F->{Titre_de_l_objet} ) + and ( 'software only' eq $F->{Valeur_Option_1} ) ) { + $F->{object_type} = 'software' ; + }elsif ( ( 'imapsync all' eq $F->{Titre_de_l_objet} ) + and ( 'software + support' eq $F->{Valeur_Option_1} ) ) { + $F->{object_type} = 'software + support' ; + }elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} ) + and ( 'Software only. For professional use.' eq $F->{Valeur_Option_1} ) ) { + $F->{object_type} = 'software' ; + }elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} ) + and ( 'Software + Support. For professional use.' eq $F->{Valeur_Option_1} ) ) { + $F->{object_type} = 'software + support' ; + }elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} ) + and ( 'Software only. For individual use.' eq $F->{Valeur_Option_1} ) ) { + $F->{object_type} = 'software' ; + }elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} ) + and ( 'Support only. For professional use.' eq $F->{Valeur_Option_1} ) ) { + $F->{object_type} = 'support' ; + }elsif ( ( + 'imapsync any' eq $F->{Titre_de_l_objet} + or 'imapsync online' eq $F->{Titre_de_l_objet} + ) + and ( + ( 'Tiny' eq $F->{Valeur_Option_1} ) + or ( 'Small' eq $F->{Valeur_Option_1} ) + or ( 'Normal' eq $F->{Valeur_Option_1} ) + or ( 'High' eq $F->{Valeur_Option_1} ) + ) ) { + $F->{object_type} = 'service' ; + } +} + +sub build_email_message { + + my $F = shift ; + + object_type( $F ) ; + my $invoice = $F->{invoice} ; + + my $message_header = qq{X-imapsync: invoice $invoice for imapsync $F->{object_type} +From: Gilles LAMIRAL +Bcc: gilles\@lamiral.info +Subject: [imapsync invoice] $invoice ($F->{Hors_taxe_num} EUR on $F->{Date}) for imapsync $F->{object_type}. +Disposition-Notification-To: Gilles LAMIRAL +} ; + + + my $message_body = qq{ +Hello $F->{Nom}, + +First of all, I'm sorry for the delay in getting back to you. + +Last imapsync release is available from the page +https://imapsync.lamiral.info/paypal_return.shtml + +You're also free to use the online imapsync GUI as you wish: +https://imapsync.lamiral.info/X/ + +You'll find in the attachment the invoice of imapsync +$F->{object_type} that you bought and you paid (dd/mm/yyyy $F->{Date}). +The invoice file is named facture_imapsync-${invoice}.pdf +This invoice is in PDF format, ready to be print. + +Should you need a hard-copy of this invoice, +I'll send it to you upon request by regular mail. + +Once more, thank you for buying and using imapsync $F->{object_type}. + +Any feedback is welcome! +Best Regards. + +-- +Gilles Lamiral. +add: 22 La Billais 35580 Baulon, France +mob: +33 6 19 22 03 54 +fix: +33 9 51 84 42 42 +} ; + + + my $message_body_blabla = qq{ +Help me improving imapsync and its services via the pole +http://imapsync.lamiral.info/S/poll.shtml + +As the law requires, this numeric invoice PDF file +is signed with my private gpg key. + +The resulting gpg signature is in the file named +facture_imapsync-${invoice}.pdf.asc +you will also find in the attachment. + +You can check I (Gilles LAMIRAL) really did generate +this invoice with the following command line: + + gpg --verify facture_imapsync-${invoice}.pdf.asc facture_imapsync-${invoice}.pdf + +or any other gpg graphical tool. + +Here is the fingerprint of my public key +pub 1024D/FDA2B3DC 2002-05-08 + Key fingerprint = 7906 F53D 0D62 0C67 304A 4CF0 6928 869B FDA2 B3DC +uid Gilles LAMIRAL +sub 1024g/A2C4CB42 2002-05-08 + +Of course the verification doesn't prove anything until +all the following conditions are met: +- you met me, +- I agree that the fingerprint above is really mine +- I prove I'm Gilles LAMIRAL with an official paper. + +Normally we won't have to verify anything unless +I disagree with this invoice and the payment +you made for imapsync. +} ; + + $F->{email_message_header} = $message_header ; + $F->{email_message_body} = $message_body ; + return( ) ; + +} + +sub write_csv_info { + + my( $dir_invoices, $invoice, $file_csv, $line_number, $line_csv ) = @_ ; + + my $invoice_00000 = invoice_00000( $invoice ) ; + $debug and print "Writing $dir_invoices/$invoice_00000/csv_info.txt\n" ; + $dry and return( ) ; + + open( CSVINFO, "> $dir_invoices/$invoice_00000/csv_info.txt") or die ; + print CSVINFO join( "\n", $file_csv, $line_number, $line_csv ) ; + close( CSVINFO ) ; + +} + +sub invoice_sent { + + my ( $dir_invoices, $invoice, $email_address ) = @_ ; + my $invoice_00000 = invoice_00000( $invoice ) ; + return( 1 ) if ( -f "$dir_invoices/$invoice_00000/SENT_TO_$email_address" ) ; + return( 0 ) ; + +} + +sub write_email_message { + my ( $dir_invoices, $invoice, $message_header, $message_body, $email_address ) = @_ ; + + my $message_body_utf8 = Unicode::MapUTF8::to_utf8({ -string => $message_body, -charset => 'ISO-8859-1' }); + + my $invoice_00000 = invoice_00000( $invoice ) ; + + if ( ! -d "$dir_invoices/$invoice_00000" ) { + $debug and print "mkdir $dir_invoices/$invoice_00000\n" ; + $dry or mkdir( "$dir_invoices/$invoice_00000" ) or die ; + } + + $dry and return( ) ; + + open( HEADER, "> $dir_invoices/$invoice_00000/facture_message_header.txt") or die ; + print HEADER $message_header ; + close( HEADER ) ; + + open( BODY, "> $dir_invoices/$invoice_00000/facture_message_body.txt") or die ; + print BODY $message_body_utf8 ; + close( BODY ) ; + + open( ADDRESS, "> $dir_invoices/$invoice_00000/email_address.txt") or die ; + print ADDRESS "$email_address\n" ; + close( ADDRESS ) ; +} + + +sub write_tex_variables_file { + my ( $dir_invoices, $invoice, $Date, $tex_variables_utf8, $tex_variables ) = @_ ; + + my $invoice_00000 = invoice_00000( $invoice ) ; + + if ( ! -d "$dir_invoices/$invoice_00000" ) { + $debug and print "mkdir $dir_invoices/$invoice_00000\n" ; + $dry or mkdir( "$dir_invoices/$invoice_00000" ) or die ; + } + + $debug and print "Writing imapsync_var.tex $dir_invoices/$invoice_00000/imapsync_var.tex\n" ; + $dry and return( ) ; + + # original input + open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_latin1.tex") or die ; + print FILE $tex_variables ; + close( FILE ) ; + + # utf8 conversion + open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_utf8.tex") or die ; + print FILE $tex_variables_utf8 ; + close( FILE ) ; + + system( "cat $dir_invoices/$invoice_00000/imapsync_var_latin1.tex | 8859_utf8 > $dir_invoices/$invoice_00000/imapsync_var.tex" ) ; + + if ( ! -f "$dir_invoices/$invoice_00000/imapsync_var_manual.tex" ) { + system( "cp $dir_invoices/$invoice_00000/imapsync_var.tex $dir_invoices/$invoice_00000/imapsync_var_manual.tex" ) ; + } +} + +sub download_urls { + my $F = shift ; + + $F->{date_aaaa_mm_jj} = date_aaaa_mm_jj( $F->{Date} ) ; + + if ( '2014_04_13' le $F->{date_aaaa_mm_jj} + and ( + ( 'software' eq $F->{object_type} ) + or + ( 'software + support' eq $F->{object_type} ) + or + ( 'support' eq $F->{object_type} ) + or + ( 'service' eq $F->{object_type} ) + ) + ) { + $F->{urlSrc} = 'http://imapsync.lamiral.info/paypal_return.shtml' ; + $F->{urlExe} = '' ; + return( ) ; + } + + if ('2011_05_01' le $F->{date_aaaa_mm_jj} + and 'software' eq $F->{object_type} ) { + $F->{urlSrc} = 'http://ks.lamiral.info/imapsync/paypal_return.shtml' ; + $F->{urlExe} = '' ; + return( ) ; + } + + if ('2011_05_01' le $F->{date_aaaa_mm_jj} + and 'support' eq $F->{object_type} ) { + $F->{urlSrc} = 'http://ks.lamiral.info/imapsync/paypal_return_support.shtml' ; + $F->{urlExe} = '' ; + return( ) ; + } + + if ('2011_03_24' le $F->{date_aaaa_mm_jj}) { + $F->{urlSrc} = 'http://www.linux-france.org/prj/imapsync/paypal_return.shtml' ; + $F->{urlExe} = '' ; + return( ) ; + } + if ('2011_02_21' le $F->{date_aaaa_mm_jj}) { + $F->{urlSrc} = 'http://www.linux-france.org/depot/2011_02_21/OUMbo7/' ; + $F->{urlExe} = 'http://www.linux-france.org/depot/2011_02_21/rHSVNs/' ; + return( ) ; + } + if ('2011_01_18' le $F->{date_aaaa_mm_jj}) { + $F->{urlSrc} = 'http://www.linux-france.org/depot/2011_01_18/zPRRNt/' ; + $F->{urlExe} = 'http://www.linux-france.org/depot/2011_01_18/FO1QzG/' ; + return( ) ; + } + if ('2011_01_18' le $F->{date_aaaa_mm_jj}) { + $F->{urlSrc} = 'http://www.linux-france.org/depot/2010_11_28/SiNdlZ/' ; + $F->{urlExe} = 'http://www.linux-france.org/depot/2010_11_28/R3ZAyr/' ; + return( ) ; + } + $F->{urlSrc} = 'http://www.linux-france.org/depot/2010_11_08/X2PWMe/' ; + $F->{urlExe} = 'http://www.linux-france.org/depot/2010_11_08/ZZ7zSc/' ; + return( ) ; +} + +sub date_aaaa_mm_jj { + my $date_jjSmmSaaaa = shift ; + + if ( $date_jjSmmSaaaa =~ m{(\d\d)/(\d\d)/(\d\d\d\d)} ) { + my( $jj, $mm, $aaaa ) = ( $1, $2, $3 ) ; + return( join( '_', $aaaa, $mm, $jj ) ) ; + }else{ + return( '9999_12_31' ) ; + } +} + + +sub tva_rate { + my $date_aaaa_mm_jj = shift ; + + if ( '2014_01_01' gt $date_aaaa_mm_jj ) { + #print "tva_rate 0.196\n" ; + #return( 0 ) ; + return( 0.196 ) ; + } + + if ( '2014_01_01' le $date_aaaa_mm_jj ) { + #print "tva_rate 0.2\n" ; + return( 0.2 ) ; + } + #print "tva_rate 0\n" ; + return( 0 ) ; +} + +sub tests_tva_rate { + ok( 0.196 == tva_rate( '2013_01_01' ), 'tva_rate: old 0.196' ) ; + ok( 0.196 == tva_rate( '2013_12_31' ), 'tva_rate: old 0.196' ) ; + ok( 0.2 == tva_rate( '2014_01_01' ), 'tva_rate: new 0.2' ) ; + ok( 0.2 == tva_rate( '2014_12_31' ), 'tva_rate: new 0.2' ) ; + ok( 0.2 == tva_rate( '2050_01_01' ), 'tva_rate: new 0.2' ) ; + ok( 0.2 == tva_rate( '2050_12_31' ), 'tva_rate: new 0.2' ) ; + return( 0 ) ; +} + + +sub tva_rate_str { + my $date_aaaa_mm_jj = shift ; + + if ( '2014_01_01' gt $date_aaaa_mm_jj ) { + #print "tva_rate 0.196\n" ; + return( '19,60\%' ) ; + } + + if ( '2014_01_01' le $date_aaaa_mm_jj ) { + return( '20\%' ) ; + } + #print "tva_rate 0\n" ; + return( '' ) ; +} + +sub tests_tva_rate_str { + ok( '19,60\%' eq tva_rate_str( '2013_01_01' ), 'tva_rate_str: old 0.196' ) ; + ok( '19,60\%' eq tva_rate_str( '2013_12_31' ), 'tva_rate_str: old 0.196' ) ; + ok( '20\%' eq tva_rate_str( '2014_01_01' ), 'tva_rate_str: new 0.2' ) ; + ok( '20\%' eq tva_rate_str( '2014_12_31' ), 'tva_rate_str: new 0.2' ) ; + ok( '20\%' eq tva_rate_str( '2050_01_01' ), 'tva_rate_str: new 0.2' ) ; + ok( '20\%' eq tva_rate_str( '2050_12_31' ), 'tva_rate_str: new 0.2' ) ; + return( 0 ) ; +} + + +sub software_price { + my $date_aaaa_mm_jj = shift ; + + if ( '2014_01_01' le $date_aaaa_mm_jj ) { + return( 50 ) ; + } + return( 0 ) ; +} + + +sub tests_software_price { + ok( 50 == software_price( '2014_01_01' ), 'software_price: 2014_01_01 => 50 ' ) ; + ok( 0 == software_price( '2000_01_01' ), 'software_price: 2000_01_01 => 0' ) ; + return( 0 ) ; +} + +sub tva_line_one_button_for_the_software { + + my $A = shift ; + + if ( 'imapsync' eq $A->{Titre_de_l_objet} + or 'imapsync.exe' eq $A->{Titre_de_l_objet} + or 'imapsync source' eq $A->{Titre_de_l_objet} + or 'imapsync source code' eq $A->{Titre_de_l_objet} + + ) { + if ( 'TAXED' eq $A->{vat_type} ) { + $A->{montant_HT_EUR_logi_ass} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + $A->{montant_TVA_EUR_logi} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; + }else{ + $A->{montant_HT_EUR_logi_exo} = $A->{Montant2} ; + } + } + +} + +sub tva_line_one_button_for_the_support { + + my $A = shift ; + + if ( 'support' eq $A->{object_type} ) { + if ( + ( 'TAXED' eq $A->{vat_type} ) + or + ( '2013_02_19' gt $A->{date_aaaa_mm_jj} ) + ) + { + $A->{montant_HT_EUR_sup} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + $A->{montant_TVA_EUR_sup} = $A->{Montant2} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; + }else{ + $A->{montant_HT_EUR_sup_exo} = $A->{Montant2} ; + } + } +} + +sub button_type { + my $A = shift ; + + if ( + 'imapsync all' eq $A->{Titre_de_l_objet} + or + 'imapsync any' eq $A->{Titre_de_l_objet} + ) { + $A->{button_type} = 'mixed' ; + }else{ + $A->{button_type} = 'single' ; + } +} + +sub tva_line_one_button_for_support_and_software { + + my $A = shift ; + + $A->{Montant2_logi} = software_price( $A->{date_aaaa_mm_jj} ) ; + $A->{Montant2_supp} = $A->{Montant2} - $A->{Montant2_logi} ; + + if ( 'mixed' eq $A->{button_type} ) { + if ( 'TAXED' eq $A->{vat_type} ) { + $A->{montant_HT_EUR_sup} = $A->{Montant2_supp} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + $A->{montant_TVA_EUR_sup} = $A->{Montant2_supp} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; + $A->{montant_HT_EUR_logi_ass} = $A->{Montant2_logi} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) ; + $A->{montant_TVA_EUR_logi} = $A->{Montant2_logi} / ( 1 + tva_rate( $A->{date_aaaa_mm_jj} ) ) * tva_rate( $A->{date_aaaa_mm_jj} ) ; + }else{ + $A->{montant_HT_EUR_logi_exo} = $A->{Montant2_logi} ; + $A->{montant_HT_EUR_sup_exo} = $A->{Montant2_supp} ; + } + } +} + + +sub tva_line { + + my $A = shift ; + + $A->{montant_HT_EUR_logi_exo} = $A->{montant_HT_EUR_logi_ass} = $A->{montant_TVA_EUR_logi} = 0 ; + $A->{montant_HT_EUR_sup} = $A->{montant_TVA_EUR_sup} = $A->{montant_HT_EUR_sup_exo} = 0 ; + + $A->{date_aaaa_mm_jj} = date_aaaa_mm_jj( $A->{Date} ) ; + clientVAT( $A ) ; + client_type( $A ) ; + object_type( $A ) ; + button_type( $A ) ; + vat_type( $A ) ; + $A->{Montant2} = $A->{Montant2}/$usdeur if 'USD' eq $A->{Devise} ; + + tva_line_one_button_for_the_software( $A ) ; + tva_line_one_button_for_the_support( $A ) ; + tva_line_one_button_for_support_and_software( $A ) ; + return ; +} + +sub vat_type { + my $F = shift ; + + if ( + ( 'individual' eq $F->{client_type} ) + or ( 'France' eq $F->{Pays} ) + ) { + $F->{vat_type} = 'TAXED' ; + }else{ + $F->{vat_type} = 'EXEMPT' ; + } + return ; + +} + +sub clientVAT { + + my $F = shift ; + $F->{clientVAT} = '' ; + + if ( + ( 'VAT if professional in Europe' eq $F->{Nom_Option_2} ) + and ( $F->{Option_2_Valeur} ) + and ( $F->{Option_2_Valeur} !~ /^\s+$/ ) + and ( 'N/A' ne $F->{Option_2_Valeur} ) + ) { + $F->{clientVAT} = $F->{Option_2_Valeur} ; + } + return ; +} + + +sub tva_stuff_one_button_for_support_xor_software { + + my $F = shift ; + + if ( not ( 'software' eq $F->{object_type} + or 'support' eq $F->{object_type} + or 'service' eq $F->{object_type} + ) ) { + return( ) ; + } + + + if ( 'TAXED' eq $F->{vat_type} ) { + $F->{priceHT} = sprintf('%2.2f', $F->{Hors_taxe} / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) ) ; + $F->{priceBHT} = '' ; + $F->{priceZHT} = $F->{priceHT} ; + $F->{tvaFR} = tva_rate_str( $F->{date_aaaa_mm_jj} ) ; + $F->{priceZTVA} = sprintf('%2.2f', $F->{Hors_taxe} / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) * tva_rate( $F->{date_aaaa_mm_jj} ) ) ; + $F->{priceZTTC} = sprintf('%2.2f', $F->{Hors_taxe}) ; + $F->{HTorTTC} = 'TTC' ; + $F->{messageTVAFR} = '' ; + $F->{messageTVAEN} = '' ; + }else{ + $F->{priceHT} = sprintf('%2.2f', $F->{Hors_taxe}) ; + $F->{priceBHT} = '' ; + $F->{priceZHT} = $F->{priceHT} ; + $F->{tvaFR} = '' ; + $F->{priceZTVA} = 'néant (none)' ; + $F->{priceZTTC} = $F->{priceHT} ; + $F->{HTorTTC} = 'HT' ; + $F->{messageTVAFR} = 'Exonération de TVA, articles 259 et 262 du Code Général des Impôts'; + $F->{messageTVAEN} = '(VAT tax-exempt, articles 259 and 262 of French General Tax Code)'; + } + + foreach my $price ( $F->{priceHT}, $F->{priceBHT}, $F->{priceZHT}, + $F->{priceZTVA}, $F->{priceZTTC} ) { + $price =~ s{\.}{, } ; + } + + return ; +} + +sub tva_stuff_one_button_for_support_and_software { + + my $F = shift ; + + if ( not ( 'software + support' eq $F->{object_type} ) ) { + return( ) ; + } + + # Default values + $F->{priceHT} = '' ; + $F->{priceBHT} = '' ; + $F->{priceZHT} = '' ; + $F->{tvaFR} = '' ; + $F->{priceZTVA} = '' ; + $F->{priceZTTC} = '' ; + $F->{HTorTTC} = '' ; + $F->{messageTVAFR} = '' ; + $F->{messageTVAEN} = '' ; + + # Now the stuff + my $amountZ = $F->{Hors_taxe} ; + my $amountA = software_price( $F->{date_aaaa_mm_jj} ) ; + my $amountB = $amountZ - $amountA ; + + if ( 'TAXED' eq $F->{vat_type} ) { + $F->{priceHT} = sprintf('%2.2f', $amountA / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) ) ; + $F->{priceBHT} = sprintf('%2.2f', $amountB / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) ) ; + $F->{priceZHT} = $F->{Hors_taxe} ; + $F->{tvaFR} = tva_rate_str( $F->{date_aaaa_mm_jj} ) ; + $F->{priceZTVA} = sprintf('%2.2f', $F->{Hors_taxe} / ( 1 + tva_rate( $F->{date_aaaa_mm_jj} ) ) * tva_rate( $F->{date_aaaa_mm_jj} ) ) ; + $F->{priceZTTC} = sprintf('%2.2f', $F->{Hors_taxe}) ; + $F->{HTorTTC} = 'TTC' ; + $F->{messageTVAFR} = '' ; + $F->{messageTVAEN} = '' ; + }else{ + $F->{priceHT} = sprintf('%2.2f', $amountA ) ; + $F->{priceBHT} = sprintf('%2.2f', $amountB ) ; + $F->{priceZHT} = $F->{Hors_taxe} ; + $F->{tvaFR} = '' ; + $F->{priceZTVA} = 'néant (none)' ; + $F->{priceZTTC} = $F->{Hors_taxe} ; + $F->{HTorTTC} = 'HT' ; + $F->{messageTVAFR} = 'Exonération de TVA, articles 259 et 262 du Code Général des Impôts'; + $F->{messageTVAEN} = '(VAT tax-exempt, articles 259 and 262 of French General Tax Code)'; + } + + foreach my $price ( $F->{priceHT}, $F->{priceBHT}, $F->{priceZHT}, + $F->{priceZTVA}, $F->{priceZTTC} ) { + $price =~ s{\.}{, } ; + } + + return( ) ; +} + + + +sub tva_stuff { + my $F = shift ; + + $F->{priceTTCusd} = '' ; + $F->{Hors_taxe} =~ s{,}{.} ; + + tva_stuff_one_button_for_support_xor_software( $F ) ; + tva_stuff_one_button_for_support_and_software( $F ) ; + return( ) ; +} + +sub client_type { + my $F = shift ; + #print "$F->{date_aaaa_mm_jj} $F->{Date}\n" ; + + + # Default to professional + $F->{client_type} = 'professional' ; + $F->{clientTypeEN} = 'professional' ; + $F->{clientTypeFR} = 'professionnel' ; + + # Otherwise + if ('imapsync usage' eq $F->{Nom_Option_1} and 'individual' eq $F->{Valeur_Option_1} ) { + $F->{client_type} = 'individual' ; + $F->{clientTypeEN} = 'individual' ; + $F->{clientTypeFR} = 'individuel' ; + }elsif ('imapsync usage' eq $F->{Nom_Option_1} and 'professional' eq $F->{Valeur_Option_1} ) { + $F->{client_type} = 'professional' ; + $F->{clientTypeEN} = 'professional' ; + $F->{clientTypeFR} = 'professionnel' ; + }elsif('usage' eq $F->{Nom_Option_2} and 'individual' eq $F->{Option_2_Valeur} ) { + $F->{client_type} = 'individual' ; + $F->{clientTypeEN} = 'individual' ; + $F->{clientTypeFR} = 'individuel' ; + }elsif ( + 'imapsync choice' eq $F->{Nom_Option_1} + and ( $F->{Valeur_Option_1} =~ /individual/ ) + and ( '2016_10_01' le $F->{date_aaaa_mm_jj} ) + and ( not $F->{clientVAT} ) + + ) { + $F->{client_type} = 'individual' ; + $F->{clientTypeEN} = 'individual' ; + $F->{clientTypeFR} = 'individuel' ; + } + + return( ) ; +} + +sub build_address { + my $F = shift ; + + my $addr = " +=========================================================== +Nom $F->{Nom} +Adresse_1 $F->{Adresse_1} +Adresse_2_district_quartier $F->{Adresse_2_district_quartier} +Ville Code_postal $F->{Ville} $F->{Code_postal} +Etat_Province $F->{Etat_Province} +Pays $F->{Pays} +" ; + #print $addr ; + + my @address ; + $F->{Nom} = '' if ( $F->{Nom} =~ m/^\s+$/ ) ; + my( $Nom1, $Nom2 ) = cut( $F->{Nom}, 42 ) ; + push( @address, $Nom1 ) if $Nom1 ; + #push( @address, $Nom2 ) if $Nom2 ; + push( @address, $F->{Adresse_1} ) if $F->{Adresse_1} ; + push( @address, $F->{Adresse_2_district_quartier} ) if $F->{Adresse_2_district_quartier} ; + push( @address, "$F->{Ville} $F->{Code_postal}" ) if ( $F->{Ville} or $F->{Code_postal} ) ; + push( @address, $F->{Etat_Province} ) if $F->{Etat_Province} ; + push( @address, $F->{Pays}, ) if $F->{Pays} ; + + + $F->{clientAdrA} = shift( @address ) || '' ; + $F->{clientAdrB} = shift( @address ) || '' ; + $F->{clientAdrC} = shift( @address ) || '' ; + $F->{clientAdrD} = shift( @address ) || '' ; + $F->{clientAdrE} = shift( @address ) || '' ; + $F->{clientAdrF} = shift( @address ) || '' ; + + return( ) ; +} + + +sub cut { + my $string = shift ; + my $offset = shift ; + return( $string, '' ) if length( $string ) < $offset ; + my $first = substr( $string, 0, $offset ) ; + my $last = substr( $string, $offset ) ; + + return( $first, $last ) ; +} + +sub tests_cut { + my( $aa, $bb ) = cut("123456789", 4 ) ; + ok( '1234' eq $aa, 'cut 123456789 4 => first 1234' ) ; + ok( '56789' eq $bb, 'cut 123456789 4 => last 56789' ) ; +} diff --git a/W/paypal_reply/paypal_build_invoices b/W/paypal_reply/paypal_build_invoices index 524763b..b957184 100755 --- a/W/paypal_reply/paypal_build_invoices +++ b/W/paypal_reply/paypal_build_invoices @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: paypal_build_invoices,v 1.111 2016/08/09 02:10:07 gilles Exp gilles $ +# $Id: paypal_build_invoices,v 1.139 2017/09/09 19:31:54 gilles Exp gilles $ # usage: sh paypal_build_invoices /g/var/paypal_invoices/???? @@ -79,9 +79,29 @@ cp /home/gilles/public_html/AGIL/factures/000/facture_imapsync-000.tex /g/var/pa #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4860 /g/paypal/paypal_2016_05_complet.csv #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4931 /g/paypal/paypal_2016_06_complet.csv #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5009 /g/paypal/paypal_2016_07_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5081 /g/paypal/paypal_2016_08_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5147 /g/paypal/paypal_2016_09_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5216 /g/paypal/paypal_2016_10_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5216 /g/paypal/paypal_2016_10_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5276 /g/paypal/paypal_2016_11_complet.csv +# Two bank transfer in 2016_12 +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5355 /g/paypal/virements_2016_12_06.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5338 --avoid_numbers '5355' /g/paypal/paypal_2016_12_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5406 /g/paypal/virements_2016_12_31.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5407 /g/paypal/paypal_2017_01_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5490 /g/paypal/paypal_2017_02_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5558 /g/paypal/paypal_2017_03_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5651 /g/paypal/paypal_2017_04_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5714 /g/paypal/paypal_2017_05_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5780 /g/paypal/paypal_2017_06_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5833 /g/paypal/paypal_2017_07_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5903 /g/paypal/paypal_2017_08_complet.csv set -x -/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5081 /g/paypal/paypal_2016_08_complet.csv +/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 5978 /g/paypal/paypal_2017_09_complet.csv + + + set +x @@ -155,10 +175,26 @@ set +x : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4776 /g/paypal/paypal_2016_04_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4860 /g/paypal/paypal_2016_05_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4931 /g/paypal/paypal_2016_06_complet.csv - -set -x : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5009 /g/paypal/paypal_2016_07_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5081 /g/paypal/paypal_2016_08_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5147 /g/paypal/paypal_2016_09_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5216 /g/paypal/paypal_2016_10_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5276 /g/paypal/paypal_2016_11_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5355 /g/paypal/virements_2016_12_06.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5338 --avoid_numbers '5355' /g/paypal/paypal_2016_12_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5406 /g/paypal/virements_2016_12_31.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5407 /g/paypal/paypal_2017_01_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5490 /g/paypal/paypal_2017_02_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5558 /g/paypal/paypal_2017_03_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5651 /g/paypal/paypal_2017_04_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5714 /g/paypal/paypal_2017_05_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5780 /g/paypal/paypal_2017_06_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5833 /g/paypal/paypal_2017_07_complet.csv +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5903 /g/paypal/paypal_2017_08_complet.csv + +set -x +# TVA a faire +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 5978 /g/paypal/paypal_2017_09_complet.csv set +x # La totale @@ -169,7 +205,8 @@ set +x 2295 2296 2297 2298 2625 2626 2970 2971 2972 3093 3296 3411 3412 3450 3451 3614 3615 3616 3617 3807 3808 3957 3958 4030 4194 4195 4381 4382 4449 4450 -4574 4641' \ +4574 4641 5213 5214 5215 5355 5406 +5489 5650' \ /g/paypal/paypal_201?_??_complet.csv #set -v @@ -179,14 +216,23 @@ set +x 2295 2296 2297 2298 2625 2626 2970 2971 2972 3093 3296 3411 3412 3450 3451 3614 3615 3616 3617 3807 3808 3957 3958 4030 4194 4195 4381 4382 4449 4450 -4574 4641' \ +4574 4641 5213 5214 5215 5355 5406 +5489 5650' \ /g/paypal/paypal_201?_??_complet.csv #set +v -#echo 2016 : ( from 4574 to ???? ) EUR +#echo 2017 : ( from 5407 to ???? ) EUR #set -v : /g/public_html/imapsync/W/paypal_reply/paypal_bilan \ - --first_in 4575 --avoid_numbers '4574 4641' \ + --first_in 5407 --avoid_numbers '5489 5650' \ + /g/paypal/paypal_2017_??_complet.csv +#set +v + + +#echo 2016 : ( from 4574 to 5406 ) EUR +#set -v +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --first_in 4575 --avoid_numbers '4574 4641 5213 5214 5215 5355 5406' \ /g/paypal/paypal_2016_??_complet.csv #set +v @@ -230,14 +276,15 @@ set +x echo 'sh paypal_build_invoices /g/var/paypal_invoices/5???' -# USD de 147 \E0 340 -# EUR de 341 \E0 ... +# USD de 147 a 340 +# EUR de 341 a ... # 20110413 Found problems with 189 199 249 258 263 359 537 # 20110412 Found problems with 189 199 242 249 258 263 359 382 537 # cen cen JAP cen cen cen cen TCH JAP # cen + for d in "$@"; do echo "==== $d ====" cd $d @@ -265,7 +312,7 @@ for d in "$@"; do continue fi fi - gpg --use-agent --armor --detach-sign --yes facture_imapsync-$bd.pdf + #gpg --use-agent --armor --detach-sign --yes facture_imapsync-$bd.pdf done echo "Found problems with $PB_LIST" diff --git a/W/paypal_reply/paypal_build_reply b/W/paypal_reply/paypal_build_reply index 21a6636..955de92 100755 --- a/W/paypal_reply/paypal_build_reply +++ b/W/paypal_reply/paypal_build_reply @@ -1,6 +1,6 @@ #!/usr/bin/perl -# $Id: paypal_build_reply,v 1.29 2016/08/18 09:48:27 gilles Exp gilles $ +# $Id: paypal_build_reply,v 1.33 2017/07/03 22:49:06 gilles Exp gilles $ use warnings; use strict; @@ -11,7 +11,7 @@ my ($amount, $name, $email); my ( $paypal_line, $paypal_info, $buyer, $description, $object, - $url, $release, $release_exe, + $release, $release_exe, ); my $help ; @@ -32,22 +32,20 @@ $release = firstline( '/g/public_html/imapsync/VERSION' ) ; $release_exe = firstline( '/g/public_html/imapsync/VERSION_EXE' ) ; #my $path_last = firstline( '/g/public_html/imapsync/dist/path_last.txt' ) ; -$url = "http://ks.lamiral.info/imapsync/dist/" ; - $debug and print "Hi!\n" ; my @input = <> ; while( my $line = shift @input ) { - next if ( $line !~ /^(.*Num.+ro de transaction.*)$/ ); + next if ( $line !~ /^(.*de transaction.*)$/ ); $paypal_line = $1; $paypal_info = "===== Paypal id =====\n$paypal_line\n"; $debug and print "$paypal_info" ; last; } while( my $line = shift @input ) { - if ( $line =~ /^Vous avez re.*paiement d'un montant de (.*) de la part de (.*) \((.*)\)/) { + if ( $line =~ /^Vous avez re.*paiement d'un montant de (.*) de la part de (.*) ?\((.*)\)/) { ($amount, $name, $email) = ($1, $2, $3); $debug and print "1 ($amount, $name, $email)\n" ; last; @@ -78,11 +76,20 @@ while( my $line = shift @input ) { $debug and print "2 $buyer\n" ; last; } + if ( $line =~ /^"Informations sur l'acheteur :"/ ) { + $buyer .= "===== Acheteur =====\n"; + shift @input ; + chomp( $name = shift @input ); + $buyer .= "$name\n" ; + $debug and print "2 $buyer\n" ; + last; + } + } while( my $line = shift @input ) { - $buyer .= $line if ( $line !~ /^-----------------------------------/ ); - last if ( $line =~ /^-----------------------------------/ ); + $buyer .= $line if ( ( $line !~ /^-----------------------------------/ ) and ( $line !~ /^Veuillez conserver ce num/ ) ); + last if ( ( $line =~ /^-----------------------------------/ ) or ( $line =~ /^Veuillez conserver ce num/ ) or ( $line =~ /tails de l'achat/) ) ; } $debug and print "3 $buyer\n" ; @@ -107,53 +114,65 @@ while( my $line = shift @input ) { my $address = 'gilles.lamiral@laposte.net'; my $address2 = 'gilles@lamiral.info'; -my $rcstag = '$Id: paypal_build_reply,v 1.29 2016/08/18 09:48:27 gilles Exp gilles $'; +my $rcstag = '$Id: paypal_build_reply,v 1.33 2017/07/03 22:49:06 gilles Exp gilles $'; -my $download_info = "You will find the latest imapsync.exe binary (release $release_exe) -and the latest imapsync source code (release $release) at the following link: -$url" ; - -my $next_releases = -"Next imapsync releases will be available to you for lifetime without extra payment. - -You are subscribed to a newsletter [imapsync_update] announcing new releases. -Just keep this message and ask for the new links in case you miss the newsletter. -Ask me to be unsubscribed, you can also do it yourself at -http://lists.lamiral.info/cgi-bin/mailman/listinfo/imapsync_update - -Run imapsync without any argument to know if a new release is available. -A permanent link to last release is http://imapsync.lamiral.info/paypal_return.shtml -also written on the invoice you'll receive soon, I edit invoices once a week or on demand." ; - -my $support_info = 'For imapsync professional support, +my $contact = +q{ +For imapsync professional support or any other request, contact me (Gilles LAMIRAL) by email or phone at: -Email address: gilles.lamiral@laposte.net. -Professionnal phone number: +33 9 51 84 42 42 (France) -Mobile phone number: +33 6 19 22 03 54 (France, SFR operator). +Email address: gilles.lamiral@laposte.net +Mobile phone number: +33 6 19 22 03 54 (France, SFR operator) +Professionnal phone number: +33 9 51 84 42 42 (France, Free operator) +} ; -I can call you back toll-free in many countries on landline telephone numbers -and to mobile numbers in the United States and France. So do not hesitate -to send me a note if you need vocal support.' ; +my $download_info = +qq{ +Software users, you will find the latest stable imapsync software +(release $release) at the following link: +https://imapsync.lamiral.info/dist/ +Next imapsync releases will be available to you for lifetime without +extra payment. To know if a new release is available, just +run imapsync with no arguments or look at the end of any logfile. +} ; + +my $online_info = +q{ +Online users, the imapsync service is at +https://imapsync.lamiral.info/X/ +Don't hesitate to drop me a note in case of problems or +clarifications about this online visual interface. +} ; + +my $newsletter = +q{ +As a buyer, you are also subscribed to a very low traffic newsletter +called [imapsync_update], announcing new releases or new services. +You might have reveived a welcome email message from the list manager, +telling you how to unsubscribe by yourself at +http://lists.lamiral.info/cgi-bin/mailman/listinfo/imapsync_update +In any case, you can also ask me to unsubscribe you, as +it's often frustrating to deal with unsubscriptions. + +} ; -my $thanks_software = "I thank you for buying and using imapsync, -I wish you successful transfers!" ; +my $thanks = +q{ +I thank you for buying and using imapsync services or products, +I wish you very successful transfers! +You will receive an invoice soon. +} ; -my $text_software = "$download_info\n -$next_releases\n -$support_info\n -You will receive an invoice soon.\n -$thanks_software" ; +my $text = $thanks +. $contact +. $download_info +. $online_info +. $newsletter +; -my $subject_software = "[imapsync download] imapsync release $release [$amount_ascii from $email]" ; - -my $subject ; - -my $text ; -$text = $text_software ; -$subject = $subject_software ; +my $subject = "[imapsync download/support/online] imapsync payment done [$amount_ascii from $email]" ; @@ -162,7 +181,7 @@ X-Comment: $rcstag In-Reply-To: $msg_id From: Gilles LAMIRAL <$address> To: <$email> -Bcc: Gilles LAMIRAL <$address>, <$address2> +Cc: Gilles LAMIRAL <$address>, <$address2> Subject: $subject Hello $name, diff --git a/W/paypal_reply/paypal_functions b/W/paypal_reply/paypal_functions index 06f9f5c..e7d5d48 100755 --- a/W/paypal_reply/paypal_functions +++ b/W/paypal_reply/paypal_functions @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: paypal_functions,v 1.21 2013/08/21 21:46:16 gilles Exp gilles $ +# $Id: paypal_functions,v 1.23 2017/03/28 10:41:55 gilles Exp gilles $ paypal_prerequisites() { perl -mMIME::Lite -e '' || echo 'sudo aptitude install libmime-lite-perl' @@ -38,7 +38,7 @@ paypal_init_petite_dev() { passfile=/g/var/pass/secret.gilles_mbox host=p tmpdir=/g/var/paypal_reply_dev - folder='INBOX.03_imapsync_less.imapsync_paypal_dev' + folder='INBOX.03_imapsync_less.imapsync_paypal_dev_tmp' } diff --git a/W/paypal_reply/paypal_imapget b/W/paypal_reply/paypal_imapget index 39c59e5..14b5bbf 100755 --- a/W/paypal_reply/paypal_imapget +++ b/W/paypal_reply/paypal_imapget @@ -1,6 +1,6 @@ #!/usr/bin/perl -w -# $Id: paypal_imapget,v 1.10 2013/08/21 22:19:35 gilles Exp gilles $ +# $Id: paypal_imapget,v 1.13 2017/03/28 10:41:36 gilles Exp gilles $ use Getopt::Long; use Mail::IMAPClient; @@ -59,7 +59,14 @@ print "@search\n" ; my @uids_01 = $imap->search('HEADER', 'Return-Path','', @search ); my @uids_02 = $imap->search('HEADER', 'Return-Path','', @search ); my @uids_03 = $imap->search('HEADER', 'Return-Path','', @search ); -my @uids = ( @uids_01, @uids_02, @uids_03 ) ; +my @uids_04 = $imap->search('HEADER', 'X-Email-Type-Id','PPX001033' ) ; +my @uids_05 = $imap->search('HEADER', 'X-Email-Type-Id','PPX001069' ) ; +my @uids_06 = $imap->search('HEADER', 'X-Email-Type-Id','PP341' ) ; + +# New on 18 oct 2016 03:24:42 CEST +# Return-Path: +# X-Email-Type-Id: PPX001033 +my @uids = ( @uids_01, @uids_02, @uids_03, @uids_04, @uids_05, @uids_06 ) ; print "Search: [@uids]\n"; foreach $msg (@uids) { diff --git a/W/paypal_reply/paypal_run_dev b/W/paypal_reply/paypal_run_dev index ee58817..0506c21 100755 --- a/W/paypal_reply/paypal_run_dev +++ b/W/paypal_reply/paypal_run_dev @@ -1,13 +1,13 @@ #!/bin/sh -# $Id: paypal_run_dev,v 1.10 2014/03/31 09:19:43 gilles Exp gilles $ +# $Id: paypal_run_dev,v 1.12 2017/02/27 04:41:36 gilles Exp gilles $ set -e #set -x # Add path to commands at home PATH=$PATH:/g/public_html/imapsync/W/paypal_reply -PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.35/lib +PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.39/lib export PERL5LIB test -f /g/public_html/imapsync/W/paypal_reply/paypal_functions \ diff --git a/W/paypal_reply/paypal_run_laposte b/W/paypal_reply/paypal_run_laposte index ff60be3..ec3e276 100755 --- a/W/paypal_reply/paypal_run_laposte +++ b/W/paypal_reply/paypal_run_laposte @@ -1,13 +1,13 @@ #!/bin/sh -# $Id: paypal_run_laposte,v 1.8 2015/03/09 17:48:48 gilles Exp gilles $ +# $Id: paypal_run_laposte,v 1.10 2017/02/27 04:41:36 gilles Exp gilles $ set -e #set -x # Add path to commands at home PATH=$PATH:/g/public_html/imapsync/W/paypal_reply -PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.35/lib +PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.39/lib export PERL5LIB test -f /g/public_html/imapsync/W/paypal_reply/paypal_functions \ diff --git a/W/paypal_reply/paypal_run_petite b/W/paypal_reply/paypal_run_petite index 5e268f4..f86cff3 100755 --- a/W/paypal_reply/paypal_run_petite +++ b/W/paypal_reply/paypal_run_petite @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: paypal_run_petite,v 1.6 2013/02/08 14:57:59 gilles Exp gilles $ +# $Id: paypal_run_petite,v 1.8 2017/02/27 04:41:36 gilles Exp gilles $ set -e #set -x @@ -8,7 +8,7 @@ set -e # Add path to commands at home PATH=$PATH:/g/public_html/imapsync/W/paypal_reply -PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.35/lib +PERL5LIB=/g/public_html/imapsync/W/Mail-IMAPClient-3.39/lib export PERL5LIB test -f /g/public_html/imapsync/W/paypal_reply/paypal_functions \ diff --git a/W/paypal_reply/paypal_send_invoices b/W/paypal_reply/paypal_send_invoices index 2d45846..294537b 100755 --- a/W/paypal_reply/paypal_send_invoices +++ b/W/paypal_reply/paypal_send_invoices @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: paypal_send_invoices,v 1.14 2015/02/04 11:36:26 gilles Exp gilles $ +# $Id: paypal_send_invoices,v 1.15 2017/02/02 02:23:48 gilles Exp gilles $ # usages: # sh paypal_send_invoices /g/var/paypal_invoices/147 @@ -21,7 +21,7 @@ send_invoice() { continue fi test -f facture_imapsync-${invoice}.pdf || { echo NO facture_imapsync-${invoice}.pdf ; return; } - test -f facture_imapsync-${invoice}.pdf.asc || { echo NO facture_imapsync-${invoice}.pdf.asc ; return; } + #test -f facture_imapsync-${invoice}.pdf.asc || { echo NO facture_imapsync-${invoice}.pdf.asc ; return; } test -f facture_message_header.txt || { echo NO facture_message_header.txt ; return; } test -f facture_message_body.txt || { echo NO facture_message_body.txt ; return; } test -f email_address.txt || { echo NO email_address.txt ; return; } @@ -43,7 +43,8 @@ send_invoice() { mailq echo SAID "[$r]" test X"$r" = Xy && { - echo | mutt -H facture_message.txt -a facture_imapsync-${invoice}.pdf facture_imapsync-${invoice}.pdf.asc -- + #echo | mutt -H facture_message.txt -a facture_imapsync-${invoice}.pdf facture_imapsync-${invoice}.pdf.asc -- + echo | mutt -H facture_message.txt -a facture_imapsync-${invoice}.pdf -- touch SENT_TO_$email sleep 3 } diff --git a/W/paypal_reply/texput.log b/W/paypal_reply/texput.log new file mode 100644 index 0000000..52ca675 --- /dev/null +++ b/W/paypal_reply/texput.log @@ -0,0 +1,21 @@ +This is pdfTeX, Version 3.14159265-2.6-1.40.16 (TeX Live 2015/Debian) (preloaded format=pdflatex 2017.2.2) 22 JUL 2017 15:17 +entering extended mode + restricted \write18 enabled. + %&-line parsing enabled. +**facture_imapsync-sh.tex + +! Emergency stop. +<*> facture_imapsync-sh.tex + +End of file on the terminal! + + +Here is how much of TeX's memory you used: + 3 strings out of 494421 + 121 string characters out of 6172372 + 49430 words of memory out of 5000000 + 3408 multiletter control sequences out of 15000+600000 + 3640 words of font info for 14 fonts, out of 8000000 for 9000 + 430 hyphenation exceptions out of 8191 + 0i,0n,0p,1b,6s stack positions out of 5000i,500n,10000p,200000b,80000s +! ==> Fatal error occurred, no output PDF file produced! diff --git a/W/perlcritic_1.out b/W/perlcritic_1.out index f0e8079..30ac415 100644 --- a/W/perlcritic_1.out +++ b/W/perlcritic_1.out @@ -1,934 +1,932 @@ Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) -Check the spelling in your POD: NAME imapsync Email IMAP tool syncing copying migrating email mailboxes The command between two imap servers than different server supported with success few failures REQUIRED required argmuments the three each sides needed to login into host username password times INSTALL There is specific everything specified by line parameteres default behavior To get of just run like this This also available at reproduced here Imapsync allowing incremental recursive transfers from one mailbox another By all folders transferred recursively flags synced too We sometimes need transfer called reduces amount not transferring given it resides already both Same headers done only taken account Received header lines All preserved unread will stay read deleted You can any time restart later works well bad decide delete after successful be good feature when since side that implies expunge so marked really you noexpunge avoid don't see real world scenario combination synchronizing want keep copy has used deletes folder destroy then foldersonly foldersbutnot adequate maintaining accounts synchronization plays independently offlineimap written Goerzen mbsync Michael Elkins ways synchronizations invoke previous named HISTORY wrote because enterprise basystemes paid install new without losing huge old located away remote low bandwidth link imapcp could help had verify every was started its life patch comes perl tarball directory EXAMPLE While working parameters please induced Nothing way synchronize buddy Then updated SECURITY passfile instead give safer With your using ps auxwwww Using dangerous auxwwwwe So saving protected rw best imasync totally against sniffers network passwords may plain text CRAM MD ssl tls enable encryption authenticate typically admin authorized someone else which means know personal Specify authuser adminuser authmech PLAIN now SOMETHING work Authenticate When proxyauth masquerade Can OAUTH transfering Google Apps key domain It does free edition STATUS status return went Otherwise exits zero unreliable connection loop Bourne shell LICENSE always cover NOLIMIT License See included enough repeat LIST list write address subscribe send even empty reply unsubscribe person consider anyone post pseudonym private Thank AUTHOR Feedback very often welcome earns his writing installing configuring teaching sold author maintening supporting license over decades BUGS Help follow following guidelines bugs requests Before reporting FAQs TODO Upgrade last release maybe bug fixed IMAPClient Perl there Make title word my spam filters won't filter Try words problem made keywords summary include Most those found begining carbon easy debug One paper How Ask Way forget SERVERS HUGE Pay special subscribed maxage maxsize useuid usecache many migrate think little program Write file.txt example containing users separator contains Windows batch replaced nothing Welcome programming find HACKING Feel hack permits Entries SIMILAR Exp at line 1, column 1. See page 148 of PBP. (Severity: 1) -Main code has high complexity score (401) at line 1, column 1. Consider refactoring. (Severity: 3) +Check the spelling in your POD: NAME imapsync Email IMAP tool syncing copying migrating email mailboxes between two imap servers one way without duplicates This refers to Imapsync We sometimes need transfer from server another command is allowing incremental recursive transfers mailbox By default all folders transferred recursively meaning the whole folder hierarchy taken them flags synced too reduces amount of by not transferring given it resides already both sides Same specific headers done only Received lines can be changed with useheader All preserved unread will stay read deleted You at any time restart later works well bad decide delete after successful good feature when since side that implies also expunge so marked host really different scenario synchronizing you just want keep copy has used deletes destroy then see foldersonly foldersbutnot adequate maintaining accounts synchronization plays independently offlineimap written Goerzen mbsync Michael Elkins ways Mandatory three each needed log into ie username password times sizes selection SECURITY passfile instead give safer With your using ps auxwwww Using like dangerous because auxwwwwe So saving protected rw best activates ssl tls encryption What details under this known imaps closed clear connection TLS CAPABILITY list supported goes automatic detection fails protect against sniffing activities network especially passwords See directory STATUS status return everything went Otherwise exits zero LICENSE free always cover NOLIMIT License included IS text enough repeat AUTHOR Feedback very often welcome earns his writing installing configuring teaching now sold its author maintain over decades BUGS SERVERS HUGE Pay special subscribed subscribe maxage maxsize useuid usecache many migrate think little shell program Write called file.txt example containing users The separator contains Windows batch replaced nothing Welcome programming find INSTALL There specified line parameters behavior HACKING Feel hack license permits SIMILAR HISTORY wrote enterprise basystemes paid install new losing huge old located away remote low bandwidth link imapcp could help had verify every was started life patch comes perl tarball precisely IMAPClient at line 1, column 1. See page 148 of PBP. (Severity: 1) +Main code has high complexity score (392) at line 1, column 1. Consider refactoring. (Severity: 3) POD before __END__ at line 18, column 1. See pages 139,140 of PBP. (Severity: 1) +Missing "REQUIRED ARGUMENTS" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) Missing "DIAGNOSTICS" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) Missing "DEPENDENCIES" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) Missing "INCOMPATIBILITIES" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) -Magic punctuation variable $| used at line 698, column 3. See page 79 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 771, column 26. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 772, column 31. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 774, column 51. Don't use whitespace at the end of lines. (Severity: 1) -Long number not separated with underscores at line 780, column 33. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 799, column 34. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 803, column 37. See page 59 of PBP. (Severity: 2) -File lexical variable "$fixInboxINBOX" is not all lower case or all upper case at line 814, column 1. See pages 45,46 of PBP. (Severity: 1) -"$ssl1_ssl_version" is declared but not used at line 814, column 1. Unused variables clutter code and make it harder to read. (Severity: 3) -"$ssl2_ssl_version" is declared but not used at line 814, column 1. Unused variables clutter code and make it harder to read. (Severity: 3) -String *may* require interpolation at line 916, column 8. See page 51 of PBP. (Severity: 1) -Magic punctuation variable $! used in interpolated string at line 966, column 47. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 967, column 32. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 971, column 17. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1010, column 119. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1044, column 15. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1045, column 21. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1051, column 25. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1059, column 24. See pages 93,94 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 1068, column 40. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 1106, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1118, column 31. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1119, column 12. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1133, column 5. See pages 93,94 of PBP. (Severity: 2) -Postfix control "unless" used at line 1252, column 40. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 1302, column 22. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1303, column 22. See pages 93,94 of PBP. (Severity: 2) -String *may* require interpolation at line 1308, column 19. See page 51 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 1314, column 47. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 1315, column 43. Don't use whitespace at the end of lines. (Severity: 1) -Postfix control "unless" used at line 1380, column 43. See pages 96,97 of PBP. (Severity: 2) -Postfix control "unless" used at line 1382, column 43. See pages 96,97 of PBP. (Severity: 2) +File lexical variable "$fixInboxINBOX" is not all lower case or all upper case at line 793, column 1. See pages 45,46 of PBP. (Severity: 1) +String *may* require interpolation at line 887, column 16. See page 51 of PBP. (Severity: 1) +Postfix control "if" used at line 953, column 55. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 972, column 20. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 973, column 21. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1011, column 119. See pages 93,94 of PBP. (Severity: 2) +Useless interpolation of literal string at line 1012, column 10. See page 51 of PBP. (Severity: 1) +Postfix control "if" used at line 1045, column 15. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1046, column 21. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1056, column 30. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1066, column 24. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1098, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1112, column 31. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1113, column 12. See pages 93,94 of PBP. (Severity: 2) +Useless use of $_ at line 1281, column 34. $_ should be omitted when calling "uc". (Severity: 2) +Postfix control "if" used at line 1300, column 22. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1301, column 22. See pages 93,94 of PBP. (Severity: 2) +String *may* require interpolation at line 1306, column 26. See page 51 of PBP. (Severity: 1) File lexical variable "%h2_folders_all_UPPER" is not all lower case or all upper case at line 1404, column 1. See pages 45,46 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 1413, column 31. Don't use whitespace at the end of lines. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 1442, column 3. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 1442, column 3. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 1443, column 3. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 1443, column 3. See page 51 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 1481, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 1481, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 1481, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 1490, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 1490, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 1490, column 33. See page 237 of PBP. (Severity: 2) -Return value of flagged function ignored - print at line 1585, column 1. See pages 208,278 of PBP. (Severity: 1) -Return value of flagged function ignored - print at line 1593, column 1. See pages 208,278 of PBP. (Severity: 1) -Postfix control "if" used at line 1596, column 3. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1631, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1632, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1641, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1649, column 34. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1711, column 3. See page 97 of PBP. (Severity: 2) -"unless" block used at line 1717, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1793, column 57. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1803, column 77. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1811, column 5. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1816, column 3. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1819, column 2. See page 97 of PBP. (Severity: 2) -Builtin function called with parentheses at line 1820, column 15. See page 13 of PBP. (Severity: 1) -Postfix control "if" used at line 1856, column 79. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1865, column 3. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1870, column 3. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1900, column 10. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1920, column 32. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1921, column 4. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1929, column 39. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1933, column 38. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1942, column 4. See page 97 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 1945, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 1945, column 31. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 1947, column 7. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1948, column 31. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1949, column 5. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1957, column 51. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1958, column 4. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1967, column 39. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1971, column 38. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1980, column 4. See page 97 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 1982, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 1982, column 31. See page 237 of PBP. (Severity: 2) -"unless" block used at line 1983, column 5. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 2012, column 69. See pages 93,94 of PBP. (Severity: 2) -Code structure is deeply nested at line 2013, column 41. Consider refactoring. (Severity: 3) -"unless" block used at line 2013, column 41. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 2024, column 39. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 2028, column 38. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 2125, column 3. See page 97 of PBP. (Severity: 2) -"unless" block used at line 2129, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "unless" used at line 2159, column 20. See pages 96,97 of PBP. (Severity: 2) -Postfix control "unless" used at line 2160, column 20. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 2163, column 66. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 2164, column 41. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 2165, column 40. See pages 93,94 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 2172, column 39. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 2173, column 39. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 2177, column 40. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 2219, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Reused variable name in lexical scope: $sync at line 2255, column 2. Invent unique variable names. (Severity: 3) -Local lexical variable "$Side" is not all lower case or all upper case at line 2268, column 2. See pages 45,46 of PBP. (Severity: 1) -String *may* require interpolation at line 2304, column 35. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 2313, column 35. See page 51 of PBP. (Severity: 1) -Quotes used with a noisy string at line 2351, column 37. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 2351, column 48. See page 53 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 2365, column 2. Invent unique variable names. (Severity: 3) -Local lexical variable "$Side" is not all lower case or all upper case at line 2367, column 9. See pages 45,46 of PBP. (Severity: 1) -Use character classes for literal metachars instead of escapes at line 2414, column 29. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 2414, column 29. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2414, column 29. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2414, column 29. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 2436, column 31. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 2436, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2436, column 31. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2436, column 31. See page 237 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 2445, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2468, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/s" flag at line 2501, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2501, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2501, column 30. See page 237 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 2512, column 53. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2520, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2570, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/s" flag at line 2607, column 26. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2607, column 26. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2607, column 26. See page 237 of PBP. (Severity: 2) -Builtin function called with parentheses at line 2615, column 37. See page 13 of PBP. (Severity: 1) -Postfix control "if" used at line 2621, column 25. See pages 93,94 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 2628, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 2633, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Builtin function called with parentheses at line 2655, column 37. See page 13 of PBP. (Severity: 1) -Too many arguments at line 2727, column 1. See page 182 of PBP. (Severity: 3) -Too many arguments at line 2745, column 1. See page 182 of PBP. (Severity: 3) -Too many arguments at line 2755, column 1. See page 182 of PBP. (Severity: 3) -Builtin function called with parentheses at line 2770, column 22. See page 13 of PBP. (Severity: 1) -Builtin function called with parentheses at line 2771, column 22. See page 13 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 2801, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 2801, column 17. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 2817, column 61. See pages 93,94 of PBP. (Severity: 2) -Subroutine "modulesversion" with high complexity score (27) at line 2868, column 1. Consider refactoring. (Severity: 3) -Regular expression without "/s" flag at line 2966, column 16. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 2966, column 16. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 2996, column 45. See page 53 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 3034, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 3051, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Too many arguments at line 3075, column 1. See page 182 of PBP. (Severity: 3) -Local lexical variable "$Side" is not all lower case or all upper case at line 3076, column 2. See pages 45,46 of PBP. (Severity: 1) -Magic punctuation variable $@ used in interpolated string at line 3085, column 18. See page 79 of PBP. (Severity: 2) -Local lexical variable "$Side" is not all lower case or all upper case at line 3103, column 2. See pages 45,46 of PBP. (Severity: 1) -Magic punctuation variable $@ used in interpolated string at line 3115, column 17. See page 79 of PBP. (Severity: 2) -Subroutine "authenticate_imap" with high complexity score (21) at line 3144, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 3144, column 1. See page 182 of PBP. (Severity: 3) -Local lexical variable "$Side" is not all lower case or all upper case at line 3146, column 2. See pages 45,46 of PBP. (Severity: 1) -Postfix control "unless" used at line 3158, column 51. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 3162, column 33. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3163, column 33. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3164, column 35. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3166, column 32. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 3170, column 2. See page 97 of PBP. (Severity: 2) -Local lexical variable "$Side" is not all lower case or all upper case at line 3200, column 2. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 3238, column 45. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3262, column 45. See pages 93,94 of PBP. (Severity: 2) -Too many arguments at line 3274, column 1. See page 182 of PBP. (Severity: 3) -Local lexical variable "$Side" is not all lower case or all upper case at line 3275, column 2. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 3298, column 43. See pages 93,94 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 3311, column 32. See pages 54,55 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 3358, column 32. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 3358, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3358, column 32. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3358, column 32. See page 237 of PBP. (Severity: 2) -Builtin function called with parentheses at line 3362, column 13. See page 13 of PBP. (Severity: 1) -Magic punctuation variable $! used in interpolated string at line 3362, column 60. See page 79 of PBP. (Severity: 2) -Use "local $/ = undef" or File::Slurp instead of joined readline at line 3363, column 43. See page 213 of PBP. (Severity: 3) -Return value of "close" ignored at line 3364, column 13. Check the return value of "close" for success. (Severity: 2) -Return value of flagged function ignored - close at line 3364, column 13. See pages 208,278 of PBP. (Severity: 1) -Use named character classes ([A-Za-z] vs. [[:alpha:]]) at line 3373, column 69. See page 248 of PBP. (Severity: 1) -Use character classes for literal metachars instead of escapes at line 3373, column 69. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 3373, column 69. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3373, column 69. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3373, column 69. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 3376, column 37. See pages 93,94 of PBP. (Severity: 2) -Backtick operator used at line 3381, column 20. Use IPC::Open3 instead. (Severity: 3) -"unless" block used at line 3406, column 9. See page 97 of PBP. (Severity: 2) -Useless interpolation of literal string at line 3416, column 69. See page 51 of PBP. (Severity: 1) -Useless interpolation of literal string at line 3416, column 112. See page 51 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 3440, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 3440, column 32. See page 237 of PBP. (Severity: 2) -String *may* require interpolation at line 3509, column 3. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 3510, column 3. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 3511, column 3. See page 51 of PBP. (Severity: 1) -Magic punctuation variable $0 used in interpolated string at line 3514, column 3. See page 79 of PBP. (Severity: 2) -Builtin function called with parentheses at line 3533, column 70. See page 13 of PBP. (Severity: 1) -Return value of eval not tested at line 3538, column 2. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) -Quotes used with a noisy string at line 3539, column 11. See page 53 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 3539, column 11. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 3539, column 18. See pages 93,94 of PBP. (Severity: 2) -Magic punctuation variable $@ used at line 3539, column 23. See page 79 of PBP. (Severity: 2) -Constant "$NB_UNIX_tests_is_valid_directory" is not all upper case at line 3545, column 9. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 3547, column 68. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 3548, column 32. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 3551, column 32. See page 53 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 3561, column 1. Don't use whitespace at the end of lines. (Severity: 1) -File handle for "print" or "printf" is not braced at line 3577, column 2. See page 217 of PBP. (Severity: 1) -Return value of flagged function ignored - print at line 3577, column 2. See pages 208,278 of PBP. (Severity: 1) -Return value of "close" ignored at line 3578, column 2. Check the return value of "close" for success. (Severity: 2) -Return value of flagged function ignored - close at line 3578, column 2. See pages 208,278 of PBP. (Severity: 1) -Return value of "close" ignored at line 3598, column 17. Check the return value of "close" for success. (Severity: 2) -Return value of flagged function ignored - close at line 3598, column 17. See pages 208,278 of PBP. (Severity: 1) -"die" used instead of "croak" at line 3606, column 2. See page 283 of PBP. (Severity: 3) -Magic punctuation variable $0 used in interpolated string at line 3611, column 13. See page 79 of PBP. (Severity: 2) -Subroutine "fix_Inbox_INBOX_mapping" is not all lower case or all upper case at line 3616, column 1. See pages 45,46 of PBP. (Severity: 1) -String *may* require interpolation at line 3623, column 77. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 3624, column 77. See page 51 of PBP. (Severity: 1) -Subroutine "tests_fix_Inbox_INBOX_mapping" is not all lower case or all upper case at line 3629, column 1. See pages 45,46 of PBP. (Severity: 1) -String *may* require interpolation at line 3643, column 6. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 3647, column 6. See page 51 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 3714, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3714, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3714, column 15. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3715, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3715, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3715, column 15. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3716, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3716, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3716, column 15. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 3725, column 8. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 3725, column 8. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3725, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3725, column 8. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3726, column 8. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3726, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3726, column 8. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 3727, column 8. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 3727, column 8. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3727, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3727, column 8. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 3770, column 31. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 3770, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3770, column 31. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3770, column 31. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3857, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3857, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3857, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3860, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3860, column 20. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3860, column 20. See page 237 of PBP. (Severity: 2) -Postfix control "unless" used at line 4057, column 18. See pages 96,97 of PBP. (Severity: 2) -Use 'eq' or hash instead of fixed-pattern regexps at line 4061, column 24. See pages 271,272 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4061, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4061, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4061, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4062, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4062, column 19. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4062, column 19. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 4066, column 19. See page 247 of PBP. (Severity: 1) -Use [\.\/] instead of \.|\/ at line 4066, column 19. See page 265 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4066, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4066, column 19. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4066, column 19. See page 237 of PBP. (Severity: 2) -Local lexical variable "$Side" is not all lower case or all upper case at line 4092, column 2. See pages 45,46 of PBP. (Severity: 1) -Quotes used with a noisy string at line 4136, column 12. See page 53 of PBP. (Severity: 2) -Postfix control "while" used at line 4136, column 20. See page 96 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4136, column 39. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4136, column 39. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4136, column 39. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4137, column 12. See page 53 of PBP. (Severity: 2) -Postfix control "while" used at line 4137, column 20. See page 96 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 4137, column 39. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4137, column 39. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4137, column 39. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4137, column 39. See page 237 of PBP. (Severity: 2) -Postfix control "while" used at line 4138, column 22. See page 96 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4138, column 41. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4138, column 41. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4138, column 41. See page 237 of PBP. (Severity: 2) -Forbid $b before $a in sort blocks at line 4140, column 20. See page 152 of PBP. (Severity: 1) -Quotes used with a noisy string at line 4147, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4148, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4149, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4150, column 6. See page 53 of PBP. (Severity: 2) -Local lexical variable "$Side" is not all lower case or all upper case at line 4156, column 2. See pages 45,46 of PBP. (Severity: 1) -Quotes used with a noisy string at line 4241, column 46. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4241, column 51. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4242, column 48. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4242, column 53. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4243, column 48. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4243, column 53. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4244, column 48. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4244, column 53. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4245, column 50. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4245, column 55. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4247, column 50. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4247, column 55. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4249, column 50. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4249, column 55. See page 53 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 4259, column 14. See pages 54,55 of PBP. (Severity: 2) -Use only '//' or '{}' to delimit regexps at line 4262, column 14. See page 246 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4262, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4262, column 14. See page 237 of PBP. (Severity: 2) -Use only '//' or '{}' to delimit regexps at line 4263, column 14. See page 246 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4263, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4263, column 14. See page 237 of PBP. (Severity: 2) -Use only '//' or '{}' to delimit regexps at line 4264, column 14. See page 246 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4264, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4264, column 14. See page 237 of PBP. (Severity: 2) -Use only '//' or '{}' to delimit regexps at line 4265, column 21. See page 246 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4265, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4265, column 21. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 4265, column 30. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4265, column 49. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4265, column 74. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4273, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4274, column 11. See page 53 of PBP. (Severity: 2) -String *may* require interpolation at line 4308, column 18. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4309, column 48. See page 51 of PBP. (Severity: 1) -Quotes used with a noisy string at line 4320, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4321, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4336, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4337, column 11. See page 53 of PBP. (Severity: 2) -String *may* require interpolation at line 4340, column 18. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4343, column 18. See page 51 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4375, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4375, column 14. See page 237 of PBP. (Severity: 2) -Postfix control "unless" used at line 4381, column 4. See pages 96,97 of PBP. (Severity: 2) -Use 'eq' or hash instead of fixed-pattern regexps at line 4381, column 66. See pages 271,272 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4381, column 66. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4381, column 66. See page 237 of PBP. (Severity: 2) -Expression form of "eval" at line 4391, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 4393, column 48. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4394, column 15. See page 79 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4404, column 28. See page 53 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4412, column 42. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4412, column 42. See page 237 of PBP. (Severity: 2) -"unless" block used at line 4445, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 4458, column 39. See pages 93,94 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4464, column 53. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4472, column 53. See page 79 of PBP. (Severity: 2) -Single-quote used as quote-like operator delimiter at line 4522, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4522, column 6. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4522, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4522, column 45. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4528, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4528, column 6. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4528, column 38. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4528, column 38. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4529, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4529, column 17. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4530, column 39. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4530, column 39. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4530, column 65. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4534, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4534, column 6. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4534, column 40. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4534, column 40. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4537, column 6. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4537, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4537, column 45. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4537, column 84. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4538, column 6. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4538, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4538, column 45. See page 51 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 4538, column 94. Don't use whitespace at the end of lines. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4539, column 22. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4539, column 22. See page 51 of PBP. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4541, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4541, column 17. See page 51 of PBP. (Severity: 1) -Found "\t" at the end of the line at line 4543, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4550, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4550, column 17. See page 51 of PBP. (Severity: 1) -Found "\t" at the end of the line at line 4554, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Single-quote used as quote-like operator delimiter at line 4556, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -String *may* require interpolation at line 4556, column 17. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4557, column 5. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4566, column 16. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4567, column 77. See page 51 of PBP. (Severity: 1) -List declaration without trailing comma at line 4571, column 15. See page 17 of PBP. (Severity: 1) -String *may* require interpolation at line 4572, column 2. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4573, column 2. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4574, column 2. See page 51 of PBP. (Severity: 1) -List declaration without trailing comma at line 4587, column 15. See page 17 of PBP. (Severity: 1) -String *may* require interpolation at line 4588, column 2. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4589, column 2. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4590, column 2. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4595, column 21. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4598, column 20. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4604, column 2. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4608, column 17. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4614, column 17. See page 51 of PBP. (Severity: 1) -Expression form of "eval" at line 4629, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 4631, column 45. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4632, column 13. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4643, column 17. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4645, column 17. See page 79 of PBP. (Severity: 2) -"unless" block used at line 4652, column 4. See page 97 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4655, column 19. See page 79 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 4684, column 17. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4684, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4684, column 17. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 4687, column 28. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 4687, column 28. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4687, column 28. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4712, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4712, column 21. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4724, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4724, column 20. See page 237 of PBP. (Severity: 2) -Found "\t" at the end of the line at line 4752, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Builtin function called with parentheses at line 4753, column 14. See page 13 of PBP. (Severity: 1) -String *may* require interpolation at line 4766, column 27. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4766, column 38. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4767, column 27. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 4767, column 38. See page 51 of PBP. (Severity: 1) -"unless" block used at line 4899, column 3. See page 97 of PBP. (Severity: 2) -"unless" block used at line 4900, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 4963, column 22. See pages 93,94 of PBP. (Severity: 2) -Subroutine "copy_message" with high complexity score (25) at line 4990, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 4990, column 1. See page 182 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 4993, column 2. Invent unique variable names. (Severity: 3) -Postfix control "if" used at line 5007, column 100. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 5057, column 19. See pages 93,94 of PBP. (Severity: 2) -Too many arguments at line 5074, column 1. See page 182 of PBP. (Severity: 3) -Subroutine "message_for_host2" with high complexity score (27) at line 5107, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 5107, column 1. See page 182 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 5129, column 2. Invent unique variable names. (Severity: 3) -"unless" block used at line 5150, column 2. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 5156, column 34. See pages 93,94 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 5222, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Reused variable name in lexical scope: $sync at line 5223, column 9. Invent unique variable names. (Severity: 3) -Found "\N{SPACE}" at the end of the line at line 5224, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Local lexical variable "$imapT" is not all lower case or all upper case at line 5229, column 9. See pages 45,46 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 5232, column 1. Don't use whitespace at the end of lines. (Severity: 1) -9 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5235, column 21. Unnamed numeric literals make code less maintainable. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 5235, column 24. Don't use whitespace at the end of lines. (Severity: 1) -Quotes used with a string containing no non-whitespace characters at line 5236, column 21. See page 53 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 5236, column 25. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 5240, column 41. Don't use whitespace at the end of lines. (Severity: 1) -Reused variable name in lexical scope: $string_ref at line 5242, column 25. Invent unique variable names. (Severity: 3) -9 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5247, column 13. Unnamed numeric literals make code less maintainable. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 5247, column 120. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 5250, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Constant "$NB_WIN_tests_message_for_host2" is not all upper case at line 5255, column 17. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 5256, column 61. See pages 93,94 of PBP. (Severity: 2) -Constant "$NB_UNX_tests_message_for_host2" is not all upper case at line 5264, column 17. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 5265, column 58. See pages 93,94 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 5267, column 1. Don't use whitespace at the end of lines. (Severity: 1) -9 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5270, column 21. Unnamed numeric literals make code less maintainable. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 5270, column 128. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 5274, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 5277, column 132. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 5283, column 132. Don't use whitespace at the end of lines. (Severity: 1) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5303, column 13. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5304, column 13. Unnamed numeric literals make code less maintainable. (Severity: 2) -Use only '//' or '{}' to delimit regexps at line 5333, column 15. See page 246 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 5333, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5333, column 15. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 5338, column 37. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 5339, column 64. See pages 93,94 of PBP. (Severity: 2) -String *may* require interpolation at line 5361, column 63. See page 51 of PBP. (Severity: 1) -Too many arguments at line 5419, column 1. See page 182 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 5445, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5445, column 20. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 5463, column 75. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5463, column 75. See page 237 of PBP. (Severity: 2) -Reused variable name in lexical scope: $total_bytes_transferred at line 5486, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $nb_msg_transferred at line 5486, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $nb_msg_transferred at line 5499, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $maxmessagespersecond at line 5499, column 9. Invent unique variable names. (Severity: 3) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5508, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5509, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5510, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5511, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -8 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5512, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -Reused variable name in lexical scope: $total_bytes_transferred at line 5520, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $maxbytespersecond at line 5520, column 9. Invent unique variable names. (Severity: 3) -Postfix control "if" used at line 5545, column 36. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 5550, column 30. See pages 93,94 of PBP. (Severity: 2) -Reused variable name in lexical scope: $h1_nb_msg_start at line 5557, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $h1_nb_msg_start at line 5568, column 2. Invent unique variable names. (Severity: 3) -Use character classes for literal metachars instead of escapes at line 5665, column 23. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 5665, column 23. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5665, column 23. See page 237 of PBP. (Severity: 2) -Use [\[\]] instead of \[|\] at line 5685, column 23. See page 265 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 5685, column 23. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5685, column 23. See page 237 of PBP. (Severity: 2) -String *may* require interpolation at line 5783, column 15. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5783, column 47. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5783, column 72. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5784, column 14. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5784, column 38. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5807, column 33. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5812, column 9. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5813, column 9. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5814, column 11. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 5815, column 11. See page 51 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 5824, column 16. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5824, column 16. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 5882, column 29. See page 53 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 5882, column 29. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 6003, column 38. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 6010, column 40. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6014, column 45. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6015, column 45. See page 53 of PBP. (Severity: 2) -String *may* require interpolation at line 6072, column 33. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 6072, column 46. See page 51 of PBP. (Severity: 1) -Quotes used with a noisy string at line 6144, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6152, column 25. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6153, column 25. See page 53 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 6169, column 21. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 6169, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 6169, column 21. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 6171, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 6171, column 20. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 6185, column 31. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 6190, column 32. See pages 93,94 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 6201, column 13. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 6201, column 13. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6207, column 38. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6208, column 46. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6209, column 54. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6212, column 54. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6213, column 60. See page 53 of PBP. (Severity: 2) -String *may* require interpolation at line 6250, column 17. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 6289, column 16. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 6559, column 16. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 6560, column 16. See page 51 of PBP. (Severity: 1) -Expression form of "eval" at line 6706, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 6708, column 38. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 6709, column 13. See page 79 of PBP. (Severity: 2) -String *may* require interpolation at line 6734, column 15. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 6742, column 15. See page 51 of PBP. (Severity: 1) -Numeric escapes in interpolated string at line 6744, column 21. See pages 54,55 of PBP. (Severity: 2) -String *may* require interpolation at line 6744, column 31. See page 51 of PBP. (Severity: 1) -Numeric escapes in interpolated string at line 6749, column 21. See pages 54,55 of PBP. (Severity: 2) -String *may* require interpolation at line 6756, column 16. See page 51 of PBP. (Severity: 1) -Long number not separated with underscores at line 6901, column 16. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6912, column 16. See page 59 of PBP. (Severity: 2) -Magic punctuation variable $% used in interpolated string at line 6928, column 3. See page 79 of PBP. (Severity: 2) -Long number not separated with underscores at line 6928, column 87. See page 59 of PBP. (Severity: 2) -Expression form of "eval" at line 6942, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 6945, column 24. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 6946, column 13. See page 79 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 6962, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Long number not separated with underscores at line 6966, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6967, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6969, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6970, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6972, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6973, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6975, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6976, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6978, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6979, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6981, column 49. See page 59 of PBP. (Severity: 2) -Builtin function called with parentheses at line 6992, column 16. See page 13 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7000, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7033, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Postfix control "if" used at line 7053, column 69. See pages 93,94 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 7088, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7092, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7099, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Subroutine "diff_or_NA" is not all lower case or all upper case at line 7111, column 1. See pages 45,46 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7113, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7117, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7118, column 37. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7122, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 7128, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Use named character classes ([0-9] vs. \d) at line 7132, column 21. See page 248 of PBP. (Severity: 1) -Use character classes for literal metachars instead of escapes at line 7132, column 21. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 7132, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7132, column 21. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7132, column 21. See page 237 of PBP. (Severity: 2) -Subroutine "tests_diff_or_NA" is not all lower case or all upper case at line 7155, column 1. See pages 45,46 of PBP. (Severity: 1) -Too many arguments at line 7204, column 1. See page 182 of PBP. (Severity: 3) -Postfix control "unless" used at line 7241, column 27. See pages 96,97 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7278, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7278, column 30. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7293, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7293, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7296, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7296, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7299, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7299, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7302, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7302, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7305, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7305, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7308, column 97. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7308, column 97. See page 237 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 7326, column 51. See pages 54,55 of PBP. (Severity: 2) -Close filehandles as soon as possible after opening them at line 7338, column 9. See page 209 of PBP. (Severity: 4) -Magic punctuation variable $! used in interpolated string at line 7339, column 26. See page 79 of PBP. (Severity: 2) -Return value of "close" ignored at line 7343, column 9. Check the return value of "close" for success. (Severity: 2) -Return value of flagged function ignored - close at line 7343, column 9. See pages 208,278 of PBP. (Severity: 1) -Magic punctuation variable $! used in interpolated string at line 7364, column 42. See page 79 of PBP. (Severity: 2) -Return value of "close" ignored at line 7366, column 2. Check the return value of "close" for success. (Severity: 2) -Return value of flagged function ignored - close at line 7366, column 2. See pages 208,278 of PBP. (Severity: 1) -Builtin function called with parentheses at line 7373, column 2. See page 13 of PBP. (Severity: 1) -Magic punctuation variable $! used in interpolated string at line 7373, column 70. See page 79 of PBP. (Severity: 2) -File handle for "print" or "printf" is not braced at line 7374, column 2. See page 217 of PBP. (Severity: 1) -Return value of flagged function ignored - print at line 7374, column 2. See pages 208,278 of PBP. (Severity: 1) -Return value of "close" ignored at line 7375, column 2. Check the return value of "close" for success. (Severity: 2) -Return value of flagged function ignored - close at line 7375, column 2. See pages 208,278 of PBP. (Severity: 1) -Literal line breaks in a string at line 7379, column 1. See pages 60,61 of PBP. (Severity: 3) -String *may* require interpolation at line 7379, column 1. See page 51 of PBP. (Severity: 1) -Postfix control "if" used at line 7393, column 3. See pages 93,94 of PBP. (Severity: 2) -Backtick operator used at line 7403, column 17. Use IPC::Open3 instead. (Severity: 3) -Builtin function called with parentheses at line 7406, column 17. See page 13 of PBP. (Severity: 1) -Builtin function called with parentheses at line 7408, column 34. See page 13 of PBP. (Severity: 1) -Constant "$NB_WIN_tests_pipemess" is not all upper case at line 7441, column 17. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 7442, column 52. See pages 93,94 of PBP. (Severity: 2) -Local lexical variable "$stringT" is not all lower case or all upper case at line 7454, column 9. See pages 45,46 of PBP. (Severity: 1) -Local lexical variable "$errorT" is not all lower case or all upper case at line 7454, column 9. See pages 45,46 of PBP. (Severity: 1) -Constant "$NB_UNX_tests_pipemess" is not all upper case at line 7457, column 17. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 7458, column 49. See pages 93,94 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 7486, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Split long regexps into smaller qr// chunks at line 7489, column 32. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7489, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7489, column 32. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7489, column 32. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7493, column 32. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7493, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7493, column 32. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7493, column 32. See page 237 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 7499, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Regular expression without "/s" flag at line 7502, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7502, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7502, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7507, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7507, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7507, column 33. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7511, column 33. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7511, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7511, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7511, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7514, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7514, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7515, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7515, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7515, column 33. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7521, column 24. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7521, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7521, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7521, column 24. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 7537, column 21. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 7537, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7537, column 21. See page 237 of PBP. (Severity: 2) -String *may* require interpolation at line 7558, column 21. See page 51 of PBP. (Severity: 1) -Use character classes for literal metachars instead of escapes at line 7561, column 24. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 7561, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7561, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7570, column 29. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7570, column 29. See page 237 of PBP. (Severity: 2) -Magic punctuation variable $0 used at line 7577, column 18. See page 79 of PBP. (Severity: 2) -File handle for "print" or "printf" is not braced at line 7595, column 2. See page 217 of PBP. (Severity: 1) -Return value of flagged function ignored - print at line 7595, column 2. See pages 208,278 of PBP. (Severity: 1) -Return value of "close" ignored at line 7600, column 2. Check the return value of "close" for success. (Severity: 2) -Return value of flagged function ignored - close at line 7600, column 2. See pages 208,278 of PBP. (Severity: 1) -Magic punctuation variable $! used in interpolated string at line 7620, column 23. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used at line 7634, column 23. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used at line 7636, column 7. See page 79 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7636, column 13. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7636, column 13. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7671, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7671, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7671, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7672, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7672, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7672, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7673, column 43. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7673, column 43. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7673, column 43. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7675, column 36. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7675, column 36. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7675, column 36. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7676, column 37. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7676, column 37. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7676, column 37. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7677, column 38. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7677, column 38. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7677, column 38. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7679, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7679, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7679, column 30. See page 237 of PBP. (Severity: 2) -Backtick operator used at line 7696, column 12. Use IPC::Open3 instead. (Severity: 3) -Found "\N{SPACE}" at the end of the line at line 7702, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Backtick operator used at line 7718, column 11. Use IPC::Open3 instead. (Severity: 3) -String delimiter used with "split" at line 7723, column 28. Express it as a regex instead. (Severity: 2) -Quotes used with a noisy string at line 7723, column 34. See page 53 of PBP. (Severity: 2) -Postfix control "if" used at line 7753, column 34. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7765, column 31. See pages 93,94 of PBP. (Severity: 2) -Subroutine "remove_Ko" is not all lower case or all upper case at line 7795, column 1. See pages 45,46 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 7797, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7797, column 17. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7806, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7806, column 17. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7826, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7826, column 19. See page 237 of PBP. (Severity: 2) -Use character classes for literal metachars instead of escapes at line 7857, column 17. See page 247 of PBP. (Severity: 1) -Use [\+-] instead of \+|- at line 7857, column 17. See page 265 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 7857, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7857, column 17. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7860, column 16. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7861, column 22. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7866, column 12. See page 261 of PBP. (Severity: 3) -Use character classes for literal metachars instead of escapes at line 7866, column 12. See page 247 of PBP. (Severity: 1) -Use [:\.] instead of :|\ at line 7866, column 12. See page 265 of PBP. (Severity: 1) -Use [:\.] instead of :|\ at line 7866, column 12. See page 265 of PBP. (Severity: 1) -Use [\+-] instead of \+|- at line 7866, column 12. See page 265 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 7866, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7866, column 12. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7878, column 38. See pages 93,94 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7878, column 72. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7878, column 72. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7879, column 38. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7881, column 46. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7885, column 30. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7887, column 33. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7892, column 12. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7892, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7892, column 12. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7909, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7909, column 19. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7921, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7921, column 19. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7933, column 12. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7933, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7933, column 12. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7939, column 29. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7945, column 12. See page 261 of PBP. (Severity: 3) -Use character classes for literal metachars instead of escapes at line 7945, column 12. See page 247 of PBP. (Severity: 1) -Use [\+-] instead of \+|- at line 7945, column 12. See page 265 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 7945, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7945, column 12. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7956, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7956, column 12. See page 237 of PBP. (Severity: 2) -Expression form of "eval" at line 8051, column 42. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 8055, column 44. See page 161 of PBP. (Severity: 5) -Postfix control "if" used at line 8060, column 34. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 8061, column 36. See pages 93,94 of PBP. (Severity: 2) -Local lexical variable "$Side" is not all lower case or all upper case at line 8072, column 9. See pages 45,46 of PBP. (Severity: 1) -Reused variable name in lexical scope: $sync at line 8072, column 9. Invent unique variable names. (Severity: 3) -Found "\N{SPACE}" at the end of the line at line 8077, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Reused variable name in lexical scope: $sync at line 8093, column 9. Invent unique variable names. (Severity: 3) -Found "\N{SPACE}" at the end of the line at line 8099, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 8126, column 31. Don't use whitespace at the end of lines. (Severity: 1) -Reused variable name in lexical scope: $sync at line 8145, column 9. Invent unique variable names. (Severity: 3) -Found "\N{SPACE}" at the end of the line at line 8146, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Local lexical variable "$Side" is not all lower case or all upper case at line 8159, column 9. See pages 45,46 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 8161, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Local lexical variable "$syncT" is not all lower case or all upper case at line 8173, column 9. See pages 45,46 of PBP. (Severity: 1) -Local lexical variable "$imapT" is not all lower case or all upper case at line 8175, column 9. See pages 45,46 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 8178, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 8189, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 8210, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Local lexical variable "$syncT" is not all lower case or all upper case at line 8277, column 9. See pages 45,46 of PBP. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 8281, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Found "\N{SPACE}" at the end of the line at line 8286, column 1. Don't use whitespace at the end of lines. (Severity: 1) -Regular expression without "/s" flag at line 8296, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8296, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8335, column 26. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8335, column 26. See page 237 of PBP. (Severity: 2) -Use 'eq' or hash instead of fixed-pattern regexps at line 8339, column 36. See pages 271,272 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8339, column 36. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8339, column 36. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8341, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8341, column 31. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8347, column 34. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8347, column 34. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 8350, column 68. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 8481, column 20. See page 261 of PBP. (Severity: 3) -Use named character classes ([A-Z] vs. [[:upper:]]) at line 8481, column 20. See page 248 of PBP. (Severity: 1) -Use character classes for literal metachars instead of escapes at line 8481, column 20. See page 247 of PBP. (Severity: 1) -Use [\+-] instead of \+|- at line 8481, column 20. See page 265 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 8481, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8481, column 20. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 8487, column 28. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8487, column 33. See page 53 of PBP. (Severity: 2) -Postfix control "if" used at line 8488, column 36. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8488, column 41. See page 53 of PBP. (Severity: 2) -Local lexical variable "$header_Message_Id" is not all lower case or all upper case at line 8515, column 2. See pages 45,46 of PBP. (Severity: 1) -String *may* require interpolation at line 8515, column 58. See page 51 of PBP. (Severity: 1) -Long number not separated with underscores at line 8521, column 55. See page 59 of PBP. (Severity: 2) -Subroutine "tests_Banner" is not all lower case or all upper case at line 8526, column 1. See pages 45,46 of PBP. (Severity: 1) -String *may* require interpolation at line 8549, column 36. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8550, column 38. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8551, column 42. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8553, column 38. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8554, column 40. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8555, column 41. See page 51 of PBP. (Severity: 1) -Long number not separated with underscores at line 8556, column 40. See page 59 of PBP. (Severity: 2) -String *may* require interpolation at line 8556, column 49. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8557, column 44. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8559, column 46. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8560, column 48. See page 51 of PBP. (Severity: 1) -String *may* require interpolation at line 8561, column 96. See page 51 of PBP. (Severity: 1) -Quotes used with a noisy string at line 8615, column 27. See page 53 of PBP. (Severity: 2) -Postfix control "if" used at line 8627, column 66. See pages 93,94 of PBP. (Severity: 2) -Postfix control "unless" used at line 8630, column 18. See pages 96,97 of PBP. (Severity: 2) -Long number not separated with underscores at line 8634, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 8635, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 8636, column 57. See page 59 of PBP. (Severity: 2) -Postfix control "unless" used at line 8638, column 16. See pages 96,97 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 8691, column 36. See page 79 of PBP. (Severity: 2) -Close filehandles as soon as possible after opening them at line 8693, column 2. See page 209 of PBP. (Severity: 4) -Magic punctuation variable $! used in interpolated string at line 8694, column 14. See page 79 of PBP. (Severity: 2) -Magic variable "*STDERR" should be assigned as "local" at line 8696, column 10. See pages 81,82 of PBP. (Severity: 4) -Double-sigil dereference at line 8696, column 12. See page 228 of PBP. (Severity: 2) -One-argument "select" used at line 8697, column 2. See page 224 of PBP. (Severity: 4) -Postfix control "if" used at line 8717, column 43. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8718, column 54. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8718, column 60. See page 53 of PBP. (Severity: 2) -Magic punctuation variable $0 used in interpolated here-document at line 8719, column 18. See page 79 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 9035, column 20. See pages 54,55 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9037, column 16. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 9037, column 16. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 9214, column 58. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 9230, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "unless" used at line 9233, column 24. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 9236, column 16. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 9253, column 46. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 9281, column 46. See pages 93,94 of PBP. (Severity: 2) -Found "\N{SPACE}" at the end of the line at line 9347, column 38. Don't use whitespace at the end of lines. (Severity: 1) -Subroutine "Tls" is not all lower case or all upper case at line 9364, column 1. See pages 45,46 of PBP. (Severity: 1) -Subroutine "Reconnect_counter" is not all lower case or all upper case at line 9371, column 1. See pages 45,46 of PBP. (Severity: 1) -Postfix control "if" used at line 9374, column 33. See pages 93,94 of PBP. (Severity: 2) -Subroutine "Banner" is not all lower case or all upper case at line 9380, column 1. See pages 45,46 of PBP. (Severity: 1) -Multiple "package" declarations at line 9395, column 1. Limit to one per file. (Severity: 4) -Subroutine "GetOptions" is not all lower case or all upper case at line 9407, column 1. See pages 45,46 of PBP. (Severity: 1) -Subroutine "GetOptions" with high complexity score (32) at line 9407, column 1. Consider refactoring. (Severity: 3) -Use character classes for literal metachars instead of escapes at line 9425, column 22. See page 247 of PBP. (Severity: 1) -Regular expression without "/s" flag at line 9425, column 22. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9425, column 22. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9425, column 22. See page 237 of PBP. (Severity: 2) -String delimiter used with "split" at line 9430, column 21. Express it as a regex instead. (Severity: 2) -Quotes used with a noisy string at line 9430, column 27. See page 53 of PBP. (Severity: 2) -Capture variable used outside conditional at line 9430, column 32. See page 253 of PBP. (Severity: 3) -Quotes used with a noisy string at line 9432, column 28. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 9437, column 32. See page 53 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9438, column 42. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9438, column 42. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9438, column 42. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9439, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9439, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9439, column 30. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9443, column 35. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9443, column 35. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9443, column 35. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9460, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9460, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9460, column 30. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9462, column 35. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9462, column 35. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9462, column 35. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 9465, column 36. See page 53 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 1424, column 36. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 1425, column 27. Don't use whitespace at the end of lines. (Severity: 1) +String *may* require interpolation at line 1444, column 17. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 1445, column 17. See page 51 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 1483, column 47. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 1483, column 47. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 1483, column 47. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 1492, column 47. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 1492, column 47. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 1492, column 47. See page 237 of PBP. (Severity: 2) +Return value of flagged function ignored - print at line 1587, column 1. See pages 208,278 of PBP. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 1597, column 8. Don't use whitespace at the end of lines. (Severity: 1) +Return value of flagged function ignored - print at line 1600, column 1. See pages 208,278 of PBP. (Severity: 1) +Postfix control "if" used at line 1603, column 3. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1638, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1639, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1648, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1656, column 34. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1799, column 71. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1809, column 84. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1817, column 17. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1822, column 17. See pages 93,94 of PBP. (Severity: 2) +Builtin function called with parentheses at line 1826, column 29. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 1865, column 86. See pages 93,94 of PBP. (Severity: 2) +Builtin function called with parentheses at line 1872, column 41. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 1878, column 17. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1908, column 17. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1928, column 53. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1937, column 60. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1941, column 45. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 1953, column 59. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 1953, column 59. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 1955, column 35. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1956, column 59. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1965, column 51. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1975, column 60. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1979, column 45. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 1990, column 59. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 1990, column 59. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 2020, column 69. See pages 93,94 of PBP. (Severity: 2) +Code structure is deeply nested at line 2021, column 41. Consider refactoring. (Severity: 3) +Postfix control "if" used at line 2032, column 60. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2036, column 45. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2170, column 66. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2171, column 41. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2174, column 40. See pages 93,94 of PBP. (Severity: 2) +String *may* require interpolation at line 2208, column 51. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 2209, column 63. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 2224, column 45. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 2225, column 57. See page 51 of PBP. (Severity: 1) +Builtin function called with parentheses at line 2237, column 25. See page 13 of PBP. (Severity: 1) +String *may* require interpolation at line 2252, column 50. See page 51 of PBP. (Severity: 1) +Builtin function called with parentheses at line 2264, column 24. See page 13 of PBP. (Severity: 1) +Found "\t" at the end of the line at line 2321, column 1. Don't use whitespace at the end of lines. (Severity: 1) +6 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2464, column 69. Unnamed numeric literals make code less maintainable. (Severity: 2) +Builtin function called with parentheses at line 2486, column 9. See page 13 of PBP. (Severity: 1) +Builtin function called with parentheses at line 2490, column 10. See page 13 of PBP. (Severity: 1) +Octal literals (0000) are not allowed. Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2498, column 29. Unnamed numeric literals make code less maintainable. (Severity: 2) +Octal literals (0000) are not allowed. Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2500, column 10. Unnamed numeric literals make code less maintainable. (Severity: 2) +777 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2500, column 27. Unnamed numeric literals make code less maintainable. (Severity: 2) +777 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2504, column 10. Unnamed numeric literals make code less maintainable. (Severity: 2) +777 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2505, column 10. Unnamed numeric literals make code less maintainable. (Severity: 2) +Quotes used with a noisy string at line 2547, column 30. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2659, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2660, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2661, column 16. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2662, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2663, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2664, column 16. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2669, column 26. See page 53 of PBP. (Severity: 2) +Builtin function called with parentheses at line 2732, column 17. See page 13 of PBP. (Severity: 1) +File handle for "print" or "printf" is not braced at line 2778, column 9. See page 217 of PBP. (Severity: 1) +Return value of flagged function ignored - print at line 2778, column 9. See pages 208,278 of PBP. (Severity: 1) +Return value of "close" ignored at line 2779, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 2779, column 9. See pages 208,278 of PBP. (Severity: 1) +Return value of flagged function ignored - print at line 2792, column 2. See pages 208,278 of PBP. (Severity: 1) +32 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2793, column 6. Unnamed numeric literals make code less maintainable. (Severity: 2) +32 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2794, column 6. Unnamed numeric literals make code less maintainable. (Severity: 2) +Useless interpolation of literal string at line 2801, column 16. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 2801, column 21. See page 51 of PBP. (Severity: 1) +Postfix control "for" used at line 2803, column 33. See page 96 of PBP. (Severity: 2) +32 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2803, column 40. Unnamed numeric literals make code less maintainable. (Severity: 2) +Local lexical variable "$Side" is not all lower case or all upper case at line 2821, column 9. See pages 45,46 of PBP. (Severity: 1) +String *may* require interpolation at line 2858, column 49. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 2867, column 49. See page 51 of PBP. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 2888, column 40. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 2891, column 45. Don't use whitespace at the end of lines. (Severity: 1) +Quotes used with a noisy string at line 2913, column 44. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 2913, column 55. See page 53 of PBP. (Severity: 2) +Local lexical variable "$Side" is not all lower case or all upper case at line 2937, column 9. See pages 45,46 of PBP. (Severity: 1) +Use character classes for literal metachars instead of escapes at line 2988, column 29. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 2988, column 29. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 2988, column 29. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 3015, column 31. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 3015, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3015, column 31. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3195, column 47. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3195, column 47. See page 237 of PBP. (Severity: 2) +Builtin function called with parentheses at line 3203, column 72. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 3209, column 25. See pages 93,94 of PBP. (Severity: 2) +Local lexical variable "$imapT" is not all lower case or all upper case at line 3218, column 9. See pages 45,46 of PBP. (Severity: 1) +String *may* require interpolation at line 3221, column 61. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 3224, column 97. See page 51 of PBP. (Severity: 1) +Builtin function called with parentheses at line 3260, column 51. See page 13 of PBP. (Severity: 1) +Useless use of $_ at line 3315, column 40. $_ should be omitted when calling "uc". (Severity: 2) +Too many arguments at line 3338, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 3356, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 3366, column 1. See page 182 of PBP. (Severity: 3) +Builtin function called with parentheses at line 3381, column 29. See page 13 of PBP. (Severity: 1) +Builtin function called with parentheses at line 3382, column 29. See page 13 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 3412, column 17. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3412, column 17. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 3428, column 61. See pages 93,94 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 3440, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Warnings disabled at line 3441, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3442, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3474, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3475, column 9. See page 431 of PBP. (Severity: 4) +100 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 3492, column 26. Unnamed numeric literals make code less maintainable. (Severity: 2) +Found "\t" at the end of the line at line 3494, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Use only '//' or '{}' to delimit regexps at line 3566, column 30. See page 246 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 3588, column 30. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3588, column 30. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 3621, column 52. See page 53 of PBP. (Severity: 2) +Use "<>" or "" or a prompting module instead of "" at line 3623, column 24. See pages 216,220,221 of PBP. (Severity: 4) +Regular expression without "/s" flag at line 3877, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3877, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3877, column 42. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3878, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3878, column 33. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3878, column 33. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3887, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3887, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3887, column 42. See page 237 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 3890, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Regular expression without "/s" flag at line 3898, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3898, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3898, column 42. See page 237 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 3914, column 149. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 3916, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Regular expression without "/s" flag at line 3919, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3919, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3919, column 42. See page 237 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 3919, column 128. Don't use whitespace at the end of lines. (Severity: 1) +Magic punctuation variable $! used at line 3920, column 73. See page 79 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 3936, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 3939, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 3946, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 3947, column 35. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 3952, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 3956, column 16. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 3959, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 3961, column 33. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 3971, column 16. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 3988, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Use character classes for literal metachars instead of escapes at line 4009, column 64. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4009, column 64. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 4009, column 64. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 4009, column 64. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 4012, column 56. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4012, column 56. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 4012, column 56. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 4012, column 56. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 4013, column 56. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4013, column 56. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 4013, column 56. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 4013, column 56. See page 237 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 4021, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 4023, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 4024, column 38. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 4031, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Too many arguments at line 4040, column 1. See page 182 of PBP. (Severity: 3) +Local lexical variable "$Side" is not all lower case or all upper case at line 4041, column 9. See pages 45,46 of PBP. (Severity: 1) +Local lexical variable "$Side" is not all lower case or all upper case at line 4073, column 9. See pages 45,46 of PBP. (Severity: 1) +Subroutine "authenticate_imap" with high complexity score (21) at line 4120, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 4120, column 1. See page 182 of PBP. (Severity: 3) +Local lexical variable "$Side" is not all lower case or all upper case at line 4122, column 9. See pages 45,46 of PBP. (Severity: 1) +Postfix control "unless" used at line 4134, column 51. See pages 96,97 of PBP. (Severity: 2) +Postfix control "if" used at line 4138, column 40. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4139, column 40. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4140, column 42. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4142, column 32. See pages 93,94 of PBP. (Severity: 2) +"unless" block used at line 4146, column 9. See page 97 of PBP. (Severity: 2) +Local lexical variable "$Side" is not all lower case or all upper case at line 4176, column 9. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 4223, column 45. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4248, column 45. See pages 93,94 of PBP. (Severity: 2) +Too many arguments at line 4260, column 1. See page 182 of PBP. (Severity: 3) +Local lexical variable "$Side" is not all lower case or all upper case at line 4261, column 9. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 4288, column 50. See pages 93,94 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 4302, column 32. See pages 54,55 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 4349, column 32. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4349, column 32. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4349, column 32. See page 237 of PBP. (Severity: 2) +Builtin function called with parentheses at line 4353, column 13. See page 13 of PBP. (Severity: 1) +Use "local $/ = undef" or Path::Tiny instead of joined readline at line 4354, column 43. See page 213 of PBP. (Severity: 3) +Return value of "close" ignored at line 4355, column 13. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 4355, column 13. See pages 208,278 of PBP. (Severity: 1) +Use named character classes ([A-Za-z] vs. [[:alpha:]]) at line 4364, column 69. See page 248 of PBP. (Severity: 1) +Use character classes for literal metachars instead of escapes at line 4364, column 69. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4364, column 69. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4364, column 69. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 4367, column 37. See pages 93,94 of PBP. (Severity: 2) +Backtick operator used at line 4372, column 20. Use IPC::Open3 instead. (Severity: 3) +"unless" block used at line 4397, column 9. See page 97 of PBP. (Severity: 2) +Useless interpolation of literal string at line 4407, column 69. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 4407, column 112. See page 51 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4431, column 32. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4431, column 32. See page 237 of PBP. (Severity: 2) +String *may* require interpolation at line 4495, column 17. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 4496, column 17. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 4497, column 17. See page 51 of PBP. (Severity: 1) +Builtin function called with parentheses at line 4519, column 84. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 4525, column 42. See pages 93,94 of PBP. (Severity: 2) +Constant "$NB_UNIX_tests_do_valid_directory" is not all upper case at line 4534, column 9. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 4536, column 82. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 4537, column 46. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 4540, column 46. See page 53 of PBP. (Severity: 2) +File handle for "print" or "printf" is not braced at line 4567, column 9. See page 217 of PBP. (Severity: 1) +Return value of flagged function ignored - print at line 4567, column 9. See pages 208,278 of PBP. (Severity: 1) +Return value of "close" ignored at line 4568, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 4568, column 9. See pages 208,278 of PBP. (Severity: 1) +Return value of "close" ignored at line 4591, column 17. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 4591, column 17. See pages 208,278 of PBP. (Severity: 1) +Subroutine "fix_Inbox_INBOX_mapping" is not all lower case or all upper case at line 4610, column 1. See pages 45,46 of PBP. (Severity: 1) +String *may* require interpolation at line 4617, column 91. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 4618, column 91. See page 51 of PBP. (Severity: 1) +Subroutine "tests_fix_Inbox_INBOX_mapping" is not all lower case or all upper case at line 4623, column 1. See pages 45,46 of PBP. (Severity: 1) +String *may* require interpolation at line 4639, column 13. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 4643, column 13. See page 51 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4718, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4718, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4719, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4719, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4720, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4720, column 15. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 4729, column 15. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4729, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4729, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4730, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4730, column 15. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 4731, column 15. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4731, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4731, column 15. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 4774, column 31. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 4774, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4774, column 31. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4861, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4861, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4864, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4864, column 20. See page 237 of PBP. (Severity: 2) +Use 'eq' or hash instead of fixed-pattern regexps at line 5068, column 38. See pages 271,272 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5068, column 38. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5068, column 38. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5069, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5069, column 33. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 5073, column 33. See page 247 of PBP. (Severity: 1) +Use [\.\/] instead of \.|\/ at line 5073, column 33. See page 265 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5073, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5073, column 33. See page 237 of PBP. (Severity: 2) +Local lexical variable "$Side" is not all lower case or all upper case at line 5101, column 9. See pages 45,46 of PBP. (Severity: 1) +Quotes used with a noisy string at line 5145, column 26. See page 53 of PBP. (Severity: 2) +Postfix control "while" used at line 5145, column 34. See page 96 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5145, column 53. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5145, column 53. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5146, column 26. See page 53 of PBP. (Severity: 2) +Postfix control "while" used at line 5146, column 34. See page 96 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 5146, column 53. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5146, column 53. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5146, column 53. See page 237 of PBP. (Severity: 2) +Postfix control "while" used at line 5147, column 36. See page 96 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5147, column 55. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5147, column 55. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5148, column 26. See page 53 of PBP. (Severity: 2) +Postfix control "while" used at line 5148, column 34. See page 96 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5148, column 53. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5148, column 53. See page 237 of PBP. (Severity: 2) +Forbid $b before $a in sort blocks at line 5150, column 27. See page 152 of PBP. (Severity: 1) +Quotes used with a noisy string at line 5159, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5160, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5161, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5162, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5164, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5165, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5166, column 13. See page 53 of PBP. (Severity: 2) +Local lexical variable "$Side" is not all lower case or all upper case at line 5173, column 9. See pages 45,46 of PBP. (Severity: 1) +Quotes used with a noisy string at line 5260, column 53. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5260, column 58. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5261, column 55. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5261, column 60. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5262, column 55. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5262, column 60. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5263, column 55. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5263, column 60. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5264, column 57. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5264, column 62. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5266, column 57. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5266, column 62. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5268, column 57. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5268, column 62. See page 53 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 5279, column 21. See pages 54,55 of PBP. (Severity: 2) +Use only '//' or '{}' to delimit regexps at line 5282, column 21. See page 246 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5282, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5282, column 21. See page 237 of PBP. (Severity: 2) +Use only '//' or '{}' to delimit regexps at line 5283, column 21. See page 246 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5283, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5283, column 21. See page 237 of PBP. (Severity: 2) +Use only '//' or '{}' to delimit regexps at line 5284, column 21. See page 246 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5284, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5284, column 21. See page 237 of PBP. (Severity: 2) +Use only '//' or '{}' to delimit regexps at line 5285, column 21. See page 246 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5285, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5285, column 21. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 5285, column 30. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5285, column 49. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5285, column 74. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5294, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5295, column 11. See page 53 of PBP. (Severity: 2) +String *may* require interpolation at line 5329, column 18. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5330, column 48. See page 51 of PBP. (Severity: 1) +Quotes used with a noisy string at line 5341, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5342, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5357, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5358, column 11. See page 53 of PBP. (Severity: 2) +String *may* require interpolation at line 5361, column 18. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5364, column 18. See page 51 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5397, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5397, column 21. See page 237 of PBP. (Severity: 2) +Postfix control "unless" used at line 5403, column 11. See pages 96,97 of PBP. (Severity: 2) +Use 'eq' or hash instead of fixed-pattern regexps at line 5403, column 73. See pages 271,272 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5403, column 73. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5403, column 73. See page 237 of PBP. (Severity: 2) +Expression form of "eval" at line 5413, column 27. See page 161 of PBP. (Severity: 5) +Quotes used with a noisy string at line 5428, column 35. See page 53 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5438, column 49. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5438, column 49. See page 237 of PBP. (Severity: 2) +"unless" block used at line 5471, column 17. See page 97 of PBP. (Severity: 2) +Postfix control "if" used at line 5484, column 53. See pages 93,94 of PBP. (Severity: 2) +String *may* require interpolation at line 5550, column 13. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5550, column 52. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5556, column 13. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5556, column 45. See page 51 of PBP. (Severity: 1) +Single-quote used as quote-like operator delimiter at line 5557, column 24. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) +String *may* require interpolation at line 5557, column 24. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5558, column 47. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5558, column 73. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5562, column 13. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5562, column 47. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5565, column 13. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5565, column 53. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5565, column 92. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5566, column 13. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5566, column 53. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5567, column 22. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5569, column 24. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5578, column 24. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5584, column 24. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5585, column 12. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5594, column 24. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5595, column 84. See page 51 of PBP. (Severity: 1) +List declaration without trailing comma at line 5599, column 22. See page 17 of PBP. (Severity: 1) +String *may* require interpolation at line 5600, column 9. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5601, column 9. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5602, column 9. See page 51 of PBP. (Severity: 1) +List declaration without trailing comma at line 5615, column 22. See page 17 of PBP. (Severity: 1) +String *may* require interpolation at line 5616, column 9. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5617, column 9. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5618, column 9. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5623, column 28. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5626, column 27. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5632, column 9. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5636, column 24. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5642, column 24. See page 51 of PBP. (Severity: 1) +Expression form of "eval" at line 5658, column 27. See page 161 of PBP. (Severity: 5) +"unless" block used at line 5681, column 25. See page 97 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 5716, column 31. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5716, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5716, column 31. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 5719, column 49. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 5719, column 49. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5719, column 49. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5747, column 28. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5747, column 28. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5759, column 27. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5759, column 27. See page 237 of PBP. (Severity: 2) +Useless use of $_ at line 5761, column 60. $_ should be omitted when calling "lc". (Severity: 2) +Useless use of $_ at line 5761, column 82. $_ should be omitted when calling "lc". (Severity: 2) +Builtin function called with parentheses at line 5792, column 21. See page 13 of PBP. (Severity: 1) +String *may* require interpolation at line 5806, column 34. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5806, column 45. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5807, column 34. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 5807, column 45. See page 51 of PBP. (Severity: 1) +"unless" block used at line 5941, column 17. See page 97 of PBP. (Severity: 2) +"unless" block used at line 5942, column 17. See page 97 of PBP. (Severity: 2) +Postfix control "if" used at line 6009, column 22. See pages 93,94 of PBP. (Severity: 2) +Subroutine "copy_message" with high complexity score (25) at line 6036, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 6036, column 1. See page 182 of PBP. (Severity: 3) +Postfix control "if" used at line 6053, column 107. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 6103, column 26. See pages 93,94 of PBP. (Severity: 2) +Too many arguments at line 6120, column 1. See page 182 of PBP. (Severity: 3) +Subroutine "message_for_host2" with high complexity score (27) at line 6153, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 6153, column 1. See page 182 of PBP. (Severity: 3) +"unless" block used at line 6196, column 9. See page 97 of PBP. (Severity: 2) +Postfix control "if" used at line 6202, column 48. See pages 93,94 of PBP. (Severity: 2) +Local lexical variable "$imapT" is not all lower case or all upper case at line 6277, column 9. See pages 45,46 of PBP. (Severity: 1) +Quotes used with a string containing no non-whitespace characters at line 6284, column 21. See page 53 of PBP. (Severity: 2) +Constant "$NB_WIN_tests_message_for_host2" is not all upper case at line 6303, column 17. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 6304, column 75. See pages 93,94 of PBP. (Severity: 2) +Constant "$NB_UNX_tests_message_for_host2" is not all upper case at line 6312, column 17. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 6313, column 72. See pages 93,94 of PBP. (Severity: 2) +Use only '//' or '{}' to delimit regexps at line 6387, column 22. See page 246 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 6387, column 22. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6387, column 22. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 6392, column 44. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 6393, column 64. See pages 93,94 of PBP. (Severity: 2) +String *may* require interpolation at line 6417, column 70. See page 51 of PBP. (Severity: 1) +Too many arguments at line 6472, column 1. See page 182 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 6498, column 41. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6498, column 41. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 6516, column 75. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6516, column 75. See page 237 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 6558, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 6580, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 6582, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Useless interpolation of literal string at line 6595, column 26. See page 51 of PBP. (Severity: 1) +Postfix control "if" used at line 6668, column 43. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 6673, column 37. See pages 93,94 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 6796, column 23. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 6796, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6796, column 23. See page 237 of PBP. (Severity: 2) +Use [\[\]] instead of \[|\] at line 6820, column 23. See page 265 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 6820, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6820, column 23. See page 237 of PBP. (Severity: 2) +String *may* require interpolation at line 6923, column 22. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6923, column 54. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6923, column 79. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6924, column 21. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6924, column 45. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6947, column 40. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6952, column 16. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6953, column 16. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6954, column 18. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 6955, column 18. See page 51 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 6966, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6966, column 23. See page 237 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 7153, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Postfix control "if" used at line 7155, column 53. See pages 93,94 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 7161, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Postfix control "if" used at line 7172, column 55. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7176, column 61. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7177, column 59. See page 53 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 7190, column 129. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 7199, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 7200, column 1. Don't use whitespace at the end of lines. (Severity: 1) +String *may* require interpolation at line 7246, column 40. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 7246, column 53. See page 51 of PBP. (Severity: 1) +Quotes used with a noisy string at line 7321, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7331, column 32. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7332, column 32. See page 53 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 7350, column 28. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 7350, column 28. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 7350, column 28. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 7352, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 7352, column 20. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 7368, column 45. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 7373, column 46. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 7385, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 7385, column 20. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7393, column 45. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7394, column 53. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7395, column 61. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7398, column 61. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7399, column 67. See page 53 of PBP. (Severity: 2) +String *may* require interpolation at line 7439, column 24. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 7478, column 16. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 7748, column 16. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 7749, column 16. See page 51 of PBP. (Severity: 1) +Expression form of "eval" at line 7896, column 27. See page 161 of PBP. (Severity: 5) +String *may* require interpolation at line 7925, column 22. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 7933, column 22. See page 51 of PBP. (Severity: 1) +Numeric escapes in interpolated string at line 7935, column 28. See pages 54,55 of PBP. (Severity: 2) +String *may* require interpolation at line 7935, column 38. See page 51 of PBP. (Severity: 1) +Numeric escapes in interpolated string at line 7940, column 28. See pages 54,55 of PBP. (Severity: 2) +String *may* require interpolation at line 7947, column 23. See page 51 of PBP. (Severity: 1) +Expression form of "eval" at line 8135, column 27. See page 161 of PBP. (Severity: 5) +Builtin function called with parentheses at line 8189, column 16. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 8248, column 76. See pages 93,94 of PBP. (Severity: 2) +Subroutine "diff_or_NA" is not all lower case or all upper case at line 8306, column 1. See pages 45,46 of PBP. (Severity: 1) +Use named character classes ([0-9] vs. \d) at line 8327, column 21. See page 248 of PBP. (Severity: 1) +Use character classes for literal metachars instead of escapes at line 8327, column 21. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 8327, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8327, column 21. See page 237 of PBP. (Severity: 2) +Subroutine "tests_diff_or_NA" is not all lower case or all upper case at line 8354, column 1. See pages 45,46 of PBP. (Severity: 1) +Too many arguments at line 8398, column 1. See page 182 of PBP. (Severity: 3) +Postfix control "unless" used at line 8435, column 34. See pages 96,97 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8472, column 51. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8472, column 51. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8487, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8487, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8490, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8490, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8493, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8493, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8496, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8496, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8499, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8499, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8502, column 97. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8502, column 97. See page 237 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 8522, column 58. See pages 54,55 of PBP. (Severity: 2) +Return value of "close" ignored at line 8545, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 8545, column 9. See pages 208,278 of PBP. (Severity: 1) +Return value of "close" ignored at line 8578, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 8578, column 9. See pages 208,278 of PBP. (Severity: 1) +Quotes used with a noisy string at line 8588, column 29. See page 53 of PBP. (Severity: 2) +Return value of "close" ignored at line 8612, column 3. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 8612, column 3. See pages 208,278 of PBP. (Severity: 1) +Quotes used with a noisy string at line 8626, column 39. See page 53 of PBP. (Severity: 2) +Constant "$NB_UNX_tests_string_to_file" is not all upper case at line 8632, column 17. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 8633, column 69. See pages 93,94 of PBP. (Severity: 2) +Builtin function called with parentheses at line 8651, column 16. See page 13 of PBP. (Severity: 1) +File handle for "print" or "printf" is not braced at line 8655, column 9. See page 217 of PBP. (Severity: 1) +Return value of flagged function ignored - print at line 8655, column 9. See pages 208,278 of PBP. (Severity: 1) +Return value of "close" ignored at line 8656, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 8656, column 9. See pages 208,278 of PBP. (Severity: 1) +Literal line breaks in a string at line 8660, column 1. See pages 60,61 of PBP. (Severity: 3) +String *may* require interpolation at line 8660, column 1. See page 51 of PBP. (Severity: 1) +Postfix control "if" used at line 8674, column 3. See pages 93,94 of PBP. (Severity: 2) +Backtick operator used at line 8684, column 17. Use IPC::Open3 instead. (Severity: 3) +Builtin function called with parentheses at line 8687, column 17. See page 13 of PBP. (Severity: 1) +Builtin function called with parentheses at line 8689, column 34. See page 13 of PBP. (Severity: 1) +Constant "$NB_WIN_tests_pipemess" is not all upper case at line 8724, column 17. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 8725, column 66. See pages 93,94 of PBP. (Severity: 2) +Local lexical variable "$stringT" is not all lower case or all upper case at line 8737, column 9. See pages 45,46 of PBP. (Severity: 1) +Local lexical variable "$errorT" is not all lower case or all upper case at line 8737, column 9. See pages 45,46 of PBP. (Severity: 1) +Constant "$NB_UNX_tests_pipemess" is not all upper case at line 8740, column 17. See pages 45,46 of PBP. (Severity: 1) +Postfix control "if" used at line 8741, column 63. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8772, column 32. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8772, column 32. See pages 240,241 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8776, column 32. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8776, column 32. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8786, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8791, column 33. See pages 240,241 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8795, column 33. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8795, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8799, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8800, column 33. See pages 240,241 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8806, column 24. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8806, column 24. See pages 240,241 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 8830, column 28. See page 247 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 8830, column 28. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8830, column 28. See page 237 of PBP. (Severity: 2) +File handle for "print" or "printf" is not braced at line 8847, column 9. See page 217 of PBP. (Severity: 1) +Return value of flagged function ignored - print at line 8847, column 9. See pages 208,278 of PBP. (Severity: 1) +Return value of "close" ignored at line 8852, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 8852, column 9. See pages 208,278 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 8891, column 36. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8891, column 36. See page 237 of PBP. (Severity: 2) +Useless interpolation of literal string at line 8928, column 6. See page 51 of PBP. (Severity: 1) +Use character classes for literal metachars instead of escapes at line 8941, column 35. See page 247 of PBP. (Severity: 1) +Use character classes for literal metachars instead of escapes at line 8944, column 39. See page 247 of PBP. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 8960, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 8981, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Reused variable name in lexical scope: $version at line 8982, column 9. Invent unique variable names. (Severity: 3) +Use character classes for literal metachars instead of escapes at line 8984, column 22. See page 247 of PBP. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 8987, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Regular expression without "/s" flag at line 8995, column 36. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8995, column 36. See page 237 of PBP. (Severity: 2) +Useless interpolation of literal string at line 9012, column 13. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 9012, column 39. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 9027, column 27. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 9039, column 12. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 9041, column 22. See page 51 of PBP. (Severity: 1) +Backtick operator used at line 9047, column 17. Use IPC::Open3 instead. (Severity: 3) +Builtin function called with parentheses at line 9048, column 3. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 9072, column 33. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9080, column 32. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9090, column 34. See pages 93,94 of PBP. (Severity: 2) +Return value of eval not tested at line 9139, column 3. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Backtick operator used at line 9140, column 15. Use IPC::Open3 instead. (Severity: 3) +Split long regexps into smaller qr// chunks at line 9149, column 16. See page 261 of PBP. (Severity: 3) +Use character classes for literal metachars instead of escapes at line 9149, column 16. See page 247 of PBP. (Severity: 1) +Return value of eval not tested at line 9162, column 3. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Capture variable used outside conditional at line 9173, column 12. See page 253 of PBP. (Severity: 3) +Builtin function called with parentheses at line 9236, column 3. See page 13 of PBP. (Severity: 1) +Useless interpolation of literal string at line 9236, column 12. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 9236, column 42. See page 51 of PBP. (Severity: 1) +Backtick operator used at line 9274, column 26. Use IPC::Open3 instead. (Severity: 3) +Backtick operator used at line 9296, column 18. Use IPC::Open3 instead. (Severity: 3) +String delimiter used with "split" at line 9301, column 42. Express it as a regex instead. (Severity: 2) +Quotes used with a noisy string at line 9301, column 48. See page 53 of PBP. (Severity: 2) +Return value of eval not tested at line 9325, column 2. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Builtin function called with parentheses at line 9330, column 2. See page 13 of PBP. (Severity: 1) +Builtin function called with parentheses at line 9340, column 11. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 9351, column 47. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9368, column 44. See pages 93,94 of PBP. (Severity: 2) +Subroutine "remove_Ko" is not all lower case or all upper case at line 9412, column 1. See pages 45,46 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 9414, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9414, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9423, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9423, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9443, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9443, column 19. See page 237 of PBP. (Severity: 2) +Use character classes for literal metachars instead of escapes at line 9478, column 20. See page 247 of PBP. (Severity: 1) +Use [\+-] instead of \+|- at line 9478, column 20. See page 265 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 9478, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9478, column 20. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9481, column 30. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9482, column 36. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9487, column 19. See page 261 of PBP. (Severity: 3) +Use character classes for literal metachars instead of escapes at line 9487, column 19. See page 247 of PBP. (Severity: 1) +Use [:\.] instead of :|\ at line 9487, column 19. See page 265 of PBP. (Severity: 1) +Use [:\.] instead of :|\ at line 9487, column 19. See page 265 of PBP. (Severity: 1) +Use [\+-] instead of \+|- at line 9487, column 19. See page 265 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 9487, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9487, column 19. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9499, column 38. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9499, column 72. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9499, column 72. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9500, column 38. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9502, column 46. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9506, column 30. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9508, column 33. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9513, column 19. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 9513, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9513, column 19. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9530, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9530, column 19. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9542, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9542, column 19. See page 237 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9554, column 19. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 9554, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9554, column 19. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9560, column 29. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9566, column 19. See page 261 of PBP. (Severity: 3) +Use character classes for literal metachars instead of escapes at line 9566, column 19. See page 247 of PBP. (Severity: 1) +Use [\+-] instead of \+|- at line 9566, column 19. See page 265 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 9566, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9566, column 19. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9577, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9577, column 19. See page 237 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 9686, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Quotes used with a noisy string at line 9692, column 26. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9693, column 26. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9699, column 26. See page 53 of PBP. (Severity: 2) +Return value of flagged function ignored - print at line 9724, column 3. See pages 208,278 of PBP. (Severity: 1) +Hard tabs used at line 9748, column 84. See page 20 of PBP. (Severity: 3) +Found "\t" at the end of the line at line 9748, column 84. Don't use whitespace at the end of lines. (Severity: 1) +Quotes used with a noisy string at line 9753, column 29. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9754, column 29. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9759, column 29. See page 53 of PBP. (Severity: 2) +Return value of flagged function ignored - print at line 9777, column 3. See pages 208,278 of PBP. (Severity: 1) +Expression form of "eval" at line 9789, column 56. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 9793, column 58. See page 161 of PBP. (Severity: 5) +Postfix control "if" used at line 9798, column 48. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9799, column 50. See pages 93,94 of PBP. (Severity: 2) +Local lexical variable "$Side" is not all lower case or all upper case at line 9810, column 9. See pages 45,46 of PBP. (Severity: 1) +Local lexical variable "$Side" is not all lower case or all upper case at line 9897, column 9. See pages 45,46 of PBP. (Severity: 1) +Local lexical variable "$syncT" is not all lower case or all upper case at line 9913, column 9. See pages 45,46 of PBP. (Severity: 1) +Local lexical variable "$imapT" is not all lower case or all upper case at line 9915, column 9. See pages 45,46 of PBP. (Severity: 1) +Local lexical variable "$syncT" is not all lower case or all upper case at line 10017, column 9. See pages 45,46 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 10038, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10038, column 33. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10080, column 26. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10080, column 26. See page 237 of PBP. (Severity: 2) +Use 'eq' or hash instead of fixed-pattern regexps at line 10084, column 36. See pages 271,272 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10084, column 36. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10084, column 36. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10086, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10086, column 31. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10092, column 34. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10092, column 34. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 10095, column 68. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 10248, column 20. See page 261 of PBP. (Severity: 3) +Use named character classes ([A-Z] vs. [[:upper:]]) at line 10248, column 20. See page 248 of PBP. (Severity: 1) +Use character classes for literal metachars instead of escapes at line 10248, column 20. See page 247 of PBP. (Severity: 1) +Use [\+-] instead of \+|- at line 10248, column 20. See page 265 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 10248, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10248, column 20. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 10254, column 28. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10254, column 33. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 10255, column 36. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10255, column 41. See page 53 of PBP. (Severity: 2) +Local lexical variable "$header_Message_Id" is not all lower case or all upper case at line 10277, column 9. See pages 45,46 of PBP. (Severity: 1) +String *may* require interpolation at line 10277, column 65. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10288, column 43. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10289, column 45. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10290, column 49. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10292, column 45. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10293, column 47. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10294, column 48. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10295, column 57. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10296, column 51. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10298, column 53. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10299, column 55. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10300, column 103. See page 51 of PBP. (Severity: 1) +Postfix control "if" used at line 10327, column 65. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10382, column 23. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 10418, column 80. See pages 93,94 of PBP. (Severity: 2) +Postfix control "unless" used at line 10421, column 32. See pages 96,97 of PBP. (Severity: 2) +Postfix control "unless" used at line 10431, column 30. See pages 96,97 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10448, column 34. See page 53 of PBP. (Severity: 2) +Useless interpolation of literal string at line 10453, column 23. See page 51 of PBP. (Severity: 1) +Builtin function called with parentheses at line 10453, column 41. See page 13 of PBP. (Severity: 1) +Magic variable "*STDERR" should be assigned as "local" at line 10509, column 17. See pages 81,82 of PBP. (Severity: 4) +Double-sigil dereference at line 10509, column 19. See page 228 of PBP. (Severity: 2) +One-argument "select" used at line 10510, column 9. See page 224 of PBP. (Severity: 4) +Ambiguously named variable "last" at line 10529, column 2. See page 48 of PBP. (Severity: 3) +Found "\N{SPACE}" at the end of the line at line 10554, column 27. Don't use whitespace at the end of lines. (Severity: 1) +Builtin function called with parentheses at line 10560, column 21. See page 13 of PBP. (Severity: 1) +Postfix control "if" used at line 10580, column 45. See pages 93,94 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 10636, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10651, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10671, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Useless interpolation of literal string at line 10677, column 20. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10702, column 19. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10720, column 19. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 10741, column 21. See page 51 of PBP. (Severity: 1) +Found "\t" at the end of the line at line 10748, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Quotes used with a string containing no non-whitespace characters at line 10751, column 21. See page 53 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 10756, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10766, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10767, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10776, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 10783, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 10784, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 10785, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10789, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10795, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Quotes used with a string containing no non-whitespace characters at line 10798, column 50. See page 53 of PBP. (Severity: 2) +Useless interpolation of literal string at line 10798, column 50. See page 51 of PBP. (Severity: 1) +Reused variable name in lexical scope: $err at line 10806, column 3. Invent unique variable names. (Severity: 3) +Found "\t" at the end of the line at line 10817, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10823, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Quotes used with a string containing no non-whitespace characters at line 10826, column 24. See page 53 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 10831, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10841, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10842, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10849, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10856, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 10862, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Quotes used with a string containing no non-whitespace characters at line 10865, column 50. See page 53 of PBP. (Severity: 2) +Useless interpolation of literal string at line 10865, column 50. See page 51 of PBP. (Severity: 1) +Reused variable name in lexical scope: $err at line 10873, column 3. Invent unique variable names. (Severity: 3) +Found "\t" at the end of the line at line 10881, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Builtin function called with parentheses at line 10928, column 12. See page 13 of PBP. (Severity: 1) +Builtin function called with parentheses at line 10944, column 19. See page 13 of PBP. (Severity: 1) +Useless interpolation of literal string at line 10944, column 28. See page 51 of PBP. (Severity: 1) +Hard tabs used at line 10944, column 44. See page 20 of PBP. (Severity: 3) +Found "\t" at the end of the line at line 10944, column 44. Don't use whitespace at the end of lines. (Severity: 1) +Useless interpolation of literal string at line 11060, column 13. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 11060, column 40. See page 51 of PBP. (Severity: 1) +Quotes used with a noisy string at line 11062, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 11062, column 35. See page 53 of PBP. (Severity: 2) +Useless interpolation of literal string at line 11064, column 13. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 11064, column 42. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 11065, column 13. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 11065, column 44. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11067, column 59. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11068, column 78. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11069, column 82. See page 51 of PBP. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11077, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11085, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Close filehandles as soon as possible after opening them at line 11091, column 9. See page 209 of PBP. (Severity: 4) +Useless interpolation of literal string at line 11091, column 32. See page 51 of PBP. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11091, column 61. Don't use whitespace at the end of lines. (Severity: 1) +"warn" used instead of "carp" at line 11092, column 17. See page 283 of PBP. (Severity: 3) +Found "\N{SPACE}" at the end of the line at line 11095, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11096, column 19. Don't use whitespace at the end of lines. (Severity: 1) +Return value of "close" ignored at line 11105, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of flagged function ignored - close at line 11105, column 9. See pages 208,278 of PBP. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11106, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Builtin function called with parentheses at line 11110, column 18. See page 13 of PBP. (Severity: 1) +Regular expression without "/s" flag at line 11117, column 40. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 11117, column 40. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 11117, column 40. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11119, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 11119, column 23. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 11119, column 23. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11120, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 11120, column 23. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 11120, column 23. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11121, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 11121, column 23. See page 237 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 11127, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Postfix control "if" used at line 11134, column 52. See pages 93,94 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 11136, column 18. Don't use whitespace at the end of lines. (Severity: 1) +Literal line breaks in a string at line 11137, column 9. See pages 60,61 of PBP. (Severity: 3) +Subroutine "myGetOptions" is not all lower case or all upper case at line 11174, column 1. See pages 45,46 of PBP. (Severity: 1) +Subroutine "myGetOptions" with high complexity score (27) at line 11174, column 1. Consider refactoring. (Severity: 3) +Use character classes for literal metachars instead of escapes at line 11195, column 22. See page 247 of PBP. (Severity: 1) +String delimiter used with "split" at line 11201, column 21. Express it as a regex instead. (Severity: 2) +Quotes used with a noisy string at line 11201, column 27. See page 53 of PBP. (Severity: 2) +Capture variable used outside conditional at line 11201, column 32. See page 253 of PBP. (Severity: 3) +Quotes used with a noisy string at line 11203, column 28. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 11209, column 32. See page 53 of PBP. (Severity: 2) +Useless use of $_ at line 11210, column 36. $_ should be omitted when calling "split" with two arguments. (Severity: 2) +Useless use of $_ at line 11230, column 37. $_ should be omitted when calling "int". (Severity: 2) +Quotes used with a noisy string at line 11234, column 36. See page 53 of PBP. (Severity: 2) +Useless interpolation of literal string at line 11276, column 35. See page 51 of PBP. (Severity: 1) +Useless interpolation of literal string at line 11277, column 35. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11308, column 29. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11310, column 44. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11317, column 37. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11322, column 41. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11325, column 48. See page 51 of PBP. (Severity: 1) +String *may* require interpolation at line 11336, column 33. See page 51 of PBP. (Severity: 1) +Numeric escapes in interpolated string at line 11400, column 27. See pages 54,55 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11402, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 11402, column 23. See page 237 of PBP. (Severity: 2) +Found "\t" at the end of the line at line 11617, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 11622, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 11645, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 11665, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 11667, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 11701, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11704, column 25. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 11706, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11710, column 31. Don't use whitespace at the end of lines. (Severity: 1) +Double-sigil dereference at line 11712, column 17. See page 228 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 11714, column 31. Don't use whitespace at the end of lines. (Severity: 1) +Double-sigil dereference at line 11716, column 18. See page 228 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 11718, column 31. Don't use whitespace at the end of lines. (Severity: 1) +Double-sigil dereference at line 11721, column 3. See page 228 of PBP. (Severity: 2) +Found "\N{SPACE}" at the end of the line at line 11721, column 21. Don't use whitespace at the end of lines. (Severity: 1) +Found "\N{SPACE}" at the end of the line at line 11730, column 51. Don't use whitespace at the end of lines. (Severity: 1) +Found "\t" at the end of the line at line 11733, column 1. Don't use whitespace at the end of lines. (Severity: 1) +Postfix control "if" used at line 11819, column 46. See pages 93,94 of PBP. (Severity: 2) - 1 files. - 263 subroutines/methods. -8,603 statements. + 1 files. + 367 subroutines/methods. +11,872 statements. -9,486 lines, consisting of: - 1,684 blank lines. - 551 comment lines. +11,937 lines, consisting of: + 2,225 blank lines. + 764 comment lines. 0 data lines. - 6,579 lines of Perl code. - 672 lines of POD. + 8,314 lines of Perl code. + 634 lines of POD. -Average McCabe score of subroutines was 4.35. +Average McCabe score of subroutines was 4.10. -858 violations. -Violations per file was 858.000. -Violations per statement was 0.100. -Violations per line of code was 0.090. +854 violations. +Violations per file was 854.000. +Violations per statement was 0.072. +Violations per line of code was 0.072. 6 severity 5 violations. - 5 severity 4 violations. -120 severity 3 violations. -475 severity 2 violations. -252 severity 1 violations. + 8 severity 4 violations. + 62 severity 3 violations. +426 severity 2 violations. +352 severity 1 violations. 1 violations of BuiltinFunctions::ProhibitReverseSortBlock. 6 violations of BuiltinFunctions::ProhibitStringyEval. 2 violations of BuiltinFunctions::ProhibitStringySplit. - 12 violations of CodeLayout::ProhibitParensWithBuiltins. - 57 violations of CodeLayout::ProhibitTrailingWhitespace. + 6 violations of BuiltinFunctions::ProhibitUselessTopic. + 2 violations of CodeLayout::ProhibitHardTabs. + 27 violations of CodeLayout::ProhibitParensWithBuiltins. + 85 violations of CodeLayout::ProhibitTrailingWhitespace. 1 violations of CodeLayout::RequireTidyCode. 2 violations of CodeLayout::RequireTrailingCommas. 1 violations of ControlStructures::ProhibitDeepNests. -109 violations of ControlStructures::ProhibitPostfixControls. - 19 violations of ControlStructures::ProhibitUnlessBlocks. +105 violations of ControlStructures::ProhibitPostfixControls. + 7 violations of ControlStructures::ProhibitUnlessBlocks. 1 violations of Documentation::PodSpelling. 1 violations of Documentation::RequirePodAtEnd. - 3 violations of Documentation::RequirePodSections. + 4 violations of Documentation::RequirePodSections. 1 violations of ErrorHandling::RequireCarping. - 1 violations of ErrorHandling::RequireCheckingReturnValueOfEval. - 4 violations of InputOutput::ProhibitBacktickOperators. + 3 violations of ErrorHandling::RequireCheckingReturnValueOfEval. + 6 violations of InputOutput::ProhibitBacktickOperators. + 1 violations of InputOutput::ProhibitExplicitStdin. 1 violations of InputOutput::ProhibitJoinedReadline. 1 violations of InputOutput::ProhibitOneArgSelect. - 3 violations of InputOutput::RequireBracedFileHandleWithPrint. - 2 violations of InputOutput::RequireBriefOpen. - 7 violations of InputOutput::RequireCheckedClose. - 12 violations of InputOutput::RequireCheckedSyscalls. + 4 violations of InputOutput::RequireBracedFileHandleWithPrint. + 1 violations of InputOutput::RequireBriefOpen. + 10 violations of InputOutput::RequireCheckedClose. + 19 violations of InputOutput::RequireCheckedSyscalls. 1 violations of Modules::ProhibitExcessMainComplexity. - 1 violations of Modules::ProhibitMultiplePackages. - 35 violations of NamingConventions::Capitalization. - 1 violations of References::ProhibitDoubleSigils. - 1 violations of RegularExpressions::ProhibitCaptureWithoutTest. - 9 violations of RegularExpressions::ProhibitComplexRegexes. + 33 violations of NamingConventions::Capitalization. + 1 violations of NamingConventions::ProhibitAmbiguousNames. + 4 violations of References::ProhibitDoubleSigils. + 2 violations of RegularExpressions::ProhibitCaptureWithoutTest. + 10 violations of RegularExpressions::ProhibitComplexRegexes. 3 violations of RegularExpressions::ProhibitEnumeratedClasses. - 21 violations of RegularExpressions::ProhibitEscapedMetacharacters. + 27 violations of RegularExpressions::ProhibitEscapedMetacharacters. 3 violations of RegularExpressions::ProhibitFixedStringMatches. 8 violations of RegularExpressions::ProhibitSingleCharAlternation. - 5 violations of RegularExpressions::ProhibitUnusualDelimiters. -100 violations of RegularExpressions::RequireDotMatchAnything. - 44 violations of RegularExpressions::RequireExtendedFormatting. -100 violations of RegularExpressions::RequireLineBoundaryMatching. - 5 violations of Subroutines::ProhibitExcessComplexity. + 6 violations of RegularExpressions::ProhibitUnusualDelimiters. + 98 violations of RegularExpressions::RequireDotMatchAnything. + 13 violations of RegularExpressions::RequireExtendedFormatting. + 90 violations of RegularExpressions::RequireLineBoundaryMatching. + 4 violations of Subroutines::ProhibitExcessComplexity. 11 violations of Subroutines::ProhibitManyArgs. - 1 violations of ValuesAndExpressions::ProhibitEmptyQuotes. + 4 violations of TestingAndDebugging::ProhibitNoWarnings. + 12 violations of ValuesAndExpressions::ProhibitEmptyQuotes. 6 violations of ValuesAndExpressions::ProhibitEscapedCharacters. - 1 violations of ValuesAndExpressions::ProhibitImplicitNewlines. - 2 violations of ValuesAndExpressions::ProhibitInterpolationOfLiterals. + 2 violations of ValuesAndExpressions::ProhibitImplicitNewlines. + 28 violations of ValuesAndExpressions::ProhibitInterpolationOfLiterals. 10 violations of ValuesAndExpressions::ProhibitMagicNumbers. - 56 violations of ValuesAndExpressions::ProhibitNoisyQuotes. - 16 violations of ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters. - 88 violations of ValuesAndExpressions::RequireInterpolationOfMetachars. - 22 violations of ValuesAndExpressions::RequireNumberSeparators. - 36 violations of Variables::ProhibitPunctuationVars. - 22 violations of Variables::ProhibitReusedNames. - 2 violations of Variables::ProhibitUnusedVariables. + 68 violations of ValuesAndExpressions::ProhibitNoisyQuotes. + 1 violations of ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters. +106 violations of ValuesAndExpressions::RequireInterpolationOfMetachars. + 1 violations of Variables::ProhibitPunctuationVars. + 3 violations of Variables::ProhibitReusedNames. 1 violations of Variables::RequireLocalizedPunctuationVars. diff --git a/W/perlcritic_2.out b/W/perlcritic_2.out index 49d5616..699b27d 100644 --- a/W/perlcritic_2.out +++ b/W/perlcritic_2.out @@ -1,665 +1,563 @@ -Main code has high complexity score (401) at line 1, column 1. Consider refactoring. (Severity: 3) +Main code has high complexity score (392) at line 1, column 1. Consider refactoring. (Severity: 3) +Missing "REQUIRED ARGUMENTS" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) Missing "DIAGNOSTICS" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) Missing "DEPENDENCIES" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) Missing "INCOMPATIBILITIES" section in POD at line 18, column 1. See pages 133,138 of PBP. (Severity: 2) -Magic punctuation variable $| used at line 698, column 3. See page 79 of PBP. (Severity: 2) -Long number not separated with underscores at line 780, column 33. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 799, column 34. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 803, column 37. See page 59 of PBP. (Severity: 2) -"$ssl1_ssl_version" is declared but not used at line 814, column 1. Unused variables clutter code and make it harder to read. (Severity: 3) -"$ssl2_ssl_version" is declared but not used at line 814, column 1. Unused variables clutter code and make it harder to read. (Severity: 3) -Magic punctuation variable $! used in interpolated string at line 966, column 47. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 967, column 32. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 971, column 17. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1010, column 119. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1044, column 15. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1045, column 21. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1051, column 25. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1059, column 24. See pages 93,94 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 1068, column 40. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 1106, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1118, column 31. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1119, column 12. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1133, column 5. See pages 93,94 of PBP. (Severity: 2) -Postfix control "unless" used at line 1252, column 40. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 1302, column 22. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1303, column 22. See pages 93,94 of PBP. (Severity: 2) -Postfix control "unless" used at line 1380, column 43. See pages 96,97 of PBP. (Severity: 2) -Postfix control "unless" used at line 1382, column 43. See pages 96,97 of PBP. (Severity: 2) -Single-quote used as quote-like operator delimiter at line 1442, column 3. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 1443, column 3. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Regular expression without "/s" flag at line 1481, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 1481, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 1481, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 1490, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 1490, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 1490, column 33. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 1596, column 3. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1631, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1632, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1641, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1649, column 34. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1711, column 3. See page 97 of PBP. (Severity: 2) -"unless" block used at line 1717, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1793, column 57. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1803, column 77. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1811, column 5. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1816, column 3. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1819, column 2. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1856, column 79. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1865, column 3. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1870, column 3. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1900, column 10. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1920, column 32. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1921, column 4. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1929, column 39. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1933, column 38. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1942, column 4. See page 97 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 1945, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 1945, column 31. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 1947, column 7. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1948, column 31. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1949, column 5. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1957, column 51. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1958, column 4. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 1967, column 39. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 1971, column 38. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 1980, column 4. See page 97 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 1982, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 1982, column 31. See page 237 of PBP. (Severity: 2) -"unless" block used at line 1983, column 5. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 2012, column 69. See pages 93,94 of PBP. (Severity: 2) -Code structure is deeply nested at line 2013, column 41. Consider refactoring. (Severity: 3) -"unless" block used at line 2013, column 41. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 2024, column 39. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 2028, column 38. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 2125, column 3. See page 97 of PBP. (Severity: 2) -"unless" block used at line 2129, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "unless" used at line 2159, column 20. See pages 96,97 of PBP. (Severity: 2) -Postfix control "unless" used at line 2160, column 20. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 2163, column 66. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 2164, column 41. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 2165, column 40. See pages 93,94 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 2255, column 2. Invent unique variable names. (Severity: 3) -Quotes used with a noisy string at line 2351, column 37. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 2351, column 48. See page 53 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 2365, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/s" flag at line 2414, column 29. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2414, column 29. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2414, column 29. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 2436, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2436, column 31. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2436, column 31. See page 237 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 2445, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2468, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/s" flag at line 2501, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2501, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2501, column 30. See page 237 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 2512, column 53. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2520, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2570, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/s" flag at line 2607, column 26. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 2607, column 26. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 2607, column 26. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 2621, column 25. See pages 93,94 of PBP. (Severity: 2) -Too many arguments at line 2727, column 1. See page 182 of PBP. (Severity: 3) -Too many arguments at line 2745, column 1. See page 182 of PBP. (Severity: 3) -Too many arguments at line 2755, column 1. See page 182 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 2801, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 2801, column 17. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 2817, column 61. See pages 93,94 of PBP. (Severity: 2) -Subroutine "modulesversion" with high complexity score (27) at line 2868, column 1. Consider refactoring. (Severity: 3) -Regular expression without "/s" flag at line 2966, column 16. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 2966, column 16. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 2996, column 45. See page 53 of PBP. (Severity: 2) -Too many arguments at line 3075, column 1. See page 182 of PBP. (Severity: 3) -Magic punctuation variable $@ used in interpolated string at line 3085, column 18. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 3115, column 17. See page 79 of PBP. (Severity: 2) -Subroutine "authenticate_imap" with high complexity score (21) at line 3144, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 3144, column 1. See page 182 of PBP. (Severity: 3) -Postfix control "unless" used at line 3158, column 51. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 3162, column 33. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3163, column 33. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3164, column 35. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3166, column 32. See pages 93,94 of PBP. (Severity: 2) -"unless" block used at line 3170, column 2. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 3238, column 45. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 3262, column 45. See pages 93,94 of PBP. (Severity: 2) -Too many arguments at line 3274, column 1. See page 182 of PBP. (Severity: 3) -Postfix control "if" used at line 3298, column 43. See pages 93,94 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 3311, column 32. See pages 54,55 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3358, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3358, column 32. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3358, column 32. See page 237 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 3362, column 60. See page 79 of PBP. (Severity: 2) -Use "local $/ = undef" or File::Slurp instead of joined readline at line 3363, column 43. See page 213 of PBP. (Severity: 3) -Return value of "close" ignored at line 3364, column 13. Check the return value of "close" for success. (Severity: 2) -Regular expression without "/s" flag at line 3373, column 69. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3373, column 69. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3373, column 69. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 3376, column 37. See pages 93,94 of PBP. (Severity: 2) -Backtick operator used at line 3381, column 20. Use IPC::Open3 instead. (Severity: 3) -"unless" block used at line 3406, column 9. See page 97 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3440, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 3440, column 32. See page 237 of PBP. (Severity: 2) -Magic punctuation variable $0 used in interpolated string at line 3514, column 3. See page 79 of PBP. (Severity: 2) -Return value of eval not tested at line 3538, column 2. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) -Quotes used with a noisy string at line 3539, column 11. See page 53 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 3539, column 11. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 3539, column 18. See pages 93,94 of PBP. (Severity: 2) -Magic punctuation variable $@ used at line 3539, column 23. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 3547, column 68. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 3548, column 32. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 3551, column 32. See page 53 of PBP. (Severity: 2) -Return value of "close" ignored at line 3578, column 2. Check the return value of "close" for success. (Severity: 2) -Return value of "close" ignored at line 3598, column 17. Check the return value of "close" for success. (Severity: 2) -"die" used instead of "croak" at line 3606, column 2. See page 283 of PBP. (Severity: 3) -Magic punctuation variable $0 used in interpolated string at line 3611, column 13. See page 79 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3714, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3714, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3714, column 15. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3715, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3715, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3715, column 15. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3716, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3716, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3716, column 15. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3725, column 8. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3725, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3725, column 8. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3726, column 8. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3726, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3726, column 8. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3727, column 8. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3727, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3727, column 8. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3770, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3770, column 31. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3770, column 31. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3857, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3857, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3857, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 3860, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 3860, column 20. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 3860, column 20. See page 237 of PBP. (Severity: 2) -Postfix control "unless" used at line 4057, column 18. See pages 96,97 of PBP. (Severity: 2) -Use 'eq' or hash instead of fixed-pattern regexps at line 4061, column 24. See pages 271,272 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4061, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4061, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4061, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4062, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4062, column 19. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4062, column 19. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4066, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4066, column 19. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4066, column 19. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4136, column 12. See page 53 of PBP. (Severity: 2) -Postfix control "while" used at line 4136, column 20. See page 96 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4136, column 39. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4136, column 39. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4136, column 39. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4137, column 12. See page 53 of PBP. (Severity: 2) -Postfix control "while" used at line 4137, column 20. See page 96 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4137, column 39. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4137, column 39. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4137, column 39. See page 237 of PBP. (Severity: 2) -Postfix control "while" used at line 4138, column 22. See page 96 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4138, column 41. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 4138, column 41. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 4138, column 41. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4147, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4148, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4149, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4150, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4241, column 46. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4241, column 51. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4242, column 48. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4242, column 53. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4243, column 48. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4243, column 53. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4244, column 48. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4244, column 53. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4245, column 50. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4245, column 55. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4247, column 50. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4247, column 55. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4249, column 50. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4249, column 55. See page 53 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 4259, column 14. See pages 54,55 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4262, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4262, column 14. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4263, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4263, column 14. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4264, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4264, column 14. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4265, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4265, column 21. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 4265, column 30. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4265, column 49. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4265, column 74. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4273, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4274, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4320, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4321, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4336, column 11. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4337, column 11. See page 53 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4375, column 14. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4375, column 14. See page 237 of PBP. (Severity: 2) -Postfix control "unless" used at line 4381, column 4. See pages 96,97 of PBP. (Severity: 2) -Use 'eq' or hash instead of fixed-pattern regexps at line 4381, column 66. See pages 271,272 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4381, column 66. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4381, column 66. See page 237 of PBP. (Severity: 2) -Expression form of "eval" at line 4391, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 4393, column 48. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4394, column 15. See page 79 of PBP. (Severity: 2) -Quotes used with a noisy string at line 4404, column 28. See page 53 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4412, column 42. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4412, column 42. See page 237 of PBP. (Severity: 2) -"unless" block used at line 4445, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 4458, column 39. See pages 93,94 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4464, column 53. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4472, column 53. See page 79 of PBP. (Severity: 2) -Single-quote used as quote-like operator delimiter at line 4522, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4522, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4528, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4528, column 38. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4529, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4530, column 39. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4534, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4534, column 40. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4537, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4538, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4539, column 22. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4541, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4550, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4556, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Expression form of "eval" at line 4629, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 4631, column 45. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4632, column 13. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4643, column 17. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4645, column 17. See page 79 of PBP. (Severity: 2) -"unless" block used at line 4652, column 4. See page 97 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 4655, column 19. See page 79 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4684, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4684, column 17. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4687, column 28. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4687, column 28. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4712, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4712, column 21. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 4724, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 4724, column 20. See page 237 of PBP. (Severity: 2) -"unless" block used at line 4899, column 3. See page 97 of PBP. (Severity: 2) -"unless" block used at line 4900, column 3. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 4963, column 22. See pages 93,94 of PBP. (Severity: 2) -Subroutine "copy_message" with high complexity score (25) at line 4990, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 4990, column 1. See page 182 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 4993, column 2. Invent unique variable names. (Severity: 3) -Postfix control "if" used at line 5007, column 100. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 5057, column 19. See pages 93,94 of PBP. (Severity: 2) -Too many arguments at line 5074, column 1. See page 182 of PBP. (Severity: 3) -Subroutine "message_for_host2" with high complexity score (27) at line 5107, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 5107, column 1. See page 182 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 5129, column 2. Invent unique variable names. (Severity: 3) -"unless" block used at line 5150, column 2. See page 97 of PBP. (Severity: 2) -Postfix control "if" used at line 5156, column 34. See pages 93,94 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 5223, column 9. Invent unique variable names. (Severity: 3) -9 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5235, column 21. Unnamed numeric literals make code less maintainable. (Severity: 2) -Quotes used with a string containing no non-whitespace characters at line 5236, column 21. See page 53 of PBP. (Severity: 2) -Reused variable name in lexical scope: $string_ref at line 5242, column 25. Invent unique variable names. (Severity: 3) -9 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5247, column 13. Unnamed numeric literals make code less maintainable. (Severity: 2) -Postfix control "if" used at line 5256, column 61. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 5265, column 58. See pages 93,94 of PBP. (Severity: 2) -9 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5270, column 21. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5303, column 13. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5304, column 13. Unnamed numeric literals make code less maintainable. (Severity: 2) -Regular expression without "/s" flag at line 5333, column 15. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5333, column 15. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 5338, column 37. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 5339, column 64. See pages 93,94 of PBP. (Severity: 2) -Too many arguments at line 5419, column 1. See page 182 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 5445, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5445, column 20. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 5463, column 75. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5463, column 75. See page 237 of PBP. (Severity: 2) -Reused variable name in lexical scope: $total_bytes_transferred at line 5486, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $nb_msg_transferred at line 5486, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $nb_msg_transferred at line 5499, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $maxmessagespersecond at line 5499, column 9. Invent unique variable names. (Severity: 3) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5508, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5509, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5510, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -4 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5511, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -8 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 5512, column 31. Unnamed numeric literals make code less maintainable. (Severity: 2) -Reused variable name in lexical scope: $total_bytes_transferred at line 5520, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $maxbytespersecond at line 5520, column 9. Invent unique variable names. (Severity: 3) -Postfix control "if" used at line 5545, column 36. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 5550, column 30. See pages 93,94 of PBP. (Severity: 2) -Reused variable name in lexical scope: $h1_nb_msg_start at line 5557, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $h1_nb_msg_start at line 5568, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/s" flag at line 5665, column 23. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5665, column 23. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 5685, column 23. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5685, column 23. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 5824, column 16. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 5824, column 16. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 5882, column 29. See page 53 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 5882, column 29. See page 79 of PBP. (Severity: 2) -Postfix control "if" used at line 6003, column 38. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 6010, column 40. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6014, column 45. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6015, column 45. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6144, column 6. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6152, column 25. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6153, column 25. See page 53 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 6169, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 6169, column 21. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 6171, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 6171, column 20. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 6185, column 31. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 6190, column 32. See pages 93,94 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 6201, column 13. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 6201, column 13. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6207, column 38. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6208, column 46. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6209, column 54. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6212, column 54. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 6213, column 60. See page 53 of PBP. (Severity: 2) -Expression form of "eval" at line 6706, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 6708, column 38. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 6709, column 13. See page 79 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 6744, column 21. See pages 54,55 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 6749, column 21. See pages 54,55 of PBP. (Severity: 2) -Long number not separated with underscores at line 6901, column 16. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6912, column 16. See page 59 of PBP. (Severity: 2) -Magic punctuation variable $% used in interpolated string at line 6928, column 3. See page 79 of PBP. (Severity: 2) -Long number not separated with underscores at line 6928, column 87. See page 59 of PBP. (Severity: 2) -Expression form of "eval" at line 6942, column 13. See page 161 of PBP. (Severity: 5) -Magic punctuation variable $@ used at line 6945, column 24. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used in interpolated string at line 6946, column 13. See page 79 of PBP. (Severity: 2) -Long number not separated with underscores at line 6966, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6967, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6969, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6970, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6972, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6973, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6975, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6976, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6978, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6979, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 6981, column 49. See page 59 of PBP. (Severity: 2) -Postfix control "if" used at line 7053, column 69. See pages 93,94 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7132, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7132, column 21. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7132, column 21. See page 237 of PBP. (Severity: 2) -Too many arguments at line 7204, column 1. See page 182 of PBP. (Severity: 3) -Postfix control "unless" used at line 7241, column 27. See pages 96,97 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7278, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7278, column 30. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7293, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7293, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7296, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7296, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7299, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7299, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7302, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7302, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7305, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7305, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7308, column 97. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7308, column 97. See page 237 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 7326, column 51. See pages 54,55 of PBP. (Severity: 2) -Close filehandles as soon as possible after opening them at line 7338, column 9. See page 209 of PBP. (Severity: 4) -Magic punctuation variable $! used in interpolated string at line 7339, column 26. See page 79 of PBP. (Severity: 2) -Return value of "close" ignored at line 7343, column 9. Check the return value of "close" for success. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 7364, column 42. See page 79 of PBP. (Severity: 2) -Return value of "close" ignored at line 7366, column 2. Check the return value of "close" for success. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 7373, column 70. See page 79 of PBP. (Severity: 2) -Return value of "close" ignored at line 7375, column 2. Check the return value of "close" for success. (Severity: 2) -Literal line breaks in a string at line 7379, column 1. See pages 60,61 of PBP. (Severity: 3) -Postfix control "if" used at line 7393, column 3. See pages 93,94 of PBP. (Severity: 2) -Backtick operator used at line 7403, column 17. Use IPC::Open3 instead. (Severity: 3) -Postfix control "if" used at line 7442, column 52. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7458, column 49. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7489, column 32. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7489, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7489, column 32. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7489, column 32. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7493, column 32. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7493, column 32. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7493, column 32. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7493, column 32. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7502, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7502, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7502, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7507, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7507, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7507, column 33. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7511, column 33. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7511, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7511, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7511, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7514, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7514, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7515, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7515, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7515, column 33. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7521, column 24. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7521, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7521, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7521, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7537, column 21. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7537, column 21. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7561, column 24. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7561, column 24. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7570, column 29. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7570, column 29. See page 237 of PBP. (Severity: 2) -Magic punctuation variable $0 used at line 7577, column 18. See page 79 of PBP. (Severity: 2) -Return value of "close" ignored at line 7600, column 2. Check the return value of "close" for success. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 7620, column 23. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used at line 7634, column 23. See page 79 of PBP. (Severity: 2) -Magic punctuation variable $@ used at line 7636, column 7. See page 79 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7636, column 13. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7636, column 13. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7671, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7671, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7671, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7672, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7672, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7672, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7673, column 43. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7673, column 43. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7673, column 43. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7675, column 36. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7675, column 36. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7675, column 36. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7676, column 37. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7676, column 37. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7676, column 37. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7677, column 38. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7677, column 38. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7677, column 38. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7679, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 7679, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 7679, column 30. See page 237 of PBP. (Severity: 2) -Backtick operator used at line 7696, column 12. Use IPC::Open3 instead. (Severity: 3) -Backtick operator used at line 7718, column 11. Use IPC::Open3 instead. (Severity: 3) -String delimiter used with "split" at line 7723, column 28. Express it as a regex instead. (Severity: 2) -Quotes used with a noisy string at line 7723, column 34. See page 53 of PBP. (Severity: 2) -Postfix control "if" used at line 7753, column 34. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7765, column 31. See pages 93,94 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7797, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7797, column 17. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7806, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7806, column 17. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7826, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7826, column 19. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7857, column 17. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7857, column 17. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7860, column 16. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7861, column 22. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7866, column 12. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7866, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7866, column 12. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7878, column 38. See pages 93,94 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7878, column 72. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7878, column 72. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7879, column 38. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7881, column 46. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7885, column 30. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 7887, column 33. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7892, column 12. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7892, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7892, column 12. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7909, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7909, column 19. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7921, column 19. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7921, column 19. See page 237 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7933, column 12. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7933, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7933, column 12. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 7939, column 29. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 7945, column 12. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 7945, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7945, column 12. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 7956, column 12. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 7956, column 12. See page 237 of PBP. (Severity: 2) -Expression form of "eval" at line 8051, column 42. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 8055, column 44. See page 161 of PBP. (Severity: 5) -Postfix control "if" used at line 8060, column 34. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 8061, column 36. See pages 93,94 of PBP. (Severity: 2) -Reused variable name in lexical scope: $sync at line 8072, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 8093, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 8145, column 9. Invent unique variable names. (Severity: 3) -Regular expression without "/s" flag at line 8296, column 33. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8296, column 33. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8335, column 26. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8335, column 26. See page 237 of PBP. (Severity: 2) -Use 'eq' or hash instead of fixed-pattern regexps at line 8339, column 36. See pages 271,272 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8339, column 36. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8339, column 36. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8341, column 31. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8341, column 31. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 8347, column 34. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8347, column 34. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 8350, column 68. See pages 93,94 of PBP. (Severity: 2) -Split long regexps into smaller qr// chunks at line 8481, column 20. See page 261 of PBP. (Severity: 3) -Regular expression without "/s" flag at line 8481, column 20. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 8481, column 20. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 8487, column 28. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8487, column 33. See page 53 of PBP. (Severity: 2) -Postfix control "if" used at line 8488, column 36. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8488, column 41. See page 53 of PBP. (Severity: 2) -Long number not separated with underscores at line 8521, column 55. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 8556, column 40. See page 59 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8615, column 27. See page 53 of PBP. (Severity: 2) -Postfix control "if" used at line 8627, column 66. See pages 93,94 of PBP. (Severity: 2) -Postfix control "unless" used at line 8630, column 18. See pages 96,97 of PBP. (Severity: 2) -Long number not separated with underscores at line 8634, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 8635, column 46. See page 59 of PBP. (Severity: 2) -Long number not separated with underscores at line 8636, column 57. See page 59 of PBP. (Severity: 2) -Postfix control "unless" used at line 8638, column 16. See pages 96,97 of PBP. (Severity: 2) -Magic punctuation variable $! used in interpolated string at line 8691, column 36. See page 79 of PBP. (Severity: 2) -Close filehandles as soon as possible after opening them at line 8693, column 2. See page 209 of PBP. (Severity: 4) -Magic punctuation variable $! used in interpolated string at line 8694, column 14. See page 79 of PBP. (Severity: 2) -Magic variable "*STDERR" should be assigned as "local" at line 8696, column 10. See pages 81,82 of PBP. (Severity: 4) -Double-sigil dereference at line 8696, column 12. See page 228 of PBP. (Severity: 2) -One-argument "select" used at line 8697, column 2. See page 224 of PBP. (Severity: 4) -Postfix control "if" used at line 8717, column 43. See pages 93,94 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8718, column 54. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 8718, column 60. See page 53 of PBP. (Severity: 2) -Magic punctuation variable $0 used in interpolated here-document at line 8719, column 18. See page 79 of PBP. (Severity: 2) -Numeric escapes in interpolated string at line 9035, column 20. See pages 54,55 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9037, column 16. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/m" flag at line 9037, column 16. See page 237 of PBP. (Severity: 2) -Postfix control "if" used at line 9214, column 58. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 9230, column 29. See pages 93,94 of PBP. (Severity: 2) -Postfix control "unless" used at line 9233, column 24. See pages 96,97 of PBP. (Severity: 2) -Postfix control "if" used at line 9236, column 16. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 9253, column 46. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 9281, column 46. See pages 93,94 of PBP. (Severity: 2) -Postfix control "if" used at line 9374, column 33. See pages 93,94 of PBP. (Severity: 2) -Multiple "package" declarations at line 9395, column 1. Limit to one per file. (Severity: 4) -Subroutine "GetOptions" with high complexity score (32) at line 9407, column 1. Consider refactoring. (Severity: 3) -Regular expression without "/s" flag at line 9425, column 22. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9425, column 22. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9425, column 22. See page 237 of PBP. (Severity: 2) -String delimiter used with "split" at line 9430, column 21. Express it as a regex instead. (Severity: 2) -Quotes used with a noisy string at line 9430, column 27. See page 53 of PBP. (Severity: 2) -Capture variable used outside conditional at line 9430, column 32. See page 253 of PBP. (Severity: 3) -Quotes used with a noisy string at line 9432, column 28. See page 53 of PBP. (Severity: 2) -Quotes used with a noisy string at line 9437, column 32. See page 53 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9438, column 42. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9438, column 42. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9438, column 42. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9439, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9439, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9439, column 30. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9443, column 35. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9443, column 35. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9443, column 35. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9460, column 30. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9460, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9460, column 30. See page 237 of PBP. (Severity: 2) -Regular expression without "/s" flag at line 9462, column 35. See pages 240,241 of PBP. (Severity: 2) -Regular expression without "/x" flag at line 9462, column 35. See page 236 of PBP. (Severity: 3) -Regular expression without "/m" flag at line 9462, column 35. See page 237 of PBP. (Severity: 2) -Quotes used with a noisy string at line 9465, column 36. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 953, column 55. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 972, column 20. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 973, column 21. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1011, column 119. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1045, column 15. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1046, column 21. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1056, column 30. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1066, column 24. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1098, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1112, column 31. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1113, column 12. See pages 93,94 of PBP. (Severity: 2) +Useless use of $_ at line 1281, column 34. $_ should be omitted when calling "uc". (Severity: 2) +Postfix control "if" used at line 1300, column 22. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1301, column 22. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 1483, column 47. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 1483, column 47. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 1483, column 47. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 1492, column 47. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 1492, column 47. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 1492, column 47. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 1603, column 3. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1638, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1639, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1648, column 29. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1656, column 34. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1799, column 71. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1809, column 84. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1817, column 17. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1822, column 17. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1865, column 86. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1878, column 17. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1908, column 17. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1928, column 53. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1937, column 60. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1941, column 45. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 1953, column 59. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 1953, column 59. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 1955, column 35. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1956, column 59. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1965, column 51. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1975, column 60. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 1979, column 45. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 1990, column 59. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 1990, column 59. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 2020, column 69. See pages 93,94 of PBP. (Severity: 2) +Code structure is deeply nested at line 2021, column 41. Consider refactoring. (Severity: 3) +Postfix control "if" used at line 2032, column 60. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2036, column 45. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2170, column 66. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2171, column 41. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 2174, column 40. See pages 93,94 of PBP. (Severity: 2) +6 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2464, column 69. Unnamed numeric literals make code less maintainable. (Severity: 2) +Octal literals (0000) are not allowed. Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2498, column 29. Unnamed numeric literals make code less maintainable. (Severity: 2) +Octal literals (0000) are not allowed. Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2500, column 10. Unnamed numeric literals make code less maintainable. (Severity: 2) +777 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2500, column 27. Unnamed numeric literals make code less maintainable. (Severity: 2) +777 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2504, column 10. Unnamed numeric literals make code less maintainable. (Severity: 2) +777 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2505, column 10. Unnamed numeric literals make code less maintainable. (Severity: 2) +Quotes used with a noisy string at line 2547, column 30. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2659, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2660, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2661, column 16. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2662, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2663, column 12. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2664, column 16. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 2669, column 26. See page 53 of PBP. (Severity: 2) +Return value of "close" ignored at line 2779, column 9. Check the return value of "close" for success. (Severity: 2) +32 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2793, column 6. Unnamed numeric literals make code less maintainable. (Severity: 2) +32 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2794, column 6. Unnamed numeric literals make code less maintainable. (Severity: 2) +Postfix control "for" used at line 2803, column 33. See page 96 of PBP. (Severity: 2) +32 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 2803, column 40. Unnamed numeric literals make code less maintainable. (Severity: 2) +Quotes used with a noisy string at line 2913, column 44. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 2913, column 55. See page 53 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 2988, column 29. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 2988, column 29. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3015, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3015, column 31. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3195, column 47. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3195, column 47. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 3209, column 25. See pages 93,94 of PBP. (Severity: 2) +Useless use of $_ at line 3315, column 40. $_ should be omitted when calling "uc". (Severity: 2) +Too many arguments at line 3338, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 3356, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 3366, column 1. See page 182 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 3412, column 17. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3412, column 17. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 3428, column 61. See pages 93,94 of PBP. (Severity: 2) +Warnings disabled at line 3441, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3442, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3474, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3475, column 9. See page 431 of PBP. (Severity: 4) +100 is not one of the allowed literal values (0, 1, 2). Use the Readonly or Const::Fast module or the "constant" pragma instead at line 3492, column 26. Unnamed numeric literals make code less maintainable. (Severity: 2) +Regular expression without "/s" flag at line 3588, column 30. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 3588, column 30. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 3621, column 52. See page 53 of PBP. (Severity: 2) +Use "<>" or "" or a prompting module instead of "" at line 3623, column 24. See pages 216,220,221 of PBP. (Severity: 4) +Regular expression without "/s" flag at line 3877, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3877, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3877, column 42. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3878, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3878, column 33. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3878, column 33. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3887, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3887, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3887, column 42. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3898, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3898, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3898, column 42. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 3919, column 42. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 3919, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 3919, column 42. See page 237 of PBP. (Severity: 2) +Magic punctuation variable $! used at line 3920, column 73. See page 79 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4009, column 64. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 4009, column 64. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 4009, column 64. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4012, column 56. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 4012, column 56. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 4012, column 56. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4013, column 56. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 4013, column 56. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 4013, column 56. See page 237 of PBP. (Severity: 2) +Too many arguments at line 4040, column 1. See page 182 of PBP. (Severity: 3) +Subroutine "authenticate_imap" with high complexity score (21) at line 4120, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 4120, column 1. See page 182 of PBP. (Severity: 3) +Postfix control "unless" used at line 4134, column 51. See pages 96,97 of PBP. (Severity: 2) +Postfix control "if" used at line 4138, column 40. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4139, column 40. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4140, column 42. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4142, column 32. See pages 93,94 of PBP. (Severity: 2) +"unless" block used at line 4146, column 9. See page 97 of PBP. (Severity: 2) +Postfix control "if" used at line 4223, column 45. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4248, column 45. See pages 93,94 of PBP. (Severity: 2) +Too many arguments at line 4260, column 1. See page 182 of PBP. (Severity: 3) +Postfix control "if" used at line 4288, column 50. See pages 93,94 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 4302, column 32. See pages 54,55 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4349, column 32. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4349, column 32. See page 237 of PBP. (Severity: 2) +Use "local $/ = undef" or Path::Tiny instead of joined readline at line 4354, column 43. See page 213 of PBP. (Severity: 3) +Return value of "close" ignored at line 4355, column 13. Check the return value of "close" for success. (Severity: 2) +Regular expression without "/s" flag at line 4364, column 69. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4364, column 69. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 4367, column 37. See pages 93,94 of PBP. (Severity: 2) +Backtick operator used at line 4372, column 20. Use IPC::Open3 instead. (Severity: 3) +"unless" block used at line 4397, column 9. See page 97 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4431, column 32. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4431, column 32. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 4525, column 42. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 4536, column 82. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 4537, column 46. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 4540, column 46. See page 53 of PBP. (Severity: 2) +Return value of "close" ignored at line 4568, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of "close" ignored at line 4591, column 17. Check the return value of "close" for success. (Severity: 2) +Regular expression without "/s" flag at line 4718, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4718, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4719, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4719, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4720, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4720, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4729, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4729, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4730, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4730, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4731, column 15. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4731, column 15. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4774, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4774, column 31. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4861, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4861, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 4864, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 4864, column 20. See page 237 of PBP. (Severity: 2) +Use 'eq' or hash instead of fixed-pattern regexps at line 5068, column 38. See pages 271,272 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5068, column 38. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5068, column 38. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5069, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5069, column 33. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5073, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5073, column 33. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5145, column 26. See page 53 of PBP. (Severity: 2) +Postfix control "while" used at line 5145, column 34. See page 96 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5145, column 53. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5145, column 53. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5146, column 26. See page 53 of PBP. (Severity: 2) +Postfix control "while" used at line 5146, column 34. See page 96 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5146, column 53. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5146, column 53. See page 237 of PBP. (Severity: 2) +Postfix control "while" used at line 5147, column 36. See page 96 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5147, column 55. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5147, column 55. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5148, column 26. See page 53 of PBP. (Severity: 2) +Postfix control "while" used at line 5148, column 34. See page 96 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5148, column 53. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5148, column 53. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5159, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5160, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5161, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5162, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5164, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5165, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5166, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5260, column 53. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5260, column 58. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5261, column 55. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5261, column 60. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5262, column 55. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5262, column 60. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5263, column 55. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5263, column 60. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5264, column 57. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5264, column 62. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5266, column 57. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5266, column 62. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5268, column 57. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5268, column 62. See page 53 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 5279, column 21. See pages 54,55 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5282, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5282, column 21. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5283, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5283, column 21. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5284, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5284, column 21. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5285, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5285, column 21. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 5285, column 30. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5285, column 49. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5285, column 74. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5294, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5295, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5341, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5342, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5357, column 11. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 5358, column 11. See page 53 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5397, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5397, column 21. See page 237 of PBP. (Severity: 2) +Postfix control "unless" used at line 5403, column 11. See pages 96,97 of PBP. (Severity: 2) +Use 'eq' or hash instead of fixed-pattern regexps at line 5403, column 73. See pages 271,272 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5403, column 73. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5403, column 73. See page 237 of PBP. (Severity: 2) +Expression form of "eval" at line 5413, column 27. See page 161 of PBP. (Severity: 5) +Quotes used with a noisy string at line 5428, column 35. See page 53 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5438, column 49. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5438, column 49. See page 237 of PBP. (Severity: 2) +"unless" block used at line 5471, column 17. See page 97 of PBP. (Severity: 2) +Postfix control "if" used at line 5484, column 53. See pages 93,94 of PBP. (Severity: 2) +Single-quote used as quote-like operator delimiter at line 5557, column 24. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) +Expression form of "eval" at line 5658, column 27. See page 161 of PBP. (Severity: 5) +"unless" block used at line 5681, column 25. See page 97 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5716, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5716, column 31. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5719, column 49. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5719, column 49. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5747, column 28. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5747, column 28. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 5759, column 27. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 5759, column 27. See page 237 of PBP. (Severity: 2) +Useless use of $_ at line 5761, column 60. $_ should be omitted when calling "lc". (Severity: 2) +Useless use of $_ at line 5761, column 82. $_ should be omitted when calling "lc". (Severity: 2) +"unless" block used at line 5941, column 17. See page 97 of PBP. (Severity: 2) +"unless" block used at line 5942, column 17. See page 97 of PBP. (Severity: 2) +Postfix control "if" used at line 6009, column 22. See pages 93,94 of PBP. (Severity: 2) +Subroutine "copy_message" with high complexity score (25) at line 6036, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 6036, column 1. See page 182 of PBP. (Severity: 3) +Postfix control "if" used at line 6053, column 107. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 6103, column 26. See pages 93,94 of PBP. (Severity: 2) +Too many arguments at line 6120, column 1. See page 182 of PBP. (Severity: 3) +Subroutine "message_for_host2" with high complexity score (27) at line 6153, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 6153, column 1. See page 182 of PBP. (Severity: 3) +"unless" block used at line 6196, column 9. See page 97 of PBP. (Severity: 2) +Postfix control "if" used at line 6202, column 48. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 6284, column 21. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 6304, column 75. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 6313, column 72. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 6387, column 22. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6387, column 22. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 6392, column 44. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 6393, column 64. See pages 93,94 of PBP. (Severity: 2) +Too many arguments at line 6472, column 1. See page 182 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 6498, column 41. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6498, column 41. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 6516, column 75. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6516, column 75. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 6668, column 43. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 6673, column 37. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 6796, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6796, column 23. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 6820, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6820, column 23. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 6966, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 6966, column 23. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 7155, column 53. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 7172, column 55. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7176, column 61. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7177, column 59. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7321, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7331, column 32. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7332, column 32. See page 53 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 7350, column 28. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 7350, column 28. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 7352, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 7352, column 20. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 7368, column 45. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 7373, column 46. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 7385, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 7385, column 20. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7393, column 45. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7394, column 53. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7395, column 61. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7398, column 61. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 7399, column 67. See page 53 of PBP. (Severity: 2) +Expression form of "eval" at line 7896, column 27. See page 161 of PBP. (Severity: 5) +Numeric escapes in interpolated string at line 7935, column 28. See pages 54,55 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 7940, column 28. See pages 54,55 of PBP. (Severity: 2) +Expression form of "eval" at line 8135, column 27. See page 161 of PBP. (Severity: 5) +Postfix control "if" used at line 8248, column 76. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8327, column 21. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8327, column 21. See page 237 of PBP. (Severity: 2) +Too many arguments at line 8398, column 1. See page 182 of PBP. (Severity: 3) +Postfix control "unless" used at line 8435, column 34. See pages 96,97 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8472, column 51. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8472, column 51. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8487, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8487, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8490, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8490, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8493, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8493, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8496, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8496, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8499, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8499, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8502, column 97. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8502, column 97. See page 237 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 8522, column 58. See pages 54,55 of PBP. (Severity: 2) +Return value of "close" ignored at line 8545, column 9. Check the return value of "close" for success. (Severity: 2) +Return value of "close" ignored at line 8578, column 9. Check the return value of "close" for success. (Severity: 2) +Quotes used with a noisy string at line 8588, column 29. See page 53 of PBP. (Severity: 2) +Return value of "close" ignored at line 8612, column 3. Check the return value of "close" for success. (Severity: 2) +Quotes used with a noisy string at line 8626, column 39. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 8633, column 69. See pages 93,94 of PBP. (Severity: 2) +Return value of "close" ignored at line 8656, column 9. Check the return value of "close" for success. (Severity: 2) +Literal line breaks in a string at line 8660, column 1. See pages 60,61 of PBP. (Severity: 3) +Postfix control "if" used at line 8674, column 3. See pages 93,94 of PBP. (Severity: 2) +Backtick operator used at line 8684, column 17. Use IPC::Open3 instead. (Severity: 3) +Postfix control "if" used at line 8725, column 66. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 8741, column 63. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8772, column 32. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8772, column 32. See pages 240,241 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8776, column 32. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8776, column 32. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8786, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8791, column 33. See pages 240,241 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8795, column 33. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8795, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8799, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8800, column 33. See pages 240,241 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 8806, column 24. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 8806, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 8830, column 28. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8830, column 28. See page 237 of PBP. (Severity: 2) +Return value of "close" ignored at line 8852, column 9. Check the return value of "close" for success. (Severity: 2) +Regular expression without "/s" flag at line 8891, column 36. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8891, column 36. See page 237 of PBP. (Severity: 2) +Reused variable name in lexical scope: $version at line 8982, column 9. Invent unique variable names. (Severity: 3) +Regular expression without "/s" flag at line 8995, column 36. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 8995, column 36. See page 237 of PBP. (Severity: 2) +Backtick operator used at line 9047, column 17. Use IPC::Open3 instead. (Severity: 3) +Postfix control "if" used at line 9072, column 33. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9080, column 32. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9090, column 34. See pages 93,94 of PBP. (Severity: 2) +Return value of eval not tested at line 9139, column 3. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Backtick operator used at line 9140, column 15. Use IPC::Open3 instead. (Severity: 3) +Split long regexps into smaller qr// chunks at line 9149, column 16. See page 261 of PBP. (Severity: 3) +Return value of eval not tested at line 9162, column 3. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Capture variable used outside conditional at line 9173, column 12. See page 253 of PBP. (Severity: 3) +Backtick operator used at line 9274, column 26. Use IPC::Open3 instead. (Severity: 3) +Backtick operator used at line 9296, column 18. Use IPC::Open3 instead. (Severity: 3) +String delimiter used with "split" at line 9301, column 42. Express it as a regex instead. (Severity: 2) +Quotes used with a noisy string at line 9301, column 48. See page 53 of PBP. (Severity: 2) +Return value of eval not tested at line 9325, column 2. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Postfix control "if" used at line 9351, column 47. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9368, column 44. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9414, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9414, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9423, column 24. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9423, column 24. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9443, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9443, column 19. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9478, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9478, column 20. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9481, column 30. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9482, column 36. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9487, column 19. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 9487, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9487, column 19. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9499, column 38. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9499, column 72. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9499, column 72. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9500, column 38. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9502, column 46. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9506, column 30. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9508, column 33. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9513, column 19. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 9513, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9513, column 19. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9530, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9530, column 19. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9542, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9542, column 19. See page 237 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9554, column 19. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 9554, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9554, column 19. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 9560, column 29. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 9566, column 19. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 9566, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9566, column 19. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 9577, column 19. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 9577, column 19. See page 237 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9692, column 26. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9693, column 26. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9699, column 26. See page 53 of PBP. (Severity: 2) +Hard tabs used at line 9748, column 84. See page 20 of PBP. (Severity: 3) +Quotes used with a noisy string at line 9753, column 29. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9754, column 29. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 9759, column 29. See page 53 of PBP. (Severity: 2) +Expression form of "eval" at line 9789, column 56. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 9793, column 58. See page 161 of PBP. (Severity: 5) +Postfix control "if" used at line 9798, column 48. See pages 93,94 of PBP. (Severity: 2) +Postfix control "if" used at line 9799, column 50. See pages 93,94 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10038, column 33. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10038, column 33. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10080, column 26. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10080, column 26. See page 237 of PBP. (Severity: 2) +Use 'eq' or hash instead of fixed-pattern regexps at line 10084, column 36. See pages 271,272 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10084, column 36. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10084, column 36. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10086, column 31. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10086, column 31. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 10092, column 34. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10092, column 34. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 10095, column 68. See pages 93,94 of PBP. (Severity: 2) +Split long regexps into smaller qr// chunks at line 10248, column 20. See page 261 of PBP. (Severity: 3) +Regular expression without "/s" flag at line 10248, column 20. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 10248, column 20. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 10254, column 28. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10254, column 33. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 10255, column 36. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10255, column 41. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 10327, column 65. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10382, column 23. See page 53 of PBP. (Severity: 2) +Postfix control "if" used at line 10418, column 80. See pages 93,94 of PBP. (Severity: 2) +Postfix control "unless" used at line 10421, column 32. See pages 96,97 of PBP. (Severity: 2) +Postfix control "unless" used at line 10431, column 30. See pages 96,97 of PBP. (Severity: 2) +Quotes used with a noisy string at line 10448, column 34. See page 53 of PBP. (Severity: 2) +Magic variable "*STDERR" should be assigned as "local" at line 10509, column 17. See pages 81,82 of PBP. (Severity: 4) +Double-sigil dereference at line 10509, column 19. See page 228 of PBP. (Severity: 2) +One-argument "select" used at line 10510, column 9. See page 224 of PBP. (Severity: 4) +Ambiguously named variable "last" at line 10529, column 2. See page 48 of PBP. (Severity: 3) +Postfix control "if" used at line 10580, column 45. See pages 93,94 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 10751, column 21. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 10798, column 50. See page 53 of PBP. (Severity: 2) +Reused variable name in lexical scope: $err at line 10806, column 3. Invent unique variable names. (Severity: 3) +Quotes used with a string containing no non-whitespace characters at line 10826, column 24. See page 53 of PBP. (Severity: 2) +Quotes used with a string containing no non-whitespace characters at line 10865, column 50. See page 53 of PBP. (Severity: 2) +Reused variable name in lexical scope: $err at line 10873, column 3. Invent unique variable names. (Severity: 3) +Hard tabs used at line 10944, column 44. See page 20 of PBP. (Severity: 3) +Quotes used with a noisy string at line 11062, column 13. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 11062, column 35. See page 53 of PBP. (Severity: 2) +Close filehandles as soon as possible after opening them at line 11091, column 9. See page 209 of PBP. (Severity: 4) +"warn" used instead of "carp" at line 11092, column 17. See page 283 of PBP. (Severity: 3) +Return value of "close" ignored at line 11105, column 9. Check the return value of "close" for success. (Severity: 2) +Regular expression without "/s" flag at line 11117, column 40. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 11117, column 40. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 11117, column 40. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11119, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 11119, column 23. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 11119, column 23. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11120, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/x" flag at line 11120, column 23. See page 236 of PBP. (Severity: 3) +Regular expression without "/m" flag at line 11120, column 23. See page 237 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11121, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 11121, column 23. See page 237 of PBP. (Severity: 2) +Postfix control "if" used at line 11134, column 52. See pages 93,94 of PBP. (Severity: 2) +Literal line breaks in a string at line 11137, column 9. See pages 60,61 of PBP. (Severity: 3) +Subroutine "myGetOptions" with high complexity score (27) at line 11174, column 1. Consider refactoring. (Severity: 3) +String delimiter used with "split" at line 11201, column 21. Express it as a regex instead. (Severity: 2) +Quotes used with a noisy string at line 11201, column 27. See page 53 of PBP. (Severity: 2) +Capture variable used outside conditional at line 11201, column 32. See page 253 of PBP. (Severity: 3) +Quotes used with a noisy string at line 11203, column 28. See page 53 of PBP. (Severity: 2) +Quotes used with a noisy string at line 11209, column 32. See page 53 of PBP. (Severity: 2) +Useless use of $_ at line 11210, column 36. $_ should be omitted when calling "split" with two arguments. (Severity: 2) +Useless use of $_ at line 11230, column 37. $_ should be omitted when calling "int". (Severity: 2) +Quotes used with a noisy string at line 11234, column 36. See page 53 of PBP. (Severity: 2) +Numeric escapes in interpolated string at line 11400, column 27. See pages 54,55 of PBP. (Severity: 2) +Regular expression without "/s" flag at line 11402, column 23. See pages 240,241 of PBP. (Severity: 2) +Regular expression without "/m" flag at line 11402, column 23. See page 237 of PBP. (Severity: 2) +Double-sigil dereference at line 11712, column 17. See page 228 of PBP. (Severity: 2) +Double-sigil dereference at line 11716, column 18. See page 228 of PBP. (Severity: 2) +Double-sigil dereference at line 11721, column 3. See page 228 of PBP. (Severity: 2) +Postfix control "if" used at line 11819, column 46. See pages 93,94 of PBP. (Severity: 2) - 1 files. - 263 subroutines/methods. -8,603 statements. + 1 files. + 367 subroutines/methods. +11,872 statements. -9,486 lines, consisting of: - 1,684 blank lines. - 551 comment lines. +11,937 lines, consisting of: + 2,225 blank lines. + 764 comment lines. 0 data lines. - 6,579 lines of Perl code. - 672 lines of POD. + 8,314 lines of Perl code. + 634 lines of POD. -Average McCabe score of subroutines was 4.35. +Average McCabe score of subroutines was 4.10. -606 violations. -Violations per file was 606.000. -Violations per statement was 0.070. -Violations per line of code was 0.064. +502 violations. +Violations per file was 502.000. +Violations per statement was 0.042. +Violations per line of code was 0.042. 6 severity 5 violations. - 5 severity 4 violations. -120 severity 3 violations. -475 severity 2 violations. + 8 severity 4 violations. + 62 severity 3 violations. +426 severity 2 violations. 6 violations of BuiltinFunctions::ProhibitStringyEval. 2 violations of BuiltinFunctions::ProhibitStringySplit. + 6 violations of BuiltinFunctions::ProhibitUselessTopic. + 2 violations of CodeLayout::ProhibitHardTabs. 1 violations of ControlStructures::ProhibitDeepNests. -109 violations of ControlStructures::ProhibitPostfixControls. - 19 violations of ControlStructures::ProhibitUnlessBlocks. - 3 violations of Documentation::RequirePodSections. +105 violations of ControlStructures::ProhibitPostfixControls. + 7 violations of ControlStructures::ProhibitUnlessBlocks. + 4 violations of Documentation::RequirePodSections. 1 violations of ErrorHandling::RequireCarping. - 1 violations of ErrorHandling::RequireCheckingReturnValueOfEval. - 4 violations of InputOutput::ProhibitBacktickOperators. + 3 violations of ErrorHandling::RequireCheckingReturnValueOfEval. + 6 violations of InputOutput::ProhibitBacktickOperators. + 1 violations of InputOutput::ProhibitExplicitStdin. 1 violations of InputOutput::ProhibitJoinedReadline. 1 violations of InputOutput::ProhibitOneArgSelect. - 2 violations of InputOutput::RequireBriefOpen. - 7 violations of InputOutput::RequireCheckedClose. + 1 violations of InputOutput::RequireBriefOpen. + 10 violations of InputOutput::RequireCheckedClose. 1 violations of Modules::ProhibitExcessMainComplexity. - 1 violations of Modules::ProhibitMultiplePackages. - 1 violations of References::ProhibitDoubleSigils. - 1 violations of RegularExpressions::ProhibitCaptureWithoutTest. - 9 violations of RegularExpressions::ProhibitComplexRegexes. + 1 violations of NamingConventions::ProhibitAmbiguousNames. + 4 violations of References::ProhibitDoubleSigils. + 2 violations of RegularExpressions::ProhibitCaptureWithoutTest. + 10 violations of RegularExpressions::ProhibitComplexRegexes. 3 violations of RegularExpressions::ProhibitFixedStringMatches. -100 violations of RegularExpressions::RequireDotMatchAnything. - 44 violations of RegularExpressions::RequireExtendedFormatting. -100 violations of RegularExpressions::RequireLineBoundaryMatching. - 5 violations of Subroutines::ProhibitExcessComplexity. + 98 violations of RegularExpressions::RequireDotMatchAnything. + 13 violations of RegularExpressions::RequireExtendedFormatting. + 90 violations of RegularExpressions::RequireLineBoundaryMatching. + 4 violations of Subroutines::ProhibitExcessComplexity. 11 violations of Subroutines::ProhibitManyArgs. - 1 violations of ValuesAndExpressions::ProhibitEmptyQuotes. + 4 violations of TestingAndDebugging::ProhibitNoWarnings. + 12 violations of ValuesAndExpressions::ProhibitEmptyQuotes. 6 violations of ValuesAndExpressions::ProhibitEscapedCharacters. - 1 violations of ValuesAndExpressions::ProhibitImplicitNewlines. + 2 violations of ValuesAndExpressions::ProhibitImplicitNewlines. 10 violations of ValuesAndExpressions::ProhibitMagicNumbers. - 56 violations of ValuesAndExpressions::ProhibitNoisyQuotes. - 16 violations of ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters. - 22 violations of ValuesAndExpressions::RequireNumberSeparators. - 36 violations of Variables::ProhibitPunctuationVars. - 22 violations of Variables::ProhibitReusedNames. - 2 violations of Variables::ProhibitUnusedVariables. + 68 violations of ValuesAndExpressions::ProhibitNoisyQuotes. + 1 violations of ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters. + 1 violations of Variables::ProhibitPunctuationVars. + 3 violations of Variables::ProhibitReusedNames. 1 violations of Variables::RequireLocalizedPunctuationVars. diff --git a/W/perlcritic_3.out b/W/perlcritic_3.out index cb94ade..223e350 100644 --- a/W/perlcritic_3.out +++ b/W/perlcritic_3.out @@ -1,174 +1,121 @@ -Main code has high complexity score (401) at line 1, column 1. Consider refactoring. (Severity: 3) -"$ssl1_ssl_version" is declared but not used at line 814, column 1. Unused variables clutter code and make it harder to read. (Severity: 3) -"$ssl2_ssl_version" is declared but not used at line 814, column 1. Unused variables clutter code and make it harder to read. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 1442, column 3. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 1443, column 3. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Regular expression without "/x" flag at line 1481, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 1490, column 33. See page 236 of PBP. (Severity: 3) -Code structure is deeply nested at line 2013, column 41. Consider refactoring. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2255, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2365, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/x" flag at line 2414, column 29. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 2436, column 31. See page 236 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2445, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2468, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/x" flag at line 2501, column 30. See page 236 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2512, column 53. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2520, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 2570, column 2. Invent unique variable names. (Severity: 3) -Regular expression without "/x" flag at line 2607, column 26. See page 236 of PBP. (Severity: 3) -Too many arguments at line 2727, column 1. See page 182 of PBP. (Severity: 3) -Too many arguments at line 2745, column 1. See page 182 of PBP. (Severity: 3) -Too many arguments at line 2755, column 1. See page 182 of PBP. (Severity: 3) -Subroutine "modulesversion" with high complexity score (27) at line 2868, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 3075, column 1. See page 182 of PBP. (Severity: 3) -Subroutine "authenticate_imap" with high complexity score (21) at line 3144, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 3144, column 1. See page 182 of PBP. (Severity: 3) -Too many arguments at line 3274, column 1. See page 182 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3358, column 32. See page 236 of PBP. (Severity: 3) -Use "local $/ = undef" or File::Slurp instead of joined readline at line 3363, column 43. See page 213 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3373, column 69. See page 236 of PBP. (Severity: 3) -Backtick operator used at line 3381, column 20. Use IPC::Open3 instead. (Severity: 3) -Return value of eval not tested at line 3538, column 2. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) -"die" used instead of "croak" at line 3606, column 2. See page 283 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3714, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3715, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3716, column 15. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3725, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3726, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3727, column 8. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3770, column 31. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3857, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 3860, column 20. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 4061, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 4062, column 19. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 4066, column 19. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 4136, column 39. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 4137, column 39. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 4138, column 41. See page 236 of PBP. (Severity: 3) -Expression form of "eval" at line 4391, column 13. See page 161 of PBP. (Severity: 5) -Single-quote used as quote-like operator delimiter at line 4522, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4522, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4528, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4528, column 38. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4529, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4530, column 39. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4534, column 6. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4534, column 40. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4537, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4538, column 45. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4539, column 22. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4541, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4550, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Single-quote used as quote-like operator delimiter at line 4556, column 17. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) -Expression form of "eval" at line 4629, column 13. See page 161 of PBP. (Severity: 5) -Subroutine "copy_message" with high complexity score (25) at line 4990, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 4990, column 1. See page 182 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 4993, column 2. Invent unique variable names. (Severity: 3) -Too many arguments at line 5074, column 1. See page 182 of PBP. (Severity: 3) -Subroutine "message_for_host2" with high complexity score (27) at line 5107, column 1. Consider refactoring. (Severity: 3) -Too many arguments at line 5107, column 1. See page 182 of PBP. (Severity: 3) -Reused variable name in lexical scope: $sync at line 5129, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 5223, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $string_ref at line 5242, column 25. Invent unique variable names. (Severity: 3) -Too many arguments at line 5419, column 1. See page 182 of PBP. (Severity: 3) -Reused variable name in lexical scope: $total_bytes_transferred at line 5486, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $nb_msg_transferred at line 5486, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $nb_msg_transferred at line 5499, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $maxmessagespersecond at line 5499, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $total_bytes_transferred at line 5520, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $maxbytespersecond at line 5520, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $h1_nb_msg_start at line 5557, column 2. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $h1_nb_msg_start at line 5568, column 2. Invent unique variable names. (Severity: 3) -Expression form of "eval" at line 6706, column 13. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 6942, column 13. See page 161 of PBP. (Severity: 5) -Regular expression without "/x" flag at line 7132, column 21. See page 236 of PBP. (Severity: 3) -Too many arguments at line 7204, column 1. See page 182 of PBP. (Severity: 3) -Close filehandles as soon as possible after opening them at line 7338, column 9. See page 209 of PBP. (Severity: 4) -Literal line breaks in a string at line 7379, column 1. See pages 60,61 of PBP. (Severity: 3) -Backtick operator used at line 7403, column 17. Use IPC::Open3 instead. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7489, column 32. See page 261 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7489, column 32. See page 236 of PBP. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7493, column 32. See page 261 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7493, column 32. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7502, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7507, column 33. See page 236 of PBP. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7511, column 33. See page 261 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7511, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7515, column 33. See page 236 of PBP. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7521, column 24. See page 261 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7521, column 24. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7671, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7672, column 33. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7673, column 43. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7675, column 36. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7676, column 37. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7677, column 38. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 7679, column 30. See page 236 of PBP. (Severity: 3) -Backtick operator used at line 7696, column 12. Use IPC::Open3 instead. (Severity: 3) -Backtick operator used at line 7718, column 11. Use IPC::Open3 instead. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7866, column 12. See page 261 of PBP. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7892, column 12. See page 261 of PBP. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7933, column 12. See page 261 of PBP. (Severity: 3) -Split long regexps into smaller qr// chunks at line 7945, column 12. See page 261 of PBP. (Severity: 3) -Expression form of "eval" at line 8051, column 42. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 8055, column 44. See page 161 of PBP. (Severity: 5) -Reused variable name in lexical scope: $sync at line 8072, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 8093, column 9. Invent unique variable names. (Severity: 3) -Reused variable name in lexical scope: $sync at line 8145, column 9. Invent unique variable names. (Severity: 3) -Split long regexps into smaller qr// chunks at line 8481, column 20. See page 261 of PBP. (Severity: 3) -Close filehandles as soon as possible after opening them at line 8693, column 2. See page 209 of PBP. (Severity: 4) -Magic variable "*STDERR" should be assigned as "local" at line 8696, column 10. See pages 81,82 of PBP. (Severity: 4) -One-argument "select" used at line 8697, column 2. See page 224 of PBP. (Severity: 4) -Multiple "package" declarations at line 9395, column 1. Limit to one per file. (Severity: 4) -Subroutine "GetOptions" with high complexity score (32) at line 9407, column 1. Consider refactoring. (Severity: 3) -Regular expression without "/x" flag at line 9425, column 22. See page 236 of PBP. (Severity: 3) -Capture variable used outside conditional at line 9430, column 32. See page 253 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 9438, column 42. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 9439, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 9443, column 35. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 9460, column 30. See page 236 of PBP. (Severity: 3) -Regular expression without "/x" flag at line 9462, column 35. See page 236 of PBP. (Severity: 3) +Main code has high complexity score (392) at line 1, column 1. Consider refactoring. (Severity: 3) +Regular expression without "/x" flag at line 1483, column 47. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 1492, column 47. See page 236 of PBP. (Severity: 3) +Code structure is deeply nested at line 2021, column 41. Consider refactoring. (Severity: 3) +Too many arguments at line 3338, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 3356, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 3366, column 1. See page 182 of PBP. (Severity: 3) +Warnings disabled at line 3441, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3442, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3474, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3475, column 9. See page 431 of PBP. (Severity: 4) +Use "<>" or "" or a prompting module instead of "" at line 3623, column 24. See pages 216,220,221 of PBP. (Severity: 4) +Regular expression without "/x" flag at line 3877, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 3878, column 33. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 3887, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 3898, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 3919, column 42. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 4009, column 64. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 4012, column 56. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 4013, column 56. See page 236 of PBP. (Severity: 3) +Too many arguments at line 4040, column 1. See page 182 of PBP. (Severity: 3) +Subroutine "authenticate_imap" with high complexity score (21) at line 4120, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 4120, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 4260, column 1. See page 182 of PBP. (Severity: 3) +Use "local $/ = undef" or Path::Tiny instead of joined readline at line 4354, column 43. See page 213 of PBP. (Severity: 3) +Backtick operator used at line 4372, column 20. Use IPC::Open3 instead. (Severity: 3) +Expression form of "eval" at line 5413, column 27. See page 161 of PBP. (Severity: 5) +Single-quote used as quote-like operator delimiter at line 5557, column 24. Using quotes as delimiters for quote-like operators obfuscates code. (Severity: 3) +Expression form of "eval" at line 5658, column 27. See page 161 of PBP. (Severity: 5) +Subroutine "copy_message" with high complexity score (25) at line 6036, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 6036, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 6120, column 1. See page 182 of PBP. (Severity: 3) +Subroutine "message_for_host2" with high complexity score (27) at line 6153, column 1. Consider refactoring. (Severity: 3) +Too many arguments at line 6153, column 1. See page 182 of PBP. (Severity: 3) +Too many arguments at line 6472, column 1. See page 182 of PBP. (Severity: 3) +Expression form of "eval" at line 7896, column 27. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 8135, column 27. See page 161 of PBP. (Severity: 5) +Too many arguments at line 8398, column 1. See page 182 of PBP. (Severity: 3) +Literal line breaks in a string at line 8660, column 1. See pages 60,61 of PBP. (Severity: 3) +Backtick operator used at line 8684, column 17. Use IPC::Open3 instead. (Severity: 3) +Split long regexps into smaller qr// chunks at line 8772, column 32. See page 261 of PBP. (Severity: 3) +Split long regexps into smaller qr// chunks at line 8776, column 32. See page 261 of PBP. (Severity: 3) +Split long regexps into smaller qr// chunks at line 8795, column 33. See page 261 of PBP. (Severity: 3) +Split long regexps into smaller qr// chunks at line 8806, column 24. See page 261 of PBP. (Severity: 3) +Reused variable name in lexical scope: $version at line 8982, column 9. Invent unique variable names. (Severity: 3) +Backtick operator used at line 9047, column 17. Use IPC::Open3 instead. (Severity: 3) +Return value of eval not tested at line 9139, column 3. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Backtick operator used at line 9140, column 15. Use IPC::Open3 instead. (Severity: 3) +Split long regexps into smaller qr// chunks at line 9149, column 16. See page 261 of PBP. (Severity: 3) +Return value of eval not tested at line 9162, column 3. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Capture variable used outside conditional at line 9173, column 12. See page 253 of PBP. (Severity: 3) +Backtick operator used at line 9274, column 26. Use IPC::Open3 instead. (Severity: 3) +Backtick operator used at line 9296, column 18. Use IPC::Open3 instead. (Severity: 3) +Return value of eval not tested at line 9325, column 2. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) +Split long regexps into smaller qr// chunks at line 9487, column 19. See page 261 of PBP. (Severity: 3) +Split long regexps into smaller qr// chunks at line 9513, column 19. See page 261 of PBP. (Severity: 3) +Split long regexps into smaller qr// chunks at line 9554, column 19. See page 261 of PBP. (Severity: 3) +Split long regexps into smaller qr// chunks at line 9566, column 19. See page 261 of PBP. (Severity: 3) +Hard tabs used at line 9748, column 84. See page 20 of PBP. (Severity: 3) +Expression form of "eval" at line 9789, column 56. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 9793, column 58. See page 161 of PBP. (Severity: 5) +Split long regexps into smaller qr// chunks at line 10248, column 20. See page 261 of PBP. (Severity: 3) +Magic variable "*STDERR" should be assigned as "local" at line 10509, column 17. See pages 81,82 of PBP. (Severity: 4) +One-argument "select" used at line 10510, column 9. See page 224 of PBP. (Severity: 4) +Ambiguously named variable "last" at line 10529, column 2. See page 48 of PBP. (Severity: 3) +Reused variable name in lexical scope: $err at line 10806, column 3. Invent unique variable names. (Severity: 3) +Reused variable name in lexical scope: $err at line 10873, column 3. Invent unique variable names. (Severity: 3) +Hard tabs used at line 10944, column 44. See page 20 of PBP. (Severity: 3) +Close filehandles as soon as possible after opening them at line 11091, column 9. See page 209 of PBP. (Severity: 4) +"warn" used instead of "carp" at line 11092, column 17. See page 283 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 11117, column 40. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 11119, column 23. See page 236 of PBP. (Severity: 3) +Regular expression without "/x" flag at line 11120, column 23. See page 236 of PBP. (Severity: 3) +Literal line breaks in a string at line 11137, column 9. See pages 60,61 of PBP. (Severity: 3) +Subroutine "myGetOptions" with high complexity score (27) at line 11174, column 1. Consider refactoring. (Severity: 3) +Capture variable used outside conditional at line 11201, column 32. See page 253 of PBP. (Severity: 3) - 1 files. - 263 subroutines/methods. -8,603 statements. + 1 files. + 367 subroutines/methods. +11,872 statements. -9,486 lines, consisting of: - 1,684 blank lines. - 551 comment lines. +11,937 lines, consisting of: + 2,225 blank lines. + 764 comment lines. 0 data lines. - 6,579 lines of Perl code. - 672 lines of POD. + 8,314 lines of Perl code. + 634 lines of POD. -Average McCabe score of subroutines was 4.35. +Average McCabe score of subroutines was 4.10. -131 violations. -Violations per file was 131.000. -Violations per statement was 0.015. -Violations per line of code was 0.014. +76 violations. +Violations per file was 76.000. +Violations per statement was 0.006. +Violations per line of code was 0.006. - 6 severity 5 violations. - 5 severity 4 violations. -120 severity 3 violations. + 6 severity 5 violations. + 8 severity 4 violations. +62 severity 3 violations. 6 violations of BuiltinFunctions::ProhibitStringyEval. + 2 violations of CodeLayout::ProhibitHardTabs. 1 violations of ControlStructures::ProhibitDeepNests. 1 violations of ErrorHandling::RequireCarping. - 1 violations of ErrorHandling::RequireCheckingReturnValueOfEval. - 4 violations of InputOutput::ProhibitBacktickOperators. + 3 violations of ErrorHandling::RequireCheckingReturnValueOfEval. + 6 violations of InputOutput::ProhibitBacktickOperators. + 1 violations of InputOutput::ProhibitExplicitStdin. 1 violations of InputOutput::ProhibitJoinedReadline. 1 violations of InputOutput::ProhibitOneArgSelect. - 2 violations of InputOutput::RequireBriefOpen. + 1 violations of InputOutput::RequireBriefOpen. 1 violations of Modules::ProhibitExcessMainComplexity. - 1 violations of Modules::ProhibitMultiplePackages. - 1 violations of RegularExpressions::ProhibitCaptureWithoutTest. - 9 violations of RegularExpressions::ProhibitComplexRegexes. -44 violations of RegularExpressions::RequireExtendedFormatting. - 5 violations of Subroutines::ProhibitExcessComplexity. + 1 violations of NamingConventions::ProhibitAmbiguousNames. + 2 violations of RegularExpressions::ProhibitCaptureWithoutTest. +10 violations of RegularExpressions::ProhibitComplexRegexes. +13 violations of RegularExpressions::RequireExtendedFormatting. + 4 violations of Subroutines::ProhibitExcessComplexity. 11 violations of Subroutines::ProhibitManyArgs. - 1 violations of ValuesAndExpressions::ProhibitImplicitNewlines. -16 violations of ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters. -22 violations of Variables::ProhibitReusedNames. - 2 violations of Variables::ProhibitUnusedVariables. + 4 violations of TestingAndDebugging::ProhibitNoWarnings. + 2 violations of ValuesAndExpressions::ProhibitImplicitNewlines. + 1 violations of ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters. + 3 violations of Variables::ProhibitReusedNames. 1 violations of Variables::RequireLocalizedPunctuationVars. diff --git a/W/perlcritic_4.out b/W/perlcritic_4.out index cc4d3a0..26c7513 100644 --- a/W/perlcritic_4.out +++ b/W/perlcritic_4.out @@ -1,38 +1,42 @@ -Expression form of "eval" at line 4391, column 13. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 4629, column 13. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 6706, column 13. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 6942, column 13. See page 161 of PBP. (Severity: 5) -Close filehandles as soon as possible after opening them at line 7338, column 9. See page 209 of PBP. (Severity: 4) -Expression form of "eval" at line 8051, column 42. See page 161 of PBP. (Severity: 5) -Expression form of "eval" at line 8055, column 44. See page 161 of PBP. (Severity: 5) -Close filehandles as soon as possible after opening them at line 8693, column 2. See page 209 of PBP. (Severity: 4) -Magic variable "*STDERR" should be assigned as "local" at line 8696, column 10. See pages 81,82 of PBP. (Severity: 4) -One-argument "select" used at line 8697, column 2. See page 224 of PBP. (Severity: 4) -Multiple "package" declarations at line 9395, column 1. Limit to one per file. (Severity: 4) +Warnings disabled at line 3441, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3442, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3474, column 9. See page 431 of PBP. (Severity: 4) +Warnings disabled at line 3475, column 9. See page 431 of PBP. (Severity: 4) +Use "<>" or "" or a prompting module instead of "" at line 3623, column 24. See pages 216,220,221 of PBP. (Severity: 4) +Expression form of "eval" at line 5413, column 27. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 5658, column 27. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 7896, column 27. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 8135, column 27. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 9789, column 56. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 9793, column 58. See page 161 of PBP. (Severity: 5) +Magic variable "*STDERR" should be assigned as "local" at line 10509, column 17. See pages 81,82 of PBP. (Severity: 4) +One-argument "select" used at line 10510, column 9. See page 224 of PBP. (Severity: 4) +Close filehandles as soon as possible after opening them at line 11091, column 9. See page 209 of PBP. (Severity: 4) - 1 files. - 263 subroutines/methods. -8,603 statements. + 1 files. + 367 subroutines/methods. +11,872 statements. -9,486 lines, consisting of: - 1,684 blank lines. - 551 comment lines. +11,937 lines, consisting of: + 2,225 blank lines. + 764 comment lines. 0 data lines. - 6,579 lines of Perl code. - 672 lines of POD. + 8,314 lines of Perl code. + 634 lines of POD. -Average McCabe score of subroutines was 4.35. +Average McCabe score of subroutines was 4.10. -11 violations. -Violations per file was 11.000. +14 violations. +Violations per file was 14.000. Violations per statement was 0.001. Violations per line of code was 0.001. 6 severity 5 violations. -5 severity 4 violations. +8 severity 4 violations. 6 violations of BuiltinFunctions::ProhibitStringyEval. +1 violations of InputOutput::ProhibitExplicitStdin. 1 violations of InputOutput::ProhibitOneArgSelect. -2 violations of InputOutput::RequireBriefOpen. -1 violations of Modules::ProhibitMultiplePackages. +1 violations of InputOutput::RequireBriefOpen. +4 violations of TestingAndDebugging::ProhibitNoWarnings. 1 violations of Variables::RequireLocalizedPunctuationVars. diff --git a/W/prereq.Ubuntu b/W/prereq.Ubuntu index df759c7..de0e0ee 100644 --- a/W/prereq.Ubuntu +++ b/W/prereq.Ubuntu @@ -1,12 +1,13 @@ $SHELL says /bin/bash $0 gives ./INSTALL.d/prerequisites_imapsync -ps -ef gives gilles 11305 11304 0 12:55 pts/27 00:00:00 /bin/sh ./INSTALL.d/prerequisites_imapsync +ps -ef gives gilles 4068 4067 0 01:12 pts/14 00:00:00 /bin/sh ./INSTALL.d/prerequisites_imapsync Distributor ID: Ubuntu -Description: Ubuntu 14.04.5 LTS -Release: 14.04 -Codename: trusty -Linux petite 3.13.0-92-generic #139-Ubuntu SMP Tue Jun 28 20:42:32 UTC 2016 i686 i686 i686 GNU/Linux -Ok: Found Perl 5.18.2 +Description: Ubuntu 16.04.2 LTS +Release: 16.04 +Codename: xenial +Linux petite 4.4.0-62-generic #83-Ubuntu SMP Wed Jan 18 14:09:55 UTC 2017 i686 i686 i686 GNU/Linux +Ok: Found Perl 5.22.1 +Ok: Found make GNU Make 4.1 Ok: Found Perl module Authen::NTLM Ok: Found Perl module Compress::Zlib Ok: Found Perl module Data::Dumper @@ -21,8 +22,10 @@ Ok: Found Perl module IO::Socket::SSL Ok: Found Perl module IO::Tee Ok: Found Perl module JSON::WebToken Ok: Found Perl module Mail::IMAPClient +Ok: Found Perl module Net::Ping Ok: Found Perl module Parse::RecDescent Ok: Found Perl module Readonly +Ok: Found Perl module Sys::MemInfo Ok: Found Perl module Term::ReadKey Ok: Found Perl module Test::MockObject Ok: Found Perl module Test::More diff --git a/W/prereq.Ubuntu_16.04.txt b/W/prereq.Ubuntu_16.04.txt new file mode 100644 index 0000000..f9989c8 --- /dev/null +++ b/W/prereq.Ubuntu_16.04.txt @@ -0,0 +1,35 @@ +$SHELL says /bin/bash +$0 gives ./INSTALL.d/prerequisites_imapsync +ps -ef gives gilles 8190 8189 0 01:36 pts/33 00:00:00 /bin/sh ./INSTALL.d/prerequisites_imapsync +Distributor ID: Ubuntu +Description: Ubuntu 16.04.2 LTS +Release: 16.04 +Codename: xenial +Linux petite 4.4.0-64-generic #85-Ubuntu SMP Mon Feb 20 11:49:39 UTC 2017 i686 i686 i686 GNU/Linux +Ok: Found Perl 5.22.1 +Ok: Found make GNU Make 4.1 +Ok: Found Perl module Authen::NTLM +Ok: Found Perl module Compress::Zlib +Ok: Found Perl module Data::Dumper +Ok: Found Perl module Data::Uniqid +Ok: Found Perl module Digest::HMAC_MD5 +Ok: Found Perl module Digest::HMAC +Ok: Found Perl module Digest::MD5 +Ok: Found Perl module File::Copy::Recursive +Ok: Found Perl module IO::Socket::INET +Ok: Found Perl module IO::Socket::INET6 +Ok: Found Perl module IO::Socket::SSL +Ok: Found Perl module IO::Tee +Ok: Found Perl module JSON::WebToken +Ok: Found Perl module Mail::IMAPClient +Ok: Found Perl module Net::Ping +Ok: Found Perl module Parse::RecDescent +Ok: Found Perl module Readonly +Ok: Found Perl module Sys::MemInfo +Ok: Found Perl module Term::ReadKey +Ok: Found Perl module Test::MockObject +Ok: Found Perl module Test::More +Ok: Found Perl module Test::Pod +Ok: Found Perl module Unicode::String +Ok: Found Perl module URI::Escape +All needed modules are already installed diff --git a/W/prereq.Ubuntu_16.04_xenial.txt b/W/prereq.Ubuntu_16.04_xenial.txt new file mode 100644 index 0000000..2cdf590 --- /dev/null +++ b/W/prereq.Ubuntu_16.04_xenial.txt @@ -0,0 +1,55 @@ +$SHELL says /bin/bash +$0 gives ./INSTALL.d/prerequisites_imapsync +ps -ef gives gilles 5273 5272 0 14:39 pts/8 00:00:00 /bin/sh ./INSTALL.d/prerequisites_imapsync +Distributor ID: Ubuntu +Description: Ubuntu 16.04.3 LTS +Release: 16.04 +Codename: xenial +Linux petite 4.4.0-92-generic #115-Ubuntu SMP Thu Aug 10 16:02:55 UTC 2017 i686 i686 i686 GNU/Linux +Ok: Found Perl 5.22.1 +Ok: Found make GNU Make 4.1 +Ok: Found Perl module Authen::NTLM +Ok: Found Perl module Class::Load +Ok: Found Perl module Compress::Zlib +Ok: Found Perl module Crypt::OpenSSL::RSA +Ok: Found Perl module Data::Dumper +Ok: Found Perl module Data::Uniqid +Ok: Found Perl module Digest::HMAC +Ok: Found Perl module Digest::HMAC_MD5 +Ok: Found Perl module Digest::MD5 +Ok: Found Perl module Dist::CheckConflicts +Ok: Found Perl module Encode::Byte +Ok: Found Perl module File::Copy::Recursive +Ok: Found Perl module IO::Socket::INET +Ok: Found Perl module IO::Socket::INET6 +Ok: Found Perl module IO::Socket::SSL +Ok: Found Perl module IO::Tee +Ok: Found Perl module JSON +Ok: Found Perl module JSON::WebToken +Ok: Found Perl module JSON::WebToken::Crypt::RSA +Ok: Found Perl module HTML::Entities +Ok: Found Perl module LWP::UserAgent +Ok: Found Perl module Mail::IMAPClient +Ok: Found Perl module Module::Implementation +Ok: Found Perl module Module::Runtime +Ok: Found Perl module Module::ScanDeps +Ok: Found Perl module Net::Ping +Ok: Found Perl module Net::SSLeay +Ok: Found Perl module Package::Stash +Ok: Found Perl module Package::Stash::XS +Ok: Found Perl module PAR::Packer +Ok: Found Perl module Parse::RecDescent +Ok: Found Perl module Pod::Usage +Ok: Found Perl module Readonly +Ok: Found Perl module Sys::MemInfo +Ok: Found Perl module Term::ReadKey +Ok: Found Perl module Test::Fatal +Ok: Found Perl module Test::Mock::Guard +Ok: Found Perl module Test::MockObject +Ok: Found Perl module Test::More +Ok: Found Perl module Test::Pod +Ok: Found Perl module Test::Requires +Ok: Found Perl module Try::Tiny +Ok: Found Perl module Unicode::String +Ok: Found Perl module URI::Escape +All needed modules are already installed diff --git a/W/prereq.scandeps b/W/prereq.scandeps index 405331b..71e273c 100644 --- a/W/prereq.scandeps +++ b/W/prereq.scandeps @@ -145,11 +145,22 @@ Example: 's/"Junk"//g' # to remove "Junk" flag. --regexflag reg : and this one, etc. - --delete : Deletes messages on host1 server after a successful - transfer. Option --delete has the following behavior: + --delete1 : Deletes messages on host1 server after a successful + transfer. Option --delete1 has the following behavior: it marks messages as deleted with the IMAP flag \Deleted, then messages are really deleted with an - EXPUNGE IMAP command. + EXPUNGE IMAP command. If expunging after each message + slows down too much the sync then use + --noexpungeaftereach to speed up. + --expunge1 : Expunge messages on host1 just before syncing a folder. + Expunge is done per folder. + Expunge aims is to really delete messages marked deleted. + An expunge is also done after each message copied + if option --delete1 is set. + --noexpunge1 : Do not expunge messages on host1. + --delete1emptyfolders : Deletes empty folders on host1, INBOX excepted. + Useful with --delete1 since what remains on host1 + is only what failed to be synced. --delete2 : Delete messages in host2 that are not in host1 server. Useful for backup or pre-sync. @@ -164,16 +175,11 @@ Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" --delete2foldersbutnot reg : Do not delete folders matching regex. Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" - --noexpunge : Do not expunge messages on host1. - Expunge really deletes messages marked deleted. - Expunge is made at the beginning, on host1 only. - Newly transferred messages are also expunged if - option --delete is given. - No expunge is done on host2 account (unless --expunge2) - --expunge1 : Expunge messages on host1 after messages transfer. + --expunge2 : Expunge messages on host2 after messages transfer. --uidexpunge2 : uidexpunge messages on the host2 account that are not on the host1 account, requires --delete2 + --nomixfolders : Avoid merging folders that are considered different on host1 but the same on destination host2 because of case sensitivities and insensitivities. @@ -227,7 +233,7 @@ and message counts at the end. Default is on. --justfoldersizes : Exit after having printed the folder sizes. - --syncacls : Synchronises acls (Access Control Lists). + --syncacls : Synchronizes acls (Access Control Lists). --nosyncacls : Does not synchronize acls. This is the default. Acls in IMAP are not standardized, be careful. @@ -274,213 +280,177 @@ --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ --host2 test2.lamiral.info --user2 test2 --password2 secret2 -Here is a [linux] system (Linux petite 3.13.0-92-generic #139-Ubuntu SMP Tue Jun 28 20:42:32 UTC 2016 i686) -with Perl 5.18.2 Mail::IMAPClient 3.35 -$Id: prereq.scandeps,v 1.4 2016/08/19 10:55:47 gilles Exp gilles $ -This imapsync is up to date +Here is a [linux] system (Linux petite 4.4.0-62-generic #83-Ubuntu SMP Wed Jan 18 14:09:55 UTC 2017 i686) +with Perl 5.22.1 Mail::IMAPClient 3.38 +$Id: prereq.scandeps,v 1.7 2017/03/01 00:12:42 gilles Exp gilles $ +This imapsync is up to date. ( local 1.776 >= official 1.727 ) Homepage: http://imapsync.lamiral.info/ -[MSG] No '/home/gilles/.cpanplus/custom-sources' dir, skipping custom sources -[MSG] No '/home/gilles/.cpanplus/custom-sources' dir, skipping custom sources -[MSG] No '/home/gilles/.cpanplus/custom-sources' dir, skipping custom sources -'Tie::Hash::NamedCapture' => '0.09', -'Authen::NTLM::DES' => '1.02', -'Authen::NTLM::MD4' => '1.02', -'IO::Compress::Gzip' => '2.063', -'IO::Compress::Base::Common' => '2.063', -'IO::Compress::Gzip::Constants' => '2.063', -'IO::Uncompress::Gunzip' => '2.063', -'Compress::Raw::Zlib' => '2.063', -'Convert::ASN1::IO' => '0.26', -'Convert::ASN1::_decode' => '0.26', -'Convert::ASN1::_encode' => '0.26', -'Convert::ASN1::parser' => '0.26', -'Crypt::SSLeay::X509' => 'undef', -'Crypt::SSLeay::CTX' => 'undef', -'Digest::HMAC' => '1.03', -'Encode::HanExtra' => '0.23', -'HTML::Parser' => '3.71', -'HTTP::Cookies::Netscape' => '6.00', -'Time::Zone' => '2.24', -'IO::Compress::Bzip2' => '2.063', -'IO::Compress::Deflate' => '2.063', -'IO::HTML' => '1.00', -'IO::Uncompress::Bunzip2' => '2.063', -'IO::Uncompress::Inflate' => '2.063', -'IO::Uncompress::RawInflate' => '2.063', -'HTTP::Message' => '6.06', -'File::GlobMapper' => '1.000', -'IO::Compress::Base' => '2.063', -'IO::Compress::Adapter::Bzip2' => '2.063', -'IO::Compress::Zlib::Constants' => '2.063', -'IO::Compress::RawDeflate' => '2.063', -'IO::Compress::Adapter::Deflate' => '2.063', -'Socket6' => '0.25', -'URI::data' => 'undef', -'URI::_idna' => 'undef', -'URI::_generic' => 'undef', -'URI::mailto' => 'undef', -'URI::_query' => 'undef', -'URI::QueryParam' => 'undef', -'URI::Split' => 'undef', -'URI::_foreign' => 'undef', -'URI::_segment' => 'undef', -'URI::file::FAT' => 'undef', -'URI::file::Mac' => 'undef', -'URI::file::OS2' => 'undef', -'URI::file::QNX' => 'undef', -'URI::ftp' => 'undef', -'URI::gopher' => 'undef', -'URI::https' => 'undef', -'URI::ldapi' => 'undef', -'URI::ldaps' => 'undef', -'URI::mms' => 'undef', -'URI::nntp' => 'undef', -'URI::pop' => 'undef', -'URI::rlogin' => 'undef', -'URI::rsync' => 'undef', -'URI::rtspu' => 'undef', -'URI::sips' => 'undef', -'URI::snews' => 'undef', -'URI::ssh' => 'undef', -'URI::telnet' => 'undef', -'URI::tn3270' => 'undef', -'URI::file::Win32' => 'undef', -'URI::file::Unix' => 'undef', -'URI::file::Base' => 'undef', -'URI::_punycode' => '0.04', -'URI::IRI' => 'undef', -'URI::_ldap' => '1.12', -'URI::ldap' => '1.12', -'URI::news' => 'undef', -'URI::rtsp' => 'undef', -'URI::Heuristic' => '4.20', -'URI::sip' => '0.11', -'URI::_userpass' => 'undef', -'URI::_login' => 'undef', -'URI::file' => '4.21', -'URI::WithBase' => '2.20', -'URI' => '1.60', -'URI::_server' => 'undef', -'Net::SSLeay' => '1.58', -'Compress::Raw::Bzip2' => '2.063', -'IO::Uncompress::Adapter::Bunzip2' => '2.063', -'IO::Uncompress::Base' => '2.063', -'IO::Compress::Zlib::Extra' => '2.063', -'IO::Uncompress::Adapter::Inflate' => '2.063', -'JSON::WebToken::Constants' => 'undef', -'JSON::WebToken::Exception' => 'undef', -'Module::Runtime' => '0.013', -'JSON::WebToken::Crypt' => 'undef', -'common::sense' => '3.72', -'Authen::NTLM' => '1.09', -'HTTP::Status' => '6.03', -'LWP::Protocol' => '6.00', -'HTTP::Response' => '6.04', -'CPAN::Config' => 'undef', -'LWP::MediaTypes' => '6.02', -'HTTP::Request' => '6.00', -'HTTP::Date' => '6.02', -'File::Listing' => '6.04', -'HTTP::Negotiate' => '6.00', -'Net::HTTP' => '6.06', -'Net::HTTPS' => '6.04', -'Net::SSL' => '2.85', -'LWP::Debug' => 'undef', -'Net::LDAP::DSML' => '0.16', -'Net::LDAP' => '0.58', -'Net::LDAP::LDIF' => '0.22', -'Mail::Internet' => '2.12', -'HTML::HeadParser' => '3.71', -'HTTP::Config' => '6.00', -'HTTP::Request::Common' => '6.04', -'LWP::ConnCache' => '6.02', -'HTTP::Cookies' => '6.00', -'HTTP::Headers' => '6.05', -'Encode::Locale' => '1.03', -'HTTP::Headers::Util' => '6.03', -'LWP::MemberMixin' => 'undef', -'LWP' => '6.05', -'Compress::Zlib' => '2.063', -'Mail::IMAPClient::MessageSet' => 'undef', -'Digest::HMAC_MD5' => '1.01', -'Mail::Address' => '2.12', -'Mail::Header' => '2.12', -'Mail::Mailer' => '2.12', -'Mail::Util' => '2.12', -'Net::HTTP::Methods' => '6.06', -'Net::LDAP::Bind' => '1.04', -'Net::LDAP::Extension' => '1.03', -'Net::LDAP::RootDSE' => '0.02', -'Net::LDAP::Search' => '0.14', -'Convert::ASN1::Debug' => '0.26', -'Convert::ASN1' => '0.26', -'Net::LDAP::Constant' => '0.22', -'Net::LDAP::ASN' => '0.11', -'Net::LDAP::Message' => '1.12', -'Net::LDAP::Filter' => '0.19', -'XML::SAX::Base' => '1.07', -'Net::LDAP::Schema' => '0.9908', -'Net::LDAP::Entry' => '0.26', -'Net::LDAP::Control' => '0.15', -'Net::LDAP::Util' => '0.18', -'Net::LDAP::Intermediate' => '0.04', -'Crypt::SSLeay::Conn' => 'undef', -'Crypt::SSLeay::Err' => 'undef', -'Crypt::SSLeay::MainContext' => 'undef', -'Crypt::SSLeay' => '0.58', -'Readonly::Array' => '1.04', -'Readonly::Hash' => '1.04', -'Readonly::Scalar' => '1.04', -'Test::Builder::IO::Scalar' => '2.110', -'UNIVERSAL::can' => '1.20140124', -'UNIVERSAL::isa' => '1.20120726', -'Test::Builder' => '1.001002', -'Test::Builder::Module' => '1.001002', -'Unicode::CharName' => '1.07', -'XML::SAX::Exception' => '1.07', -'Crypt::OpenSSL::Bignum' => '0.04', -'Crypt::OpenSSL::Random' => '0.04', -'Data::Uniqid' => '0.12', -'Digest::HMAC_SHA1' => '1.03', -'File::Copy::Recursive' => '0.38', -'IO::Tee' => '0.64', -'JSON::WebToken' => '0.10', -'JSON::WebToken::Crypt::RSA' => 'undef', -'Readonly' => '1.04', -'Term::ReadKey' => '2.31', -'Test::MockObject' => '1.20120301', -'Test::More' => '1.001002', -'Unicode::String' => '2.09', -'File::Spec::Unix' => '3.40', -'File::Spec' => '3.40', -'Cwd' => '3.40', -'URI::http' => 'undef', -'URI::URL' => '5.04', -'URI::Escape' => '3.31', -'JSON' => '2.61', -'JSON::XS::Boolean' => 'undef', -'JSON::XS' => '2.34', -'Crypt::OpenSSL::RSA' => '0.28', -'LWP::UserAgent' => '6.05', -'HTML::Entities' => '3.69', -'LWP::Protocol::http' => 'undef', -'IO::Socket::SSL' => '1.965', -'LWP::Protocol::ldap' => '1.25', -'LWP::Authen::Digest' => 'undef', -'LWP::Authen::Ntlm' => '6.00', -'LWP::Protocol::GHTTP' => 'undef', -'LWP::Protocol::cpan' => 'undef', -'LWP::Protocol::data' => 'undef', -'LWP::Protocol::file' => 'undef', -'LWP::Protocol::ftp' => 'undef', -'LWP::Protocol::gopher' => 'undef', -'LWP::Protocol::https' => '6.04', -'LWP::Protocol::ldapi' => 'undef', -'LWP::Protocol::ldaps' => 'undef', -'LWP::Protocol::loopback' => 'undef', -'LWP::Protocol::mailto' => 'undef', -'LWP::Protocol::nntp' => 'undef', -'LWP::Protocol::nogo' => 'undef', -'LWP::Authen::Basic' => 'undef', +'Tie::Hash::NamedCapture' => '0.09', +'Authen::NTLM::DES' => '1.02', +'Authen::NTLM::MD4' => '1.02', +'CGI::Cookie' => '4.26', +'CGI::File::Temp' => '4.26', +'CGI::Util' => '4.26', +'Fh' => '4.26', +'Convert::ASN1::IO' => '0.27', +'Convert::ASN1::_decode' => '0.27', +'Convert::ASN1::_encode' => '0.27', +'Convert::ASN1::parser' => '0.27', +'Digest::HMAC' => '1.03', +'HTML::Parser' => '3.72', +'HTTP::Cookies::Netscape' => '6.00', +'IO::HTML' => '1.001', +'HTTP::Headers' => '6.11', +'HTTP::Message' => '6.11', +'IO::Socket::SSL::PublicSuffix' => 'undef', +'Net::SSLeay' => '1.72', +'Socket6' => '0.25', +'JSON::WebToken::Constants' => 'undef', +'JSON::WebToken::Exception' => 'undef', +'Module::Runtime' => '0.014', +'JSON::WebToken::Crypt' => 'undef', +'Types::Serialiser' => '1.0', +'common::sense' => '3.74', +'CPAN::Config' => 'undef', +'URI::_foreign' => '1.71', +'URI::mailto' => '1.71', +'URI::data' => '1.71', +'URI::_query' => '1.71', +'URI' => '1.71', +'URI::QueryParam' => '1.71', +'URI::Split' => '1.71', +'URI::_segment' => '1.71', +'URI::file::FAT' => '1.71', +'URI::file::Mac' => '1.71', +'URI::file::OS2' => '1.71', +'URI::file::QNX' => '1.71', +'URI::ftp' => '1.71', +'URI::gopher' => '1.71', +'URI::https' => '1.71', +'URI::ldapi' => '1.71', +'URI::ldaps' => '1.71', +'URI::mms' => '1.71', +'URI::nntp' => '1.71', +'URI::pop' => '1.71', +'URI::rlogin' => '1.71', +'URI::rsync' => '1.71', +'URI::rtspu' => '1.71', +'URI::sftp' => '1.71', +'URI::sips' => '1.71', +'URI::snews' => '1.71', +'URI::telnet' => '1.71', +'URI::tn3270' => '1.71', +'URI::file::Win32' => '1.71', +'URI::file::Unix' => '1.71', +'URI::file::Base' => '1.71', +'URI::_punycode' => '1.71', +'URI::IRI' => '1.71', +'URI::_ldap' => '1.71', +'URI::ldap' => '1.71', +'URI::news' => '1.71', +'URI::rtsp' => '1.71', +'URI::ssh' => '1.71', +'URI::sip' => '1.71', +'URI::Heuristic' => '4.20', +'URI::_generic' => '1.71', +'URI::_login' => '1.71', +'URI::_idna' => '1.71', +'URI::_userpass' => '1.71', +'LWP::MediaTypes' => '6.02', +'File::Listing' => '6.04', +'HTTP::Negotiate' => '6.00', +'Net::HTTP' => '6.09', +'HTTP::Status' => '6.11', +'Net::HTTPS' => '6.09', +'Net::LDAP::DSML' => '0.16', +'Net::LDAP' => '0.65', +'Net::LDAP::LDIF' => '0.26', +'Mail::Internet' => '2.13', +'HTML::HeadParser' => '3.71', +'HTTP::Config' => '6.11', +'HTTP::Request::Common' => '6.11', +'LWP::ConnCache' => '6.15', +'HTTP::Cookies' => '6.01', +'HTTP::Headers::Util' => '6.11', +'Encode::Locale' => '1.05', +'LWP::MemberMixin' => 'undef', +'LWP' => '6.15', +'HTTP::Date' => '6.02', +'HTTP::Request' => '6.11', +'LWP::Protocol' => '6.15', +'HTTP::Response' => '6.11', +'Mail::IMAPClient::MessageSet' => 'undef', +'Digest::HMAC_MD5' => '1.01', +'Authen::NTLM' => '1.09', +'Mail::Address' => '2.13', +'Mail::Header' => '2.13', +'Mail::Mailer' => '2.13', +'Mail::Util' => '2.13', +'IO::Socket::INET6' => '2.72', +'Net::HTTP::Methods' => '6.09', +'Net::LDAP::Bind' => '1.05', +'Net::LDAP::Extension' => '1.04', +'Net::LDAP::RootDSE' => '0.02', +'Net::LDAP::Search' => '0.14', +'Convert::ASN1::Debug' => '0.27', +'Convert::ASN1' => '0.27', +'Net::LDAP::Message' => '1.12', +'Net::LDAP::Schema' => '0.9908', +'Net::LDAP::Entry' => '0.27', +'Net::LDAP::ASN' => '0.12', +'Net::LDAP::Filter' => '0.20', +'Net::LDAP::Constant' => '0.23', +'XML::SAX::Base' => '1.07', +'Net::LDAP::Control' => '0.18', +'Net::LDAP::Util' => '0.19', +'Net::LDAP::Intermediate' => '0.04', +'UNIVERSAL::can' => '1.20140328', +'UNIVERSAL::isa' => '1.20150614', +'URI::WithBase' => '2.20', +'URI::file' => '4.21', +'URI::_server' => '1.71', +'Unicode::CharName' => '1.07', +'XML::SAX::Exception' => '1.07', +'CGI::Carp' => '4.26', +'Data::Uniqid' => '0.12', +'Digest::HMAC_SHA1' => '1.03', +'File::Copy::Recursive' => '0.38', +'IO::Tee' => '0.64', +'JSON::WebToken' => '0.10', +'JSON::WebToken::Crypt::RSA' => 'undef', +'Readonly' => '2.00', +'Sys::MemInfo' => '0.98', +'Term::ReadKey' => '2.33', +'Test::MockObject' => '1.20150527', +'Unicode::String' => '2.09', +'HTML::Entities' => '3.69', +'CGI' => '4.26', +'LWP::Authen::Digest' => 'undef', +'LWP::Authen::Ntlm' => '6.15', +'LWP::Protocol::GHTTP' => 'undef', +'LWP::Protocol::cpan' => 'undef', +'LWP::Protocol::data' => 'undef', +'LWP::Protocol::file' => 'undef', +'LWP::Protocol::ftp' => 'undef', +'LWP::Protocol::gopher' => 'undef', +'LWP::Protocol::https' => '6.06', +'LWP::Protocol::ldapi' => 'undef', +'LWP::Protocol::ldaps' => 'undef', +'LWP::Protocol::loopback' => 'undef', +'LWP::Protocol::mailto' => 'undef', +'LWP::Protocol::nntp' => 'undef', +'LWP::UserAgent' => '6.15', +'JSON' => '2.90', +'JSON::XS::Boolean' => 'undef', +'Crypt::OpenSSL::RSA' => '0.28', +'JSON::XS' => '3.01', +'LWP::Authen::Basic' => 'undef', +'URI::URL' => '5.04', +'URI::http' => '1.71', +'URI::Escape' => '3.31', +'LWP::Protocol::http' => 'undef', +'IO::Socket::SSL' => '2.024', +'LWP::Protocol::ldap' => '1.25', +'LWP::Protocol::nogo' => 'undef', diff --git a/W/prereq.scandeps.Ubuntu_16.04.txt b/W/prereq.scandeps.Ubuntu_16.04.txt new file mode 100644 index 0000000..b17845d --- /dev/null +++ b/W/prereq.scandeps.Ubuntu_16.04.txt @@ -0,0 +1,457 @@ + + usage: imapsync [options] + + Several options are mandatory. + str means string + int means integer + reg means regular expression + cmd means command + + --dry : Makes imapsync doing nothing, just print what would + be done without --dry. + + --host1 str : Source or "from" imap server. Mandatory. + --port1 int : Port to connect on host1. Default is 143, 993 if --ssl1 + --user1 str : User to login on host1. Mandatory. + --showpasswords : Shows passwords on output instead of "MASKED". + Useful to restart a complete run by just reading the log. + --password1 str : Password for the user1. + --host2 str : "destination" imap server. Mandatory. + --port2 int : Port to connect on host2. Default is 143, 993 if --ssl2 + --user2 str : User to login on host2. Mandatory. + --password2 str : Password for the user2. + + --passfile1 str : Password file for the user1. It must contain the + password on the first line. This option avoids to show + the password on the command line like --password1 does. + --passfile2 str : Password file for the user2. Contains the password. + + --ssl1 : Use a SSL connection on host1. + --ssl2 : Use a SSL connection on host2. + --tls1 : Use a TLS connection on host1. + --tls2 : Use a TLS connection on host2. + --debugssl int : SSL debug mode from 0 to 4. + --sslargs1 str : Pass any ssl parameter for host1 ssl or tls connection. Example: + --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3 + See all possibilities in the new() method of IO::Socket::SSL + http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods + --sslargs2 str : Pass any ssl parameter for host2 ssl or tls connection. + See --sslargs1 + + --timeout1 int : Connection timeout in seconds for host1. + Default is 120 and 0 means no timeout at all. + --timeout2 int : Connection timeout in seconds for host2. + Default is 120 and 0 means no timeout at all. + + --authmech1 str : Auth mechanism to use with host1: + PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. + --authmech2 str : Auth mechanism to use with host2. See --authmech1 + + --authuser1 str : User to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. + --authuser2 str : User to auth with on host2 (admin user). + --proxyauth1 : Use proxyauth on host1. Requires --authuser1. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user. + --proxyauth2 : Use proxyauth on host2. Requires --authuser2. + + --authmd51 : Use MD5 authentification for host1. + --authmd52 : Use MD5 authentification for host2. + --domain1 str : Domain on host1 (NTLM authentication). + --domain2 str : Domain on host2 (NTLM authentication). + + + --folder str : Sync this folder. + --folder str : and this one, etc. + --folderrec str : Sync this folder recursively. + --folderrec str : and this one, etc. + + --folderfirst str : Sync this folder first. --folderfirst "Work" + --folderfirst str : then this one, etc. + --folderlast str : Sync this folder last. --folderlast "[Gmail]/All Mail" + --folderlast str : then this one, etc. + + --nomixfolders : Do not merge folders when host1 is case sensitive + while host2 is not (like Exchange). Only the first + similar folder is synced (ex: Sent SENT sent -> Sent). + + --skipemptyfolders : Empty host1 folders are not created on host2. + + --include reg : Sync folders matching this regular expression + --include reg : or this one, etc. + in case both --include --exclude options are + use, include is done before. + --exclude reg : Skips folders matching this regular expression + Several folders to avoid: + --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. + --exclude reg : or this one, etc. + + --subfolder2 str : Move whole host1 folders hierarchy under this + host2 folder str . + It does it by adding two --regextrans2 options before + all others. Add --debug to see what's really going on. + + --automap : guesses folders mapping, for folders like + "Sent", "Junk", "Drafts", "All", "Archive", "Flagged". + --f1f2 str1=str2 : Force folder str1 to be synced to str2, + --f1f2 overrides --automap and --regextrans2. + --regextrans2 reg : Apply the whole regex to each destination folders. + --regextrans2 reg : 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. + Have in mind that --regextrans2 is applied after prefix + and separator inversion. For examples see + http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt + + --tmpdir str : Where to store temporary files and subdirectories. + Will be created if it doesn't exist. + Default is system specific, Unix is /tmp but + it's often small and deleted at reboot. + --tmpdir /var/tmp should be better. + --pidfile str : The file where imapsync pid is written. + --pidfilelocking : Abort if pidfile already exists. Usefull to avoid + concurrent transfers on the same mailbox. + + --nolog : Turn off logging on file + --logfile str : Change the default log filename (can be dirname/filename). + --logdir str : Change the default log directory. Default is LOG_imapsync + + --prefix1 str : Remove prefix to all destination folders + (usually INBOX. or INBOX/ or an empty string "") + you have to use --prefix1 if host1 imap server + does not have NAMESPACE capability, so imapsync + suggests to use it. All other cases are bad. + --prefix2 str : Add prefix to all host2 folders. See --prefix1 + --sep1 str : Host1 separator in case NAMESPACE is not supported. + --sep2 str : Host2 separator in case NAMESPACE is not supported. + + --skipmess reg : Skips messages maching the regex. + Example: 'm/[\x80-ff]/' # to avoid 8bits messages. + --skipmess is applied before --regexmess + --skipmess reg : or this one, etc. + + --pipemess cmd : Apply this cmd command to each message content + before the copy. + --pipemess cmd : and this one, etc. + + --disarmreadreceipts : Disarms read receipts (host2 Exchange issue) + + --regexmess reg : Apply the whole regex to each message before transfer. + Example: 's/\000/ /g' # to replace null by space. + --regexmess reg : and this one, etc. + + --regexflag reg : Apply the whole regex to each flags list. + Example: 's/"Junk"//g' # to remove "Junk" flag. + --regexflag reg : and this one, etc. + + --delete1 : Deletes messages on host1 server after a successful + transfer. Option --delete1 has the following behavior: + it marks messages as deleted with the IMAP flag + \Deleted, then messages are really deleted with an + EXPUNGE IMAP command. If expunging after each message + slows down too much the sync then use + --noexpungeaftereach to speed up. + --expunge1 : Expunge messages on host1 just before syncing a folder. + Expunge is done per folder. + Expunge aims is to really delete messages marked deleted. + An expunge is also done after each message copied + if option --delete1 is set. + --noexpunge1 : Do not expunge messages on host1. + --delete1emptyfolders : Deletes empty folders on host1, INBOX excepted. + Useful with --delete1 since what remains on host1 + is only what failed to be synced. + + --delete2 : Delete messages in host2 that are not in + host1 server. Useful for backup or pre-sync. + --delete2duplicates : Delete messages in host2 that are duplicates. + Works only without --useuid since duplicates are + detected with an header part of each message. + + --delete2folders : Delete folders in host2 that are not in host1 server. + For safety, first try it like this (it is safe): + --delete2folders --dry --justfolders --nofoldersizes + --delete2foldersonly reg : Deleted only folders matching regex. + Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" + --delete2foldersbutnot reg : Do not delete folders matching regex. + Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" + + --expunge2 : Expunge messages on host2 after messages transfer. + --uidexpunge2 : uidexpunge messages on the host2 account + that are not on the host1 account, requires --delete2 + + --nomixfolders : Avoid merging folders that are considered different on + host1 but the same on destination host2 because of + case sensitivities and insensitivities. + + --syncinternaldates : Sets the internal dates on host2 same as host1. + Turned on by default. Internal date is the date + a message arrived on a host (mtime). + --idatefromheader : Sets the internal dates on host2 same as the + "Date:" headers. + + --maxsize int : Skip messages larger (or equal) than int bytes + --minsize int : Skip messages smaller (or equal) than int bytes + --maxage int : Skip messages older than int days. + final stats (skipped) don't count older messages + see also --minage + --minage int : Skip messages newer than int days. + final stats (skipped) don't count newer messages + You can do (+ are the messages selected): + past|----maxage+++++++++++++++>now + past|+++++++++++++++minage---->now + past|----maxage+++++minage---->now (intersection) + past|++++minage-----maxage++++>now (union) + + --search str : Selects only messages returned by this IMAP SEARCH + command. Applied on both sides. + --search1 str : Same as --search for selecting host1 messages only. + --search2 str : Same as --search for selecting host2 messages only. + --search CRIT equals --search1 CRIT --search2 CRIT + + --exitwhenover int : Stop syncing when total bytes transferred reached. + Gmail per day allows + 2500000000 = 2.5 GB downloaded from Gmail as host2 + 500000000 = 500 MB uploaded to Gmail as host1. + + --maxlinelength int : skip messages with a line length longer than int bytes. + RFC 2822 says it must be no more than 1000 bytes. + + --useheader str : Use this header to compare messages on both sides. + Ex: Message-ID or Subject or Date. + --useheader str and this one, etc. + + --subscribed : Transfers subscribed folders. + --subscribe : Subscribe to the folders transferred on the + host2 that are subscribed on host1. On by default. + --subscribeall : Subscribe to the folders transferred on the + host2 even if they are not subscribed on host1. + + --nofoldersizes : Do not calculate the size of each folder in bytes + and message counts. Default is to calculate them. + --nofoldersizesatend: Do not calculate the size of each folder in bytes + and message counts at the end. Default is on. + --justfoldersizes : Exit after having printed the folder sizes. + + --syncacls : Synchronizes acls (Access Control Lists). + --nosyncacls : Does not synchronize acls. This is the default. + Acls in IMAP are not standardized, be careful. + + --usecache : Use cache to speedup. + --nousecache : Do not use cache. Caveat: --useuid --nousecache creates + duplicates on multiple runs. + --useuid : Use uid instead of header as a criterium to recognize + messages. Option --usecache is then implied unless + --nousecache is used. + + --debug : Debug mode. + --debugfolders : Debug mode for the folders part only. + --debugcontent : Debug content of the messages transfered. Huge ouput. + --debugflags : Debug mode for flags. + --debugimap1 : IMAP debug mode for host1. Very verbose. + --debugimap2 : IMAP debug mode for host2. Very verbose. + --debugimap : IMAP debug mode for host1 and host2. + --debugmemory : Debug mode showing memory consumption after each copy. + + --errorsmax int : Exit when int number of errors is reached. Default is 50. + + --tests : Run local non-regression tests. Exit code 0 means all ok. + --testslive : Run a live test with test1.lamiral.info imap server. + Useful to check the basics. Needs internet connexion. + + --version : Print only software version. + --noreleasecheck : Do not check for new imapsync release (a http request). + --releasecheck : Check for new imapsync release (a http request). + --noid : Do not send/receive ID command to imap servers. + --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 : Do only things about folders (ignore messages). + + --help : print this help. + + Example: to synchronize imap account "test1" on "test1.lamiral.info" + to imap account "test2" on "test2.lamiral.info" + with test1 password "secret1" + and test2 password "secret2" + + imapsync \ + --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ + --host2 test2.lamiral.info --user2 test2 --password2 secret2 + +Here is a 2.0 GiB [linux] system (Linux petite 4.4.0-64-generic #85-Ubuntu SMP Mon Feb 20 11:49:39 UTC 2017 i686) +with Perl 5.22.1and Mail::IMAPClient 3.38 +$Id: prereq.scandeps.Ubuntu_16.04.txt,v 1.1 2017/03/22 00:36:33 gilles Exp gilles $ +This imapsync is up to date. ( local 1.788 >= official 1.727 ) + +Homepage: http://imapsync.lamiral.info/ + +'Tie::Hash::NamedCapture' => '0.09', +'Authen::NTLM::DES' => '1.02', +'Authen::NTLM::MD4' => '1.02', +'CGI::Cookie' => '4.26', +'CGI::File::Temp' => '4.26', +'CGI::Util' => '4.26', +'Fh' => '4.26', +'Convert::ASN1::IO' => '0.27', +'Convert::ASN1::_decode' => '0.27', +'Convert::ASN1::_encode' => '0.27', +'Convert::ASN1::parser' => '0.27', +'Digest::HMAC' => '1.03', +'HTML::Parser' => '3.72', +'HTTP::Headers' => '6.11', +'HTTP::Cookies::Netscape' => '6.00', +'IO::HTML' => '1.001', +'HTTP::Message' => '6.11', +'IO::Socket::SSL::PublicSuffix' => 'undef', +'Net::SSLeay' => '1.72', +'Socket6' => '0.25', +'JSON::WebToken::Constants' => 'undef', +'JSON::WebToken::Exception' => 'undef', +'Module::Runtime' => '0.014', +'JSON::WebToken::Crypt' => 'undef', +'Types::Serialiser' => '1.0', +'common::sense' => '3.74', +'Authen::NTLM' => '1.09', +'CPAN::Config' => 'undef', +'URI::_foreign' => '1.71', +'URI::_generic' => '1.71', +'URI::mailto' => '1.71', +'URI::data' => '1.71', +'URI::_query' => '1.71', +'URI' => '1.71', +'URI::QueryParam' => '1.71', +'URI::Split' => '1.71', +'URI::_segment' => '1.71', +'URI::file::FAT' => '1.71', +'URI::file::Mac' => '1.71', +'URI::file::OS2' => '1.71', +'URI::file::QNX' => '1.71', +'URI::ftp' => '1.71', +'URI::gopher' => '1.71', +'URI::https' => '1.71', +'URI::ldapi' => '1.71', +'URI::ldaps' => '1.71', +'URI::mms' => '1.71', +'URI::nntp' => '1.71', +'URI::pop' => '1.71', +'URI::rlogin' => '1.71', +'URI::rsync' => '1.71', +'URI::rtspu' => '1.71', +'URI::sftp' => '1.71', +'URI::sips' => '1.71', +'URI::snews' => '1.71', +'URI::telnet' => '1.71', +'URI::tn3270' => '1.71', +'URI::file::Win32' => '1.71', +'URI::file::Unix' => '1.71', +'URI::file::Base' => '1.71', +'URI::_idna' => '1.71', +'URI::_punycode' => '1.71', +'URI::IRI' => '1.71', +'URI::_ldap' => '1.71', +'URI::ldap' => '1.71', +'URI::news' => '1.71', +'URI::rtsp' => '1.71', +'URI::ssh' => '1.71', +'URI::sip' => '1.71', +'URI::_userpass' => '1.71', +'URI::Heuristic' => '4.20', +'URI::_login' => '1.71', +'LWP::MediaTypes' => '6.02', +'File::Listing' => '6.04', +'HTTP::Negotiate' => '6.00', +'Net::HTTP' => '6.09', +'HTTP::Status' => '6.11', +'Net::HTTPS' => '6.09', +'Net::LDAP::DSML' => '0.16', +'Net::LDAP' => '0.65', +'Net::LDAP::LDIF' => '0.26', +'Mail::Internet' => '2.13', +'HTML::HeadParser' => '3.71', +'HTTP::Config' => '6.11', +'HTTP::Request::Common' => '6.11', +'LWP::ConnCache' => '6.15', +'HTTP::Cookies' => '6.01', +'HTTP::Headers::Util' => '6.11', +'Encode::Locale' => '1.05', +'LWP::MemberMixin' => 'undef', +'LWP' => '6.15', +'HTTP::Date' => '6.02', +'HTTP::Request' => '6.11', +'LWP::Protocol' => '6.15', +'HTTP::Response' => '6.11', +'Mail::IMAPClient::MessageSet' => 'undef', +'Digest::HMAC_MD5' => '1.01', +'Mail::Address' => '2.13', +'Mail::Header' => '2.13', +'Mail::Mailer' => '2.13', +'Mail::Util' => '2.13', +'Net::HTTP::Methods' => '6.09', +'Net::LDAP::Bind' => '1.05', +'Net::LDAP::Extension' => '1.04', +'Net::LDAP::RootDSE' => '0.02', +'Net::LDAP::Search' => '0.14', +'Convert::ASN1::Debug' => '0.27', +'Convert::ASN1' => '0.27', +'Net::LDAP::Schema' => '0.9908', +'Net::LDAP::Entry' => '0.27', +'Net::LDAP::Message' => '1.12', +'Net::LDAP::ASN' => '0.12', +'Net::LDAP::Constant' => '0.23', +'Net::LDAP::Filter' => '0.20', +'XML::SAX::Base' => '1.07', +'Net::LDAP::Control' => '0.18', +'Net::LDAP::Util' => '0.19', +'Net::LDAP::Intermediate' => '0.04', +'IO::Socket::INET6' => '2.72', +'UNIVERSAL::can' => '1.20140328', +'UNIVERSAL::isa' => '1.20150614', +'URI::WithBase' => '2.20', +'URI::file' => '4.21', +'URI::_server' => '1.71', +'Unicode::CharName' => '1.07', +'XML::SAX::Exception' => '1.07', +'CGI::Carp' => '4.26', +'Data::Uniqid' => '0.12', +'Digest::HMAC_SHA1' => '1.03', +'File::Copy::Recursive' => '0.38', +'IO::Tee' => '0.64', +'JSON::WebToken' => '0.10', +'JSON::WebToken::Crypt::RSA' => 'undef', +'Mail::IMAPClient' => '3.38', +'Readonly' => '2.00', +'Sys::MemInfo' => '0.98', +'Term::ReadKey' => '2.33', +'Test::MockObject' => '1.20150527', +'Unicode::String' => '2.09', +'CGI' => '4.26', +'Crypt::OpenSSL::RSA' => '0.28', +'LWP::Authen::Digest' => 'undef', +'LWP::Authen::Ntlm' => '6.15', +'LWP::Protocol::GHTTP' => 'undef', +'LWP::Protocol::cpan' => 'undef', +'LWP::Protocol::data' => 'undef', +'LWP::Protocol::file' => 'undef', +'LWP::Protocol::ftp' => 'undef', +'LWP::Protocol::gopher' => 'undef', +'LWP::Protocol::https' => '6.06', +'LWP::Protocol::ldapi' => 'undef', +'LWP::Protocol::ldaps' => 'undef', +'LWP::Protocol::loopback' => 'undef', +'LWP::Protocol::mailto' => 'undef', +'LWP::Protocol::nntp' => 'undef', +'LWP::UserAgent' => '6.15', +'LWP::Authen::Basic' => 'undef', +'URI::URL' => '5.04', +'URI::http' => '1.71', +'HTML::Entities' => '3.69', +'URI::Escape' => '3.31', +'LWP::Protocol::http' => 'undef', +'IO::Socket::SSL' => '2.024', +'JSON' => '2.90', +'JSON::XS::Boolean' => 'undef', +'JSON::XS' => '3.01', +'LWP::Protocol::ldap' => '1.25', +'LWP::Protocol::nogo' => 'undef', diff --git a/W/prereq.scandeps.Ubuntu_16.04_xenial.txt b/W/prereq.scandeps.Ubuntu_16.04_xenial.txt new file mode 100644 index 0000000..cb793e6 --- /dev/null +++ b/W/prereq.scandeps.Ubuntu_16.04_xenial.txt @@ -0,0 +1,582 @@ +Name: + + imapsync - Email IMAP tool for syncing, copying and migrating email + mailboxes between two imap servers, one way, and without duplicates. + +Version: + + This documentation refers to Imapsync $Revision: 1.1 $ + +Usage: + + To synchronize the source imap account + "test1" on server "test1.lamiral.info" with password "secret1" + to the destination imap account + "test2" on server "test2.lamiral.info" with password "secret2" + do: + + imapsync \ + --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ + --host2 test2.lamiral.info --user2 test2 --password2 secret2 + +Options: + + usage: imapsync [options] + + Mandatory options are the six values, three on each sides, needed to log in + into the IMAP servers, ie, a host, a username, and a password, two times. + + Conventions used: + + str means string + int means integer + reg means regular expression + cmd means command + + --dry : Makes imapsync doing nothing for real, just print what + would be done without --dry. + +Options/credentials: + + --host1 str : Source or "from" imap server. Mandatory. + --port1 int : Port to connect on host1. Default is 143, 993 if --ssl1 + --user1 str : User to login on host1. Mandatory. + --password1 str : Password for the user1. + --host2 str : "destination" imap server. Mandatory. + --port2 int : Port to connect on host2. Default is 143, 993 if --ssl2 + --user2 str : User to login on host2. Mandatory. + --password2 str : Password for the user2. + + --showpasswords : Shows passwords on output instead of "MASKED". + Useful to restart a complete run by just reading the log, + or to debug passwords. It's not a secure practice. + + --passfile1 str : Password file for the user1. It must contain the + password on the first line. This option avoids to show + the password on the command line like --password1 does. + --passfile2 str : Password file for the user2. Contains the password. + +Options/encryption: + + --nossl1 : Do not use a SSL connection on host1. + --ssl1 : Use a SSL connection on host1. On by default if possible. + --nossl2 : Do not use a SSL connection on host2. + --ssl2 : Use a SSL connection on host2. On by default if possible. + --notls1 : Do not use a TLS connection on host1. + --tls1 : Use a TLS connection on host1. On by default if possible. + --notls2 : Do not use a TLS connection on host2. + --tls2 : Use a TLS connection on host2. On by default if possible. + --debugssl int : SSL debug mode from 0 to 4. + --sslargs1 str : Pass any ssl parameter for host1 ssl or tls connection. Example: + --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3 + See all possibilities in the new() method of IO::Socket::SSL + http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods + --sslargs2 str : Pass any ssl parameter for host2 ssl or tls connection. + See --sslargs1 + + --timeout1 int : Connection timeout in seconds for host1. + Default is 120 and 0 means no timeout at all. + --timeout2 int : Connection timeout in seconds for host2. + Default is 120 and 0 means no timeout at all. + +Options/authentication: + + --authmech1 str : Auth mechanism to use with host1: + PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. + --authmech2 str : Auth mechanism to use with host2. See --authmech1 + + --authuser1 str : User to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. + --authuser2 str : User to auth with on host2 (admin user). + --proxyauth1 : Use proxyauth on host1. Requires --authuser1. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user. + --proxyauth2 : Use proxyauth on host2. Requires --authuser2. + + --authmd51 : Use MD5 authentication for host1. + --authmd52 : Use MD5 authentication for host2. + --domain1 str : Domain on host1 (NTLM authentication). + --domain2 str : Domain on host2 (NTLM authentication). + +Options/folders: + + --folder str : Sync this folder. + --folder str : and this one, etc. + --folderrec str : Sync this folder recursively. + --folderrec str : and this one, etc. + + --folderfirst str : Sync this folder first. --folderfirst "Work" + --folderfirst str : then this one, etc. + --folderlast str : Sync this folder last. --folderlast "[Gmail]/All Mail" + --folderlast str : then this one, etc. + + --nomixfolders : Do not merge folders when host1 is case-sensitive + while host2 is not (like Exchange). Only the first + similar folder is synced (ex: Sent SENT sent -> Sent). + + --skipemptyfolders : Empty host1 folders are not created on host2. + + --include reg : Sync folders matching this regular expression + --include reg : or this one, etc. + If both --include --exclude options are used, then + include is done before. + --exclude reg : Skips folders matching this regular expression + Several folders to avoid: + --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. + --exclude reg : or this one, etc. + + --subfolder2 str : Move whole host1 folders hierarchy under this + host2 folder str . + It does it by adding two --regextrans2 options before + all others. Add --debug to see what's really going on. + + --automap : guesses folders mapping, for folders like + "Sent", "Junk", "Drafts", "All", "Archive", "Flagged". + --f1f2 str1=str2 : Force folder str1 to be synced to str2, + --f1f2 overrides --automap and --regextrans2. + + --nomixfolders : Avoid merging folders that are considered different on + host1 but the same on destination host2 because of + case sensitivities and insensitivities. + + --subscribed : Transfers subscribed folders. + --subscribe : Subscribe to the folders transferred on the + host2 that are subscribed on host1. On by default. + --subscribeall : Subscribe to the folders transferred on the + host2 even if they are not subscribed on host1. + + --prefix1 str : Remove prefix str to all destination folders, + usually INBOX. or INBOX/ or an empty string "". + imapsync guesses the prefix if host1 imap server + does not have NAMESPACE capability. This option + should not be used, most of the time. + --prefix2 str : Add prefix to all host2 folders. See --prefix1 + --sep1 str : Host1 separator in case NAMESPACE is not supported. + --sep2 str : Host2 separator in case NAMESPACE is not supported. + + --regextrans2 reg : Apply the whole regex to each destination folders. + --regextrans2 reg : 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. + Have in mind that --regextrans2 is applied after prefix + and separator inversion. For examples see + http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt + +Options/folders sizes: + + --nofoldersizes : Do not calculate the size of each folder at the + beginning of the sync. Default is to calculate them. + --nofoldersizesatend: Do not calculate the size of each folder at the + end of the sync. Default is to calculate them. + --justfoldersizes : Exit after having printed the initial folder sizes. + +Options/tmp: + + --tmpdir str : Where to store temporary files and subdirectories. + Will be created if it doesn't exist. + Default is system specific, Unix is /tmp but + /tmp is often too small and deleted at reboot. + --tmpdir /var/tmp should be better. + --pidfile str : The file where imapsync pid is written, + it can be dirname/filename. + Default name is imapsync.pid in tmpdir. + --pidfilelocking : Abort if pidfile already exists. Useful to avoid + concurrent transfers on the same mailbox. + +Options/log: + + --nolog : Turn off logging on file + --logfile str : Change the default log filename (can be dirname/filename). + --logdir str : Change the default log directory. Default is LOG_imapsync/ + +Options/messages: + + --skipmess reg : Skips messages matching the regex. + Example: 'm/[\x80-ff]/' # to avoid 8bits messages. + --skipmess is applied before --regexmess + --skipmess reg : or this one, etc. + + --pipemess cmd : Apply this cmd command to each message content + before the copy. + --pipemess cmd : and this one, etc. + + --disarmreadreceipts : Disarms read receipts (host2 Exchange issue) + + --regexmess reg : Apply the whole regex to each message before transfer. + Example: 's/\000/ /g' # to replace null by space. + --regexmess reg : and this one, etc. + +Options/flags: + + --regexflag reg : Apply the whole regex to each flags list. + Example: 's/"Junk"//g' # to remove "Junk" flag. + --regexflag reg : then this one, etc. + +Options/deletions: + + --delete1 : Deletes messages on host1 server after a successful + transfer. Option --delete1 has the following behavior: + it marks messages as deleted with the IMAP flag + \Deleted, then messages are really deleted with an + EXPUNGE IMAP command. If expunging after each message + slows down too much the sync then use + --noexpungeaftereach to speed up. + --expunge1 : Expunge messages on host1 just before syncing a folder. + Expunge is done per folder. + Expunge aims is to really delete messages marked deleted. + An expunge is also done after each message copied + if option --delete1 is set. + --noexpunge1 : Do not expunge messages on host1. + --delete1emptyfolders : Deletes empty folders on host1, INBOX excepted. + Useful with --delete1 since what remains on host1 + is only what failed to be synced. + + --delete2 : Delete messages in host2 that are not in + host1 server. Useful for backup or pre-sync. + --delete2duplicates : Delete messages in host2 that are duplicates. + Works only without --useuid since duplicates are + detected with an header part of each message. + + --delete2folders : Delete folders in host2 that are not in host1 server. + For safety, first try it like this (it is safe): + --delete2folders --dry --justfolders --nofoldersizes + --delete2foldersonly reg : Deleted only folders matching regex. + Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" + --delete2foldersbutnot reg : Do not delete folders matching regex. + Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" + + --expunge2 : Expunge messages on host2 after messages transfer. + --uidexpunge2 : uidexpunge messages on the host2 account + that are not on the host1 account, requires --delete2 + +Options/dates: + + --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. + +Options/message selection: + + --maxsize int : Skip messages larger (or equal) than int bytes + --minsize int : Skip messages smaller (or equal) than int bytes + --maxage int : Skip messages older than int days. + final stats (skipped) don't count older messages + see also --minage + --minage int : Skip messages newer than int days. + final stats (skipped) don't count newer messages + You can do (+ are the messages selected): + past|----maxage+++++++++++++++>now + past|+++++++++++++++minage---->now + past|----maxage+++++minage---->now (intersection) + past|++++minage-----maxage++++>now (union) + + --search str : Selects only messages returned by this IMAP SEARCH + command. Applied on both sides. + --search1 str : Same as --search for selecting host1 messages only. + --search2 str : Same as --search for selecting host2 messages only. + --search CRIT equals --search1 CRIT --search2 CRIT + + --maxlinelength int : skip messages with a line length longer than int bytes. + RFC 2822 says it must be no more than 1000 bytes. + + + --useheader str : Use this header to compare messages on both sides. + Ex: Message-ID or Subject or Date. + --useheader str and this one, etc. + + --usecache : Use cache to speed up the sync. + --nousecache : Do not use cache. Caveat: --useuid --nousecache creates + duplicates on multiple runs. + --useuid : Use uid instead of header as a criterium to recognize + messages. Option --usecache is then implied unless + --nousecache is used. + +Options/miscelaneous: + + --syncacls : Synchronizes acls (Access Control Lists). + --nosyncacls : Does not synchronize acls. This is the default. + Acls in IMAP are not standardized, be careful. + +Options/debugging: + + --debug : Debug mode. + --debugfolders : Debug mode for the folders part only. + --debugcontent : Debug content of the messages transferred. Huge output. + --debugflags : Debug mode for flags. + --debugimap1 : IMAP debug mode for host1. Very verbose. + --debugimap2 : IMAP debug mode for host2. Very verbose. + --debugimap : IMAP debug mode for host1 and host2. + --debugmemory : Debug mode showing memory consumption after each copy. + + --errorsmax int : Exit when int number of errors is reached. Default is 50. + + --tests : Run local non-regression tests. Exit code 0 means all ok. + --testslive : Run a live test with test1.lamiral.info imap server. + Useful to check the basics. Needs internet connexion. + --testslive6 : Run a live test with ks2ipv6.lamiral.info imap server. + Useful to check the ipv6 connectivity. Needs internet. + +Options/specific: + + --gmail1 : sets --host1 to Gmail and options from FAQ.Gmail.txt + --gmail2 : sets --host2 to Gmail and options from FAQ.Gmail.txt + + --office1 : sets --host1 to Office365 options from FAQ.Exchange.txt + --office2 : sets --host2 to Office365 options from FAQ.Exchange.txt + + --exchange1 : sets options from FAQ.Exchange.txt, account1 part + --exchange2 : sets options from FAQ.Exchange.txt, account2 part + + --domino1 : sets options from FAQ.Domino.txt, account1 part + --domino2 : sets options from FAQ.Domino.txt, account2 part + +Options/behavior: + + --maxmessagespersecond int : limits the number of messages transferred per second. + + --maxbytespersecond int : limits the average transfer rate per second. + --maxbytesafter int : starts --maxbytespersecond limitation only after + --maxbytesafter amount of data transferred. + + --maxsleep int : do not sleep more than int seconds. + On by default, 2 seconds max, like --maxsleep 2 + + --abort : terminates a previous call still running. + It uses the pidfile to know what processus to abort. + + --exitwhenover int : Stop syncing when total bytes transferred reached. + + --version : Print only software version. + --noreleasecheck : Do not check for new imapsync release (a http request). + --releasecheck : Check for new imapsync release (a http request). + --noid : Do not send/receive ID command to imap servers. + --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 : Do only things about folders (ignore messages). + + --help : print this help. + + Example: to synchronize imap account "test1" on "test1.lamiral.info" + to imap account "test2" on "test2.lamiral.info" + with test1 password "secret1" + and test2 password "secret2" + + imapsync \ + --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ + --host2 test2.lamiral.info --user2 test2 --password2 secret2 + +Here is petite, a 2.0 GiB [linux] system (Linux petite 4.4.0-92-generic #115-Ubuntu SMP Thu Aug 10 16:02:55 UTC 2017 i686) +with Perl 5.22.1 and Mail::IMAPClient 3.38 +$Id: prereq.scandeps.Ubuntu_16.04_xenial.txt,v 1.1 2017/09/07 12:39:54 gilles Exp gilles $ +This imapsync is up to date. ( local 1.836 >= official 1.727 ) + +Homepage: http://imapsync.lamiral.info/ +'Tie::Hash::NamedCapture' => '0.09', +'Authen::NTLM::DES' => '1.02', +'Authen::NTLM::MD4' => '1.02', +'Crypt::Random::Seed' => '0.03', +'Math::Random::ISAAC' => '1.003', +'CGI::Cookie' => '4.26', +'CGI::File::Temp' => '4.26', +'CGI::Util' => '4.26', +'Fh' => '4.26', +'Convert::ASN1::IO' => '0.27', +'Convert::ASN1::_decode' => '0.27', +'Convert::ASN1::_encode' => '0.27', +'Convert::ASN1::parser' => '0.27', +'Bytes::Random::Secure' => '0.28', +'Crypt::SSLeay::X509' => 'undef', +'Crypt::SSLeay::CTX' => 'undef', +'Digest::HMAC' => '1.03', +'Encode::HanExtra' => '0.23', +'HTML::Parser' => '3.72', +'HTTP::Headers' => '6.11', +'HTTP::Cookies::Netscape' => '6.00', +'IO::Compress::Bzip2' => '2.069', +'IO::Compress::Deflate' => '2.069', +'IO::Compress::Gzip' => '2.069', +'IO::HTML' => '1.001', +'IO::Uncompress::Bunzip2' => '2.069', +'IO::Uncompress::Inflate' => '2.069', +'IO::Uncompress::RawInflate' => '2.069', +'IO::Uncompress::Gunzip' => '2.069', +'HTTP::Message' => '6.11', +'File::GlobMapper' => '1.000', +'IO::Compress::Adapter::Bzip2' => '2.069', +'IO::Compress::Base' => '2.069', +'IO::Compress::Zlib::Constants' => '2.069', +'IO::Compress::RawDeflate' => '2.069', +'IO::Compress::Adapter::Deflate' => '2.069', +'Socket6' => '0.25', +'IO::Socket::SSL::PublicSuffix' => 'undef', +'Net::SSLeay' => '1.72', +'Compress::Raw::Bzip2' => '2.069', +'IO::Uncompress::Adapter::Bunzip2' => '2.069', +'IO::Compress::Zlib::Extra' => '2.069', +'IO::Compress::Gzip::Constants' => '2.069', +'IO::Compress::Base::Common' => '2.069', +'IO::Uncompress::Adapter::Inflate' => '2.069', +'IO::Uncompress::Base' => '2.069', +'JSON::WebToken::Constants' => 'undef', +'JSON::WebToken::Exception' => 'undef', +'Module::Runtime' => '0.014', +'JSON::WebToken::Crypt' => 'undef', +'Types::Serialiser' => '1.0', +'common::sense' => '3.74', +'Authen::NTLM' => '1.09', +'HTTP::Status' => '6.11', +'LWP::Protocol' => '6.15', +'HTTP::Response' => '6.11', +'CPAN::Config' => 'undef', +'URI::_query' => '1.71', +'URI::data' => '1.71', +'URI::_idna' => '1.71', +'URI::mailto' => '1.71', +'URI' => '1.71', +'URI::QueryParam' => '1.71', +'URI::Split' => '1.71', +'URI::_segment' => '1.71', +'URI::file::FAT' => '1.71', +'URI::file::Mac' => '1.71', +'URI::file::OS2' => '1.71', +'URI::file::QNX' => '1.71', +'URI::ftp' => '1.71', +'URI::gopher' => '1.71', +'URI::https' => '1.71', +'URI::ldapi' => '1.71', +'URI::ldaps' => '1.71', +'URI::mms' => '1.71', +'URI::nntp' => '1.71', +'URI::pop' => '1.71', +'URI::rlogin' => '1.71', +'URI::rsync' => '1.71', +'URI::rtspu' => '1.71', +'URI::sftp' => '1.71', +'URI::sips' => '1.71', +'URI::snews' => '1.71', +'URI::telnet' => '1.71', +'URI::tn3270' => '1.71', +'URI::_foreign' => '1.71', +'URI::file::Win32' => '1.71', +'URI::file::Unix' => '1.71', +'URI::file::Base' => '1.71', +'URI::Heuristic' => '4.20', +'URI::_login' => '1.71', +'URI::IRI' => '1.71', +'URI::ldap' => '1.71', +'URI::news' => '1.71', +'URI::ssh' => '1.71', +'URI::_punycode' => '1.71', +'URI::_generic' => '1.71', +'URI::_ldap' => '1.71', +'URI::rtsp' => '1.71', +'URI::_userpass' => '1.71', +'URI::sip' => '1.71', +'URI::WithBase' => '2.20', +'URI::file' => '4.21', +'URI::_server' => '1.71', +'HTTP::Date' => '6.02', +'LWP' => '6.15', +'LWP::MediaTypes' => '6.02', +'HTTP::Request' => '6.11', +'File::Listing' => '6.04', +'HTTP::Negotiate' => '6.00', +'Net::HTTP' => '6.09', +'Net::HTTPS' => '6.09', +'Net::SSL' => '2.88', +'Net::LDAP::DSML' => '0.16', +'Net::LDAP' => '0.65', +'Net::LDAP::LDIF' => '0.26', +'Mail::Internet' => '2.13', +'HTML::HeadParser' => '3.71', +'HTTP::Config' => '6.11', +'HTTP::Request::Common' => '6.11', +'LWP::ConnCache' => '6.15', +'HTTP::Cookies' => '6.01', +'Encode::Locale' => '1.05', +'HTTP::Headers::Util' => '6.11', +'LWP::MemberMixin' => 'undef', +'Mail::IMAPClient::MessageSet' => 'undef', +'Digest::HMAC_MD5' => '1.01', +'Mail::Address' => '2.13', +'Mail::Header' => '2.13', +'Mail::Mailer' => '2.13', +'Mail::Util' => '2.13', +'Math::Random::ISAAC::PP' => '1.003', +'Math::Random::ISAAC::XS' => '1.004', +'Net::HTTP::Methods' => '6.09', +'Compress::Raw::Zlib' => '2.069', +'Net::LDAP::Bind' => '1.05', +'Net::LDAP::Extension' => '1.04', +'Net::LDAP::RootDSE' => '0.02', +'Net::LDAP::Search' => '0.14', +'Convert::ASN1::Debug' => '0.27', +'Convert::ASN1' => '0.27', +'Net::LDAP::Constant' => '0.23', +'Net::LDAP::ASN' => '0.12', +'Net::LDAP::Message' => '1.12', +'Net::LDAP::Filter' => '0.20', +'XML::SAX::Base' => '1.07', +'Net::LDAP::Schema' => '0.9908', +'Net::LDAP::Entry' => '0.27', +'Net::LDAP::Control' => '0.18', +'Net::LDAP::Util' => '0.19', +'Net::LDAP::Intermediate' => '0.04', +'Crypt::SSLeay::MainContext' => 'undef', +'Crypt::SSLeay' => '0.73_04', +'Test::Builder::IO::Scalar' => '2.113', +'UNIVERSAL::can' => '1.20140328', +'UNIVERSAL::isa' => '1.20150614', +'Test::Builder' => '1.001014', +'Test::Builder::Module' => '1.001014', +'Unicode::CharName' => '1.07', +'XML::SAX::Exception' => '1.07', +'CGI::Carp' => '4.26', +'Data::Uniqid' => '0.12', +'Digest::HMAC_SHA1' => '1.03', +'File::Copy::Recursive' => '0.38', +'IO::Tee' => '0.64', +'JSON::WebToken' => '0.10', +'JSON::WebToken::Crypt::RSA' => 'undef', +'Mail::IMAPClient' => '3.38', +'Readonly' => '2.00', +'Sys::MemInfo' => '0.98', +'Term::ReadKey' => '2.33', +'Test::MockObject' => '1.20150527', +'Test::More' => '1.001014', +'Unicode::String' => '2.09', +'CGI' => '4.26', +'Crypt::OpenSSL::RSA' => '0.28', +'LWP::Authen::Digest' => 'undef', +'LWP::Authen::Ntlm' => '6.15', +'LWP::Protocol::GHTTP' => 'undef', +'LWP::Protocol::cpan' => 'undef', +'LWP::Protocol::data' => 'undef', +'LWP::Protocol::file' => 'undef', +'LWP::Protocol::ftp' => 'undef', +'LWP::Protocol::gopher' => 'undef', +'LWP::Protocol::https' => '6.06', +'LWP::Protocol::ldapi' => 'undef', +'LWP::Protocol::ldaps' => 'undef', +'LWP::Protocol::loopback' => 'undef', +'LWP::Protocol::mailto' => 'undef', +'LWP::Protocol::nntp' => 'undef', +'LWP::UserAgent' => '6.15', +'LWP::Authen::Basic' => 'undef', +'URI::URL' => '5.04', +'URI::http' => '1.71', +'HTML::Entities' => '3.69', +'URI::Escape' => '3.31', +'LWP::Protocol::http' => 'undef', +'IO::Socket::SSL' => '2.047', +'JSON' => '2.90', +'JSON::XS::Boolean' => 'undef', +'JSON::XS' => '3.01', +'LWP::Protocol::ldap' => '1.25', +'LWP::Protocol::nogo' => 'undef', +'IO::Socket::INET6' => '2.72', diff --git a/W/t/loadavg.out b/W/t/loadavg.out new file mode 100644 index 0000000..c387b24 --- /dev/null +++ b/W/t/loadavg.out @@ -0,0 +1 @@ +0.39 0.30 0.37 1/602 6073 diff --git a/W/test3.bat b/W/test3.bat index fad65c6..a4be2fa 100644 --- a/W/test3.bat +++ b/W/test3.bat @@ -1,12 +1,26 @@ -@REM $Id: test3.bat,v 1.24 2016/08/05 14:22:42 gilles Exp gilles $ +@REM $Id: test3.bat,v 1.26 2017/07/08 00:11:24 gilles Exp gilles $ cd /D %~dp0 @REM \$1 must be $1 on Windows -@REM ==== password within double-quotes -perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^ - --debugimap2 --debugcontent --folder INBOX --maxage 1 + +@ECHO ==== --justloadavg --justbanner + +@REM perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --justbanner + +@REM perl -V +@REM perl -e "print 'zzz'" +@REM perl -c .\imapsync +@REM perl .\imapsync --version +@REM --testsdebug --debugdev + +@REM perl .\imapsync --host1 imap.gmail.com --host2 ks2ipv6.lamiral.info --ssl1 --ssl2 --justconnect --debugimap +@REM perl .\imapsync --host1 test.lamiral.info --host2 ks2ipv6.lamiral.info --nossl1 --justconnect --debugimap +perl .\imapsync --host1 test.lamiral.info --user1 test1 --password1 secret1 --host2 p --user2 titi --passfile2 secret.titi --nossl1 --justlogin --debugimap + + + @EXIT diff --git a/W/test3_boxon.bat b/W/test3_boxon.bat index 07dc2d1..d3251b2 100644 --- a/W/test3_boxon.bat +++ b/W/test3_boxon.bat @@ -60,7 +60,7 @@ perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 --prefix1 "" ^ --sep2 "\\" --prefix2 "" --regextrans2 "s,^Inbox\\(.*),$1,i" --justfolders --dry --debug --folder INBOX.yop.yap.yip -@REM ==== split lon lines +@ECHO ==== split long lines perl ./imapsync ^ --host1 p --user1 tata ^ --passfile1 secret.tata ^ @@ -68,6 +68,19 @@ perl ./imapsync ^ --passfile2 secret.titi ^ --nofoldersizes --folder "INBOX.longline" --regexmess "s,(.{9900}),$1\r\n,g" --dry --debugcontent +@ECHO ==== password within double-quotes via --passfile1 +perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^ + --debugimap2 --debugcontent --folder INBOX --maxage 1 + +@ECHO ==== \Seen set in case unset +perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 tata --passfile2 secret.tata ^ + --nofoldersizes --no-modulesversion --folder INBOX.flagsetSeen --debugflags --dry --regexflag "s,^((?!\\Seen)).*$,$1 \\Seen," + +@ECHO ==== password double-quotes within via --password1 +@REM perl ./imapsync --host1 p --user1 tata --password1 \"ami\\\"seen\" --host2 p --user2 titi --passfile2 secret.titi --debugimap1 --showpasswords --justlogin +perl ./imapsync --host1 p --user1 tata --password1 ami\\\"seen --host2 p --user2 titi --passfile2 secret.titi --debugimap1 --showpasswords --justlogin + + @REM diff --git a/W/test3_gmail.bat b/W/test3_gmail.bat index b55eb8a..bfb4a85 100644 --- a/W/test3_gmail.bat +++ b/W/test3_gmail.bat @@ -1,5 +1,5 @@ -@REM $Id: test3_gmail.bat,v 1.4 2016/08/19 14:11:00 gilles Exp gilles $ +@REM $Id: test3_gmail.bat,v 1.5 2016/08/19 18:27:13 gilles Exp gilles $ cd /D %~dp0 @@ -13,4 +13,4 @@ cd /D %~dp0 perl .\imapsync --host1 imap.gmail.com --ssl1 --user1 gilles.lamiral@gmail.com --passfile1 secret.gilles_gmail ^ --host2 p --user2 tata --passfile2 secret.tata ^ - --regextrans2 "s,\[Gmail\].,," --dry --justfolders + --regextrans2 "s,\[Gmail\].,," --dry --justfolders diff --git a/W/test_cook_exe.bat b/W/test_cook_exe.bat index 8d4e6fd..3a62e76 100644 --- a/W/test_cook_exe.bat +++ b/W/test_cook_exe.bat @@ -1,11 +1,16 @@ -REM $Id: test_cook_exe.bat,v 1.1 2015/04/02 23:38:23 gilles Exp gilles $ +REM $Id: test_cook_exe.bat,v 1.4 2017/09/07 00:59:35 gilles Exp gilles $ cd /D %~dp0 -@REM EXIT - .\imapsync.exe +@PAUSE .\imapsync.exe --tests -.\imapsync.exe --testslive +@PAUSE +.\imapsync.exe --testslive --nossl2 +@PAUSE +.\imapsync.exe --testslive6 --nossl2 +@ECHO The previous test fails with "Invalid argument" usually (August 2017) +@ECHO Tests ended, bye. +@PAUSE -@PAUSE \ No newline at end of file +@REM EXIT diff --git a/W/test_cook_src.bat b/W/test_cook_src.bat index a493ac6..1770cd0 100644 --- a/W/test_cook_src.bat +++ b/W/test_cook_src.bat @@ -1,11 +1,15 @@ -REM $Id: test_cook_src.bat,v 1.1 2015/04/02 23:38:16 gilles Exp gilles $ +REM $Id: test_cook_src.bat,v 1.3 2017/09/07 00:59:26 gilles Exp gilles $ cd /D %~dp0 -@REM EXIT + perl .\imapsync +@PAUSE perl .\imapsync --tests +@PAUSE perl .\imapsync --testslive - +@PAUSE +perl .\imapsync --testslive6 +@ECHO Tests for imapsync script are finished, bye! @PAUSE \ No newline at end of file diff --git a/W/test_exe.bat b/W/test_exe.bat index 0ce95af..dc8a1a1 100644 --- a/W/test_exe.bat +++ b/W/test_exe.bat @@ -1,4 +1,4 @@ -REM $Id: test_exe.bat,v 1.15 2016/08/19 14:09:56 gilles Exp gilles $ +REM $Id: test_exe.bat,v 1.19 2017/08/31 01:57:33 gilles Exp gilles $ @SETLOCAL @ECHO OFF @@ -6,12 +6,14 @@ ECHO Currently running through %0 %* cd /D %~dp0 -REM Remove the error file because its existence means an error occured during this script execution +@REM Remove the error file because its existence means an error occured during this script execution IF EXIST LOG_bat\%~nx0.txt DEL LOG_bat\%~nx0.txt -REM CALL :handle_error .\imapsync.exe --thisoptionnoexists -CALL :handle_error perl imapsync --tests +@REM CALL :handle_error .\imapsync.exe --thisoptionnoexists +@REM CALL :handle_error perl imapsync --tests CALL :handle_error .\imapsync.exe --tests -CALL :handle_error .\imapsync.exe --testslive +CALL :handle_error .\imapsync.exe --testslive --nossl2 +@REM CALL :handle_error .\imapsync.exe --testslive6 --nossl2 + EXIT /B @ECHO ==== All 8 combinaisons between ssl1/tls1 ssl2/tls2 justconnect/justlogin diff --git a/W/test_exe_tests.bat b/W/test_exe_tests.bat new file mode 100644 index 0000000..c00df89 --- /dev/null +++ b/W/test_exe_tests.bat @@ -0,0 +1,36 @@ +@REM $Id: test_exe_tests.bat,v 1.2 2017/05/02 08:43:02 gilles Exp gilles $ + +@SETLOCAL +@ECHO OFF + +ECHO Currently running through %0 %* + +CD /D %~dp0 + +REM Remove the error file because its existence means an error occured during this script execution +IF EXIST LOG_bat\%~nx0.txt DEL LOG_bat\%~nx0.txt + +REM CALL :handle_error .\imapsync.exe --testsunit tests_always_fail +CALL :handle_error .\imapsync.exe --tests + +@REM @PAUSE +@ENDLOCAL +@EXIT /B + + +:handle_error +SETLOCAL +ECHO IN %0 with parameters %* +%* +SET CMD_RETURN=%ERRORLEVEL% + +IF %CMD_RETURN% EQU 0 ( + ECHO GOOD END +) ELSE ( + ECHO BAD END + IF NOT EXIST LOG_bat MKDIR LOG_bat + ECHO Failure running %* >> LOG_bat\%~nx0.txt +) +ENDLOCAL +EXIT /B + diff --git a/W/test_reg.bat b/W/test_reg.bat index c0e0754..75c6d39 100644 --- a/W/test_reg.bat +++ b/W/test_reg.bat @@ -1,14 +1,22 @@ -REM $Id: test_reg.bat,v 1.3 2015/05/11 01:08:05 gilles Exp gilles $ +REM $Id: test_reg.bat,v 1.4 2016/09/28 03:41:38 gilles Exp gilles $ cd /D %~dp0 -perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^ - --justfolders --dry --nofoldersizes ^ - --regextrans2 "s/\./_/g" + perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^ + --justfolders --folder INBOX --dry ^ + --regextrans2 "s,(/|^) +,$1,g" ^ + --regextrans2 "s, +(/|$),$1,g" ^ + --regextrans2 "s/[\^]/_/g" ^ + --regextrans2 "s/['\\]/_/g" ^ + --regextrans2 "s,^&AC8-,-,g" ^ + --regextrans2 "s,^&APg-,oe,g" + + + +@REM --regextrans2 "s/\./_/g" @REM --regextrans2 "s,${h2_prefix}(.*),${h2_prefix}old_mail${h2_sep}$1," ^ @REM --regextrans2 "s,^INBOX$,${h2_prefix}old_mail${h2_sep}INBOX," - @REM --regextrans2 "s,(.*),old_mail/$1," diff --git a/W/test_testsdebug.bat b/W/test_testsdebug.bat index c3efdeb..b90b591 100644 --- a/W/test_testsdebug.bat +++ b/W/test_testsdebug.bat @@ -1,4 +1,4 @@ -@REM $Id: test_testsdebug.bat,v 1.1 2016/08/19 08:20:53 gilles Exp gilles $ +@REM $Id: test_testsdebug.bat,v 1.3 2017/07/08 00:02:13 gilles Exp gilles $ @SETLOCAL @ECHO OFF @@ -11,7 +11,7 @@ REM Remove the error file because its existence means an error occured during th IF EXIST LOG_bat\%~nx0.txt DEL LOG_bat\%~nx0.txt @REM CALL :handle_error perl .\imapsync --justbanner -CALL :handle_error perl .\imapsync --testsdebug +CALL :handle_error perl .\imapsync --testsdebug --debug @REM CALL :handle_error perl .\imapsync --tests @REM @PAUSE diff --git a/W/tools/IMAPSyncInputs.bat b/W/tools/IMAPSyncInputs.bat new file mode 100755 index 0000000..914a093 --- /dev/null +++ b/W/tools/IMAPSyncInputs.bat @@ -0,0 +1,183 @@ +@echo off + +@REM Written by Liam Patrick +@REM imapsync example batch for Windows users +@REM lines beginning with @REM are just comments + +@REM Double quotes are necessary if a value contain one or more blanks. + +@REM value for --host1 is the IMAP source server hostname or IP address +@REM value for --user1 is the IMAP source user login +@REM value for --password1 is the IMAP source user password + +@REM value for --host2 is the IMAP destination server hostname or IP address +@REM value for --user2 is the IMAP destination user login +@REM value for --password2 is the IMAP destination user password + +@REM Character ^ at the end of the first line is essential and means +@REM "this command continues on the next line". You can add other lines +@REM but don't forget ^ character lasting each line, except the last one. + + +@REM ------------------------------------------------------------------------------------ + +:start +echo. +echo This will run IMAPSync letting you Migrate mail to another account on +echo another server. +echo. +echo The information to be entered is as follows. +echo. +echo -Host1 -User1 -Password1 -require ssl for 1? +echo -Host2 -User2 -Password2 -require ssl for 2? +echo. +pause + +:vari1 +cls +echo --------------------------------------------- +echo. +SET /P ANSWER= enter host1? +echo. + +SET HOST1=%ANSWER% + +SET /P ANSWER= enter user1? +echo. + +SET USER1=%ANSWER% + +SET /P ANSWER= enter password1? +echo. + +SET PASS1=%ANSWER% + + +:ssl1 +SET /P ANSWER= enable ssl1? (y/n) +echo. +if /i {%ANSWER%}=={y} (goto :ssl11) +if /i {%ANSWER%}=={n} (goto :ssl12) +(goto :ssl1) + + +:ssl11 +SET SSL1=-ssl1 +echo ssl Enabled +echo. +(goto :ask1) + + +:ssl12 +SET SSL1= +echo ssl Disabled +echo. +(goto :ask1) + + +:ask1 +cls +SET /P ANSWER= Check " %HOST1% %USER1% %PASS1% %SSL1% " Correct details? (y/n) + +if /i {%ANSWER%}=={y} (goto :vari2) +if /i {%ANSWER%}=={n} (goto :vari1) +(goto :ask1) + +@REM -------------------------------------------------------------------------------------- + +:vari2 +cls +echo --------------------------------------------- +echo. +SET /P ANSWER= enter host2? +echo. + +SET HOST2=%ANSWER% + +SET /P ANSWER= enter user2? +echo. + +SET USER2=%ANSWER% + +SET /P ANSWER= enter password2? +echo. + +SET PASS2=%ANSWER% + + +:ssl2 +SET /P ANSWER= enable ssl2? (y/n) +echo. +if /i {%ANSWER%}=={y} (goto :ssl21) +if /i {%ANSWER%}=={n} (goto :ssl22) +(goto :ssl2) + + +:ssl21 +SET SSL2=-ssl2 +echo ssl Enabled +echo. +(goto :ask2) + + +:ssl22 +SET SSL2= +echo ssl Disabled +echo. +(goto :ask2) + + +:ask2 +cls +SET /P ANSWER= Check " -%HOST2% -%USER2% -%PASS2% %SSL2% " Correct details? (y/n) + +if /i {%ANSWER%}=={y} (goto :run) +if /i {%ANSWER%}=={n} (goto :vari2) +(goto :ask2) + +@REM ------------------------------------------------------------------------------------ + +:run +cls +echo --------------------------------------------------------------------------- +echo. +echo Now that all the data has been entered we will run IMAPSync +echo. +echo This is the final step. Please read the information carefully +echo to avoid issues with migration. +echo. +echo If any of the details are incorrect please exit and re-enter your +echo details to run correctly +echo. +echo the following is what will be saved to a file which can later be run or edited +echo. +echo .\imapsync.exe --host1 %HOST1% --user1 %USER1% --password1 "%PASS1%" +echo --host2 %HOST2% --user2 %USER2% --password2 "%PASS2%" %SSL1% %SSL2% +echo. +echo To exit without running, please enter n. to Save settings to a file, please enter s +echo. +SET /P ANSWER= (n/s) + +if /i {%ANSWER%}=={n} (goto :end) +if /i {%ANSWER%}=={s} (goto :savefinal) +(goto :run) + +:runfinal +.\imapsync.exe --host1 %HOST1% --user1 %USER1% --password1 "%PASS1%" ^ + --host2 %HOST2% --user2 %USER2% --password2 "%PASS2%" %SSL1% %SSL2% --regextrans2 "s/\\/./g" --maxsize 250000000 --maxlinelength 9900 +(goto :end) + +:savefinal + +@echo .\imapsync.exe --host1 %HOST1% --user1 %USER1% --password1 "%PASS1%" ^ +--host2 %HOST2% --user2 %USER2% --password2 "%PASS2%" %SSL1% %SSL2% --regextrans2 "s/\\/./g" --maxsize 250000000 --maxlinelength 9900 > ".\%USER1%.bat" +echo. +echo File Saved in .\%USER1%.bat +echo. +(goto :end) + +:end + +echo. +@PAUSE + diff --git a/W/tools/backup_old_dist b/W/tools/backup_old_dist new file mode 100755 index 0000000..4ee001c --- /dev/null +++ b/W/tools/backup_old_dist @@ -0,0 +1,32 @@ +#!/bin/sh + +# $Id: backup_old_dist,v 1.3 2017/09/11 03:04:20 gilles Exp gilles $ + +# Bye on any error not handled +set -e + +! test -f dist/imapsync && return + +version_previous=`dist/imapsync --version || echo ERROR` +echo "previous: [$version_previous]" + +test "ERROR" != "$version_previous" || return 1 + +version_current=`cat VERSION || echo ERROR` + +test "ERROR" != "$version_current" || return 1 + +echo "current: [$version_current]" + +# nothing to backup +test "$version_previous" = "$version_current" && return 0 + +test -d dist/old_releases/$version_previous || mkdir dist/old_releases/$version_previous && ( cd dist/old_releases/$version_previous ) + +pwd +# all or nothing +ls -ld dist/imapsync dist/imapsync-$version_previous.tgz dist/imapsync_$version_previous.zip || return 1 +# let's do it +mv -vf dist/imapsync dist/imapsync_bin_Darwin dist/imapsync-$version_previous.tgz dist/imapsync_$version_previous.zip dist/old_releases/$version_previous + + diff --git a/W/tools/fix_email_for_exchange.py b/W/tools/fix_email_for_exchange.py new file mode 100755 index 0000000..eeeb8e8 --- /dev/null +++ b/W/tools/fix_email_for_exchange.py @@ -0,0 +1,275 @@ +#!/usr/bin/python +# +# $Cambridge: hermes/src/2exchange/scripts/fix_email_for_exchange.py,v 1.20 2017/01/25 18:33:48 dpc22 Exp $ +# +# Convert message into form that Exchange Online will accept. +# +# This is a combination of lossless conversions (for example recoding text +# attachments with long lines) and more aggresive conversions which remove +# headers and attachments which Exchange Online cannot accept because of +# hard limits listed on: +# +# https://technet.microsoft.com/en-GB/library/exchange-online-limits.aspx + +MAX_MSG_SIZE = 35*1024*1024 +MAX_LINE_LENGTH = 996 +MAX_ATTACHMENTS = 250 # Across the entire message +MAX_SUBPARTS = 250 # In single multipart. +MAX_FILENAME = 255 # for attachments +MAX_DEPTH = 30 # Nested multipart +NUKE_8BIT = True +NUKE_HDRS = [ + # (hdr, max_lines, max_items, max_bytes). (-1 => unlimited). + ("References", 485, 485, 40000), + ("Subject", -1, -1, 255), +] +FORCE_REWRITE = False + +import sys +import binascii +from email.parser import Parser +from email.generator import Generator +from email import utils +from cStringIO import StringIO + +# NB: utils._qencode() replaces ALL ' ' with '=20', as required by QP +# header strings. We only need to encode trailing whitespace in message +# body. quopri.encodestring (used by utils._qencode()) does this already. +from quopri import encodestring as qp_encode + +fp = open(sys.argv[1], "rb") if len(sys.argv) > 1 else sys.stdin +msg_text_crnl = fp.read(); fp.close() +msg_text_nl = msg_text_crnl.replace("\r\n", "\n") + +# We want to preserve CRLF and any leading "From" from source message +CRLF = "\r\n" if (len(msg_text_nl) < len(msg_text_crnl)) else "\n" +UNIXFROM = msg_text_nl.startswith("From ") + +def max_line_len(str): + return(max([len(i) for i in str.split('\n')])) + +def count_attachments(part): + if part.is_multipart(): + count = 0 # multipart wrapper doesn't count as attachment itself? + for subpart in part.get_payload(): + count += count_attachments(subpart) + else: + count = 1 + + return count + +def find_depth(part): + max_depth = 0 + if part.is_multipart(): + for subpart in part.get_payload(): + depth = find_depth(subpart) + if depth > max_depth: + max_depth = depth + + return max_depth + 1 + +# Replace complex bodypart with simple text/plain explanation +def nuke_part(part, print_stderr, text): + for hdr in ['Content-Transfer-Encoding', 'Content-Disposition']: + if part.has_key(hdr): + del part[hdr] + + if part.has_key('Content-Type'): + part.replace_header('Content-Type', 'text/plain') + + part.add_header('X-Mime-Autoconverted', text) + part.set_payload(text) + if print_stderr: + sys.stderr.write("FIXUP NEXT: " + text + "\n") + +def rewrite(part, drop_all_multipart_err): + need_rewrite = False + + if (part.preamble and max_line_len(part.preamble) > MAX_LINE_LENGTH): + part.preamble = "\n" + sys.stderr.write("FIXUP NEXT: Removed over-long MIME preamble\n") + need_rewrite = True + + if (part.epilogue and max_line_len(part.epilogue) > MAX_LINE_LENGTH): + part.epilogue = "\n" + sys.stderr.write("FIXUP NEXT: Removed over-long MIME epilogue\n") + need_rewrite = True + + for hdr in part.values(): + if max_line_len(hdr) > MAX_LINE_LENGTH: + need_rewrite = True # Force MIME rewrite if we have long headers + sys.stderr.write("FIXUP NEXT: Rewrite forced by long header line\n") + + for hdr, max_lines, max_items, max_bytes in NUKE_HDRS: + (hdr, val) = (hdr.lower(), part.get(hdr)) + if (val and ((max_lines >= 0 and len(val.split('\n')) > max_lines) or + (max_items >= 0 and len(val.split()) > max_items) or + (max_bytes >= 0 and len(val) > max_bytes))): + del part[hdr] + sys.stderr.write("FIXUP NEXT: Removed long header line: "+hdr+"\n") + need_rewrite = True + + # Exchange Online can't cope with very long component in address list + for hdr in ['To', 'Cc', 'Bcc']: + val = part.get(hdr, "") + for addr in val.split(','): # Need better parsing here! + if len(addr) > 1950: + part['X-Broken-' + hdr] = val + del part[hdr] + sys.stderr.write("FIXUP NEXT: Renamed broken " + hdr + + " to X-Broken-" + hdr + "\n") + need_rewrite = True + + ct = part.get_content_type() + max_name_len = 0 + params = part.get_params() + if params: + for (key,value) in part.get_params(): + if key in ['name', 'filename']: + if len(value) > max_name_len: + max_name_len = len(value) + + if max_name_len > MAX_FILENAME: + need_rewrite = True + part_count=len(part.get_payload()) + part_str = ('Removed ' + ct + + ' with long filename (' + str(max_name_len) + + ' characters) which chokes Exchange Online') + nuke_part(part, 1, part_str) + return need_rewrite + + if part.is_multipart(): + if (drop_all_multipart_err): + need_rewrite = True + part_count=len(part.get_payload()) + part_str = drop_all_multipart_err + nuke_part(part, 0, part_str) + elif (len(part.get_payload()) > MAX_SUBPARTS): + need_rewrite = True + part_count=len(part.get_payload()) + part_str = ('Removed ' + ct + + ' with ' + str(part_count) + + ' subparts/attachments which chokes Exchange Online') + nuke_part(part, 1, part_str) + elif ct in ['multipart/appledouble']: + need_rewrite = True + part_str = ('Removed ' + ct + + ' which chokes Exchange Online') + nuke_part(part, 1, part_str) + else: + for subpart in part.get_payload(): + if rewrite(subpart, drop_all_multipart_err): + need_rewrite = True + return need_rewrite + + payload = part.get_payload() + max_line_length = max_line_len(payload) + + cte = part.get('content-transfer-encoding', '').lower().strip() + if cte in ['8bit', '7bit', 'binary', '']: + # Encode unencoded forms which contain 8bit characters or long lines + update_cte = part.replace_header if (cte != '') else part.add_header + nonascii_count = [(ord(c) >= 128) for c in payload].count(True) + if ((NUKE_8BIT and nonascii_count > 0) or + max_line_length > MAX_LINE_LENGTH): + if nonascii_count < 100: + part.set_payload(qp_encode(payload)) + update_cte('Content-Transfer-Encoding', "quoted-printable") + else: + part.set_payload(utils._bencode(payload)) + update_cte('Content-Transfer-Encoding', "base64") + need_rewrite = True + elif (cte in ['quoted-printable', 'base64']): + decode_error = False + try: + if cte == 'quoted-printable': + raw=utils._qdecode(payload) + else: + raw=utils._bdecode(payload) + + if (len(payload) > 100) and (len(raw) < len(payload)/10): + raise binascii.Error + except binascii.Error: + decode_error = True + + if decode_error: + # Discard broken attachment which would no decode + need_rewrite = True + part_str = ('Removed ' + ct + + ' with broken attachment which failed to decode') + nuke_part(part, 1, part_str) + elif max_line_length > MAX_LINE_LENGTH: + sys.stderr.write("FIXUP NEXT: Recoded " + + (cte or "none") + " attachment [Long lines]\n") + + # Recode quoted-printable or base64 with long lines + need_rewrite = True + if cte == 'quoted-printable': + part.set_payload(qp_encode(raw)) + else: + part.set_payload(utils._bencode(raw)) + + newcte = part.get('content-transfer-encoding', '').lower().strip() + if (newcte and (newcte != cte)): + part.add_header('X-Mime-Autoconverted', + "from " + (cte or "none") + " to " + newcte) + if max_line_length > MAX_LINE_LENGTH: + sys.stderr.write("FIXUP NEXT: Attachment converted " + + "from " + (cte or "none") + " to " + newcte + + " [Long lines]\n") + else: + sys.stderr.write("FIXUP NEXT: Attachment converted " + + "from " + (cte or "none") + " to " + newcte + + " [Raw Binary data]\n") + + return need_rewrite + +msg=Parser().parsestr(msg_text_nl) + +msg_size = len(msg_text_nl) +msg_depth = find_depth(msg) +attachments_count = count_attachments(msg) + +if msg_size > MAX_MSG_SIZE: + err= ("message is too large for" + + " Exchange Online (" + str(msg_size / (1024*1024)) + " Mbytes)") + + need_rewrite=rewrite(msg, err) + if need_rewrite: + sys.stderr.write("FIXUP NEXT: " + err + "\n") +elif msg_depth > MAX_DEPTH: + err=("Removed multipart message with " + str(msg_depth) + + " nested messages which chokes Exchange Online") + + need_rewrite=rewrite(msg, err) + if need_rewrite: + sys.stderr.write("FIXUP NEXT: " + err + "\n") +elif attachments_count > MAX_SUBPARTS: + err=("Removed multipart message with " + str(attachments_count) + + " attachments which chokes Exchange Online") + + need_rewrite=rewrite(msg, err) + if need_rewrite: + sys.stderr.write("FIXUP NEXT: " + err + "\n") +else: + need_rewrite=rewrite(msg, '') + +if not need_rewrite and not FORCE_REWRITE: + sys.stdout.write(msg_text_crnl) + sys.exit(0) + +if need_rewrite: + # Log message headers if structure has changed + for hdr in ['Message-Id', 'From', 'Subject', 'Date']: + if msg.get(hdr): + sys.stderr.write(" " + hdr + ": " + msg.get(hdr) + "\n") + +buffer = StringIO() +gen=Generator(buffer, mangle_from_=False, maxheaderlen=MAX_LINE_LENGTH) +gen.flatten(msg, unixfrom=UNIXFROM) + +buffer.seek(0) +for line in buffer.readlines(): + sys.stdout.write(line.rstrip('\n')); sys.stdout.write(CRLF) +buffer.close() +sys.exit(0) diff --git a/W/tools/fixup_email.py b/W/tools/fixup_email.py deleted file mode 100755 index 25879aa..0000000 --- a/W/tools/fixup_email.py +++ /dev/null @@ -1,107 +0,0 @@ -#!/usr/bin/python - -NUKE_HDRS = [ - # (hdr, max_lines, max_items, max_bytes). (-1 => unlimited). - ("References", 485, 485, 40000), -] -MAX_LINE_LENGTH = 996 -NUKE_8BIT = True -FORCE_REWRITE = False - -import sys -from email.parser import Parser -from email.generator import Generator -from email import utils -from cStringIO import StringIO - -# NB: utils._qencode() replaces ALL ' ' with '=20', as required by QP -# header strings. We only need to encode trailing whitespace in message -# body. quopri.encodestring (used by utils._qencode()) does this already. -from quopri import encodestring as qp_encode - -fp = open(sys.argv[1], "rb") if len(sys.argv) > 1 else sys.stdin -msg_text_crnl = fp.read(); fp.close() -msg_text_nl = msg_text_crnl.replace("\r\n", "\n") - -# We want to preserve CRLF and any leading "From" from source message -CRLF = "\r\n" if (len(msg_text_nl) < len(msg_text_crnl)) else "\n" -UNIXFROM = msg_text_nl.startswith("From ") - -def rewrite(part): - need_rewrite = False - - for hdr in part.values(): - if max([len(i) for i in hdr.split('\n')]) > MAX_LINE_LENGTH: - need_rewrite = True # Force MIME rewrite if we have long headers - sys.stderr.write("FIXUP NEXT: Rewrite forced by long header line\n") - - for hdr, max_lines, max_items, max_bytes in NUKE_HDRS: - (hdr, val) = (hdr.lower(), msg.get(hdr)) - if (val and ((max_lines >= 0 and len(val.split('\n')) > max_lines) or - (max_items >= 0 and len(val.split()) > max_items) or - (max_bytes >= 0 and len(val) > max_bytes))): - del msg[hdr] - sys.stderr.write("FIXUP NEXT: Removed long header line: "+hdr+"\n") - need_rewrite = True - - if part.is_multipart(): - for subpart in part.get_payload(): - if rewrite(subpart): - need_rewrite = True - return need_rewrite - - payload = part.get_payload() - max_line_length = max([ len(i) for i in payload.split('\n') ]) - - cte = part.get('content-transfer-encoding', '').lower().strip() - if cte in ['8bit', '7bit', 'binary', '']: - # Encode unencoded forms which contain 8bit characters or long lines - update_cte = part.replace_header if (cte != '') else part.add_header - nonascii_count = [(ord(c) >= 128) for c in payload].count(True) - if ((NUKE_8BIT and nonascii_count > 0) or - max_line_length > MAX_LINE_LENGTH): - if nonascii_count < 100: - part.set_payload(qp_encode(payload)) - update_cte('Content-Transfer-Encoding', "quoted-printable") - else: - part.set_payload(utils._bencode(payload)) - update_cte('Content-Transfer-Encoding', "base64") - need_rewrite = True - elif cte in ['quoted-printable', 'base64']: - # Recode quoted-printable or base64 with long lines - if max_line_length > MAX_LINE_LENGTH: - if cte == 'quoted-printable': - raw=utils._qdecode(payload) - part.set_payload(qp_encode(raw)) - need_rewrite = True - elif cte == 'base64': - try: - raw=utils._bdecode(payload) - part.set_payload(utils._bencode(raw)) - need_rewrite = True - except binascii.Error: - pass - - newcte = part.get('content-transfer-encoding', '').lower().strip() - if (newcte != cte): - part.add_header('X-Mime-Autoconverted', - "from " + (cte or "none") + " to " + newcte) - sys.stderr.write("FIXUP NEXT: Attachment converted " + - "from " + (cte or "none") + " to " + newcte + "\n") - return need_rewrite - -msg=Parser().parsestr(msg_text_nl) - -if not rewrite(msg) and not FORCE_REWRITE: - sys.stdout.write(msg_text_crnl) - sys.exit(0) - -buffer = StringIO() -gen=Generator(buffer, mangle_from_=False, maxheaderlen=MAX_LINE_LENGTH) -gen.flatten(msg, unixfrom=UNIXFROM) - -buffer.seek(0) -for line in buffer.readlines(): - sys.stdout.write(line.rstrip('\n')); sys.stdout.write(CRLF) -buffer.close() -sys.exit(0) diff --git a/W/tools/gen_README_dist b/W/tools/gen_README_dist index dc7953c..cdcfe89 100755 --- a/W/tools/gen_README_dist +++ b/W/tools/gen_README_dist @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: gen_README_dist,v 1.1 2014/05/29 23:33:19 gilles Exp gilles $ +# $Id: gen_README_dist,v 1.2 2017/09/11 02:19:34 gilles Exp gilles $ VERSION_UNX=`cat VERSION` #echo $VERSION_UNX @@ -9,11 +9,18 @@ VERSION_EXE=`cat VERSION_EXE` cat < +# +# This is a simplified version of the online WDG HTML Validator +# found at . +# +# Copyright (c) 1998-2010 by Liam Quinn +# This program is free software; you can redistribute it +# and/or modify it under the same terms as Perl itself. +# +# Contributors: +# * Ville Skytta +# * John Goebel +# +##################################################################### + +##################################################################### +# Required libraries # +###################### + +# These are all standard Perl modules; we'll check for URI and LWP +# later on demand. + +use strict; +use Getopt::Long qw(GetOptions); +use Text::Wrap qw(wrap); +use POSIX qw(:fcntl_h); + +# If File::Spec::Functions isn't available, let's fall back quietly +# to a replacement function. +eval { + require File::Spec::Functions; + File::Spec::Functions->import('catfile'); +}; +*catfile = sub { join('/', @_) } if $@; + +##################################################################### + +##################################################################### +# Variables to define # +####################### + +# Version and identifier of this program +my $VERSION = '1.2.3'; +my $progname = "Offline HTMLHelp.com Validator, Version $VERSION +by Liam Quinn "; +my $usage = "Usage: validate [OPTION] [FILE...]"; + +# SGML directory (catalog, DTDs, SGML declarations) +my $sgmlDir = '/usr/local/share/wdg/sgml-lib'; + +# Location of lq-nsgmls executable +my $nsgmlsLocation = '/usr/bin/nsgmls'; + +# lq-nsgmls command line +# The SGML declaration and HTML document's filename will be appended +# to this string +my $nsgmls = "$nsgmlsLocation -E0 -s"; + +# Warnings to pass on command-line to lq-nsgmls, if desired +my $nsgmlsWarnings = '-wnon-sgml-char-ref -wmin-tag'; +my $nsgmlsXMLWarnings = '-wxml'; + +# lq-nsgmls "errors" that are not reported unless warnings are requested. +# These are true errors in XML validation, but they should only be +# reported as warnings otherwise. +my %errorAsWarning = ( + ' net-enabling start-tag not supported in {{XML}}' => 1, + ' unclosed start-tag' => 1, + ' unclosed end-tag' => 1 +); + +# Catalog files for HTML/SGML and XHTML/XML +my $htmlCatalog = catfile($sgmlDir, 'catalog'); +my $xhtmlCatalog = catfile($sgmlDir, 'xhtml.soc'); + +# Where to direct errors (typically *STDOUT or *STDERR) +my $errout = *STDOUT; + +# Versions of HTML associated with a given FPI +my %HTMLversion = ( + 'PUBLIC "-//WAPFORUM//DTD XHTML Mobile 1.2//EN"' => 'XHTML-MP 1.2', + 'PUBLIC "-//WAPFORUM//DTD XHTML Mobile 1.1//EN"' => 'XHTML-MP 1.1', + 'PUBLIC "-//WAPFORUM//DTD XHTML Mobile 1.0//EN"' => 'XHTML-MP 1.0', + 'PUBLIC "-//W3C//DTD XHTML+RDFa 1.0//EN"' => 'XHTML+RDFa 1.0', + 'PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN"' => 'XHTML 1.1 plus MathML 2.0 plus SVG 1.1', + 'PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0//EN"' => 'XHTML 1.1 plus MathML 2.0', + 'PUBLIC "-//W3C//DTD MathML 2.0//EN"' => 'MathML 2.0', + 'PUBLIC "-//W3C//DTD XHTML 1.1//EN"' => 'XHTML 1.1', + 'PUBLIC "-//WAPFORUM//DTD WML 1.3//EN"' => 'WML 1.3', + 'PUBLIC "-//WAPFORUM//DTD WML 1.2//EN"' => 'WML 1.2', + 'PUBLIC "-//WAPFORUM//DTD WML 1.1//EN"' => 'WML 1.1', + 'PUBLIC "-//WAPFORUM//DTD WML 1.0//EN"' => 'WML 1.0', + 'PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"' => 'XHTML Basic', + 'PUBLIC "ISO/IEC 15445:2000//DTD HyperText Markup Language//EN"' => 'ISO/IEC 15445:2000', + 'PUBLIC "ISO/IEC 15445:2000//DTD HTML//EN"' => 'ISO/IEC 15445:2000', + 'PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"' => 'XHTML 1.0 Strict', + 'PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"' => 'XHTML 1.0 Transitional', + 'PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"' => 'XHTML 1.0 Frameset', + 'PUBLIC "-//W3C//DTD HTML 4.01//EN"' => 'HTML 4.01 Strict', + 'PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"' => 'HTML 4.01 Transitional', + 'PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN"' => 'HTML 4.01 Frameset', + 'PUBLIC "-//W3C//DTD HTML 4.0//EN"' => 'HTML 4.0 Strict', + 'PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"' => 'HTML 4.0 Transitional', + 'PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN"' => 'HTML 4.0 Frameset', + 'PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"' => 'HTML 3.2', + 'PUBLIC "-//W3C//DTD HTML 3.2 Draft//EN"' => 'HTML 3.2', + 'PUBLIC "-//W3C//DTD HTML 3.2//EN"' => 'HTML 3.2', + 'PUBLIC "-//W3C//DTD HTML Experimental 970421//EN"' => 'HTML 3.2 + Style', + 'PUBLIC "-//W3O//DTD W3 HTML 3.0//EN"' => 'HTML 3.0 Draft', + 'PUBLIC "-//IETF//DTD HTML 3.0//EN//"' => 'HTML 3.0 Draft', + 'PUBLIC "-//IETF//DTD HTML 3.0//EN"' => 'HTML 3.0 Draft', + 'PUBLIC "-//IETF//DTD HTML i18n//EN"' => 'HTML 2.0 + i18n', + 'PUBLIC "-//IETF//DTD HTML//EN"' => 'HTML 2.0', + 'PUBLIC "-//IETF//DTD HTML 2.0//EN"' => 'HTML 2.0', + 'PUBLIC "-//IETF//DTD HTML Level 2//EN"' => 'HTML 2.0', + 'PUBLIC "-//IETF//DTD HTML 2.0 Level 2//EN"' => 'HTML 2.0', + 'PUBLIC "-//IETF//DTD HTML Level 1//EN"' => 'HTML 2.0 Level 1', + 'PUBLIC "-//IETF//DTD HTML 2.0 Level 1//EN"' => 'HTML 2.0 Level 1', + 'PUBLIC "-//IETF//DTD HTML Strict//EN"' => 'HTML 2.0 Strict', + 'PUBLIC "-//IETF//DTD HTML 2.0 Strict//EN"' => 'HTML 2.0 Strict', + 'PUBLIC "-//IETF//DTD HTML Strict Level 2//EN"' => 'HTML 2.0 Strict', + 'PUBLIC "-//IETF//DTD HTML 2.0 Strict Level 2//EN"' => 'HTML 2.0 Strict', + 'PUBLIC "-//IETF//DTD HTML Strict Level 1//EN"' => 'HTML 2.0 Strict Level 1', + 'PUBLIC "-//IETF//DTD HTML 2.0 Strict Level 1//EN"' => 'HTML 2.0 Strict Level 1' +); + +# SGML declarations for a given level of HTML +my %sgmlDecl = ( + 'XHTML-MP 1.2' => catfile($sgmlDir, 'xhtml-basic10','xml1.dcl'), + 'XHTML-MP 1.1' => catfile($sgmlDir, 'xhtml-basic10','xml1.dcl'), + 'XHTML-MP 1.0' => catfile($sgmlDir, 'xhtml-basic10','xml1.dcl'), + 'XHTML+RDFa 1.0' => catfile($sgmlDir, 'xhtml11', 'xml1n.dcl'), + 'XHTML 1.1 plus MathML 2.0 plus SVG 1.1' => catfile($sgmlDir, 'xhtml11', 'xml1n.dcl'), + 'XHTML 1.1 plus MathML 2.0' => catfile($sgmlDir, 'xhtml11', 'xml1n.dcl'), + 'MathML 2.0' => catfile($sgmlDir, 'xhtml11', 'xml1n.dcl'), + 'XHTML 1.1' => catfile($sgmlDir, 'xhtml11', 'xml1n.dcl'), + 'WML 1.3' => catfile($sgmlDir, 'xhtml1', 'xhtml1.dcl'), + 'WML 1.2' => catfile($sgmlDir, 'xhtml1', 'xhtml1.dcl'), + 'WML 1.1' => catfile($sgmlDir, 'xhtml1', 'xhtml1.dcl'), + 'WML 1.0' => catfile($sgmlDir, 'xhtml1', 'xhtml1.dcl'), + 'XHTML Basic' => catfile($sgmlDir, 'xhtml-basic10','xml1.dcl'), + 'ISO/IEC 15445:2000' => catfile($sgmlDir, '15445.dcl'), + 'XHTML 1.0 Strict' => catfile($sgmlDir ,'xhtml1', 'xhtml1.dcl'), + 'XHTML 1.0 Transitional' => catfile($sgmlDir, 'xhtml1', 'xhtml1.dcl'), + 'XHTML 1.0 Frameset' => catfile($sgmlDir, 'xhtml1', 'xhtml1.dcl'), + 'HTML 4.01 Strict' => catfile($sgmlDir, 'HTML4.dcl'), + 'HTML 4.01 Transitional' => catfile($sgmlDir, 'HTML4.dcl'), + 'HTML 4.01 Frameset' => catfile($sgmlDir, 'HTML4.dcl'), + 'HTML 4.0 Strict' => catfile($sgmlDir, 'HTML4.dcl'), + 'HTML 4.0 Transitional' => catfile($sgmlDir, 'HTML4.dcl'), + 'HTML 4.0 Frameset' => catfile($sgmlDir, 'HTML4.dcl'), + 'HTML 3.2' => catfile($sgmlDir, 'HTML32.dcl'), + 'HTML 3.2 + Style' => catfile($sgmlDir, 'html-970421.decl'), + 'HTML 3.0 Draft' => catfile($sgmlDir, 'HTML3.dcl'), + 'HTML 2.0 + i18n' => catfile($sgmlDir, 'i18n.dcl'), + 'HTML 2.0' => catfile($sgmlDir, 'html.dcl'), + 'HTML 2.0 Strict' => catfile($sgmlDir, 'html.dcl'), + 'HTML 2.0 Level 1' => catfile($sgmlDir, 'html.dcl'), + 'HTML 2.0 Strict Level 1' => catfile($sgmlDir, 'html.dcl'), + 'Unknown' => catfile($sgmlDir, 'custom.dcl'), + + # For generic XML validation (using the --xml option) + 'XML' => catfile($sgmlDir, 'xhtml1', 'xhtml1.dcl'), +); + +# XHTML DTDs +my %xhtml = ( + 'XHTML-MP 1.2' => 1, + 'XHTML-MP 1.1' => 1, + 'XHTML-MP 1.0' => 1, + 'XHTML+RDFa 1.0' => 1, + 'XHTML 1.1 plus MathML 2.0 plus SVG 1.1' => 1, + 'XHTML 1.1 plus MathML 2.0' => 1, + 'MathML 2.0' => 1, + 'XHTML 1.1' => 1, + 'WML 1.3' => 1, + 'WML 1.2' => 1, + 'WML 1.1' => 1, + 'WML 1.0' => 1, + 'XHTML Basic' => 1, + 'XHTML 1.0 Strict' => 1, + 'XHTML 1.0 Transitional' => 1, + 'XHTML 1.0 Frameset' => 1, + 'XML' => 1, +); + +# Default DOCTYPE if the document is missing a DOCTYPE +my $defaultDoctype = ''; + +# Default DOCTYPE if the document contains frames +my $defaultFramesetDoctype = ''; + +# Error for missing DOCTYPE +my $noDoctype = "missing document type declaration; assuming HTML 4.01 Transitional"; + +# Error for missing DOCTYPE in a Frameset document +my $noFramesetDoctype = "missing document type declaration; assuming HTML 4.01 Frameset"; + +##################################################################### + +##################################################################### +# +# The rest of the script... +# +##################################################################### + +# Get rid of unsafe environment variables, see perlsec +delete(@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}); + +# Flush output buffer +$| = 1; + +### Get user input ### + +# Character encoding to use (optional) +my $charsetOverride; + +# Verbose output (optional) +my $verbose; + +# Emacs-friendly output +my $emacs = ($ENV{EMACS} && $ENV{EMACS} eq 't'); + +# XML mode +my $xml; + +# Whether warnings are desired +my $warnings; + +# HTTP headers to send +my @headers; + +# Help and version info +my $help; +my $versionInfo; + +GetOptions("xml" => \$xml, "charset=s" => \$charsetOverride, + "verbose" => \$verbose, "help|h" => \$help, + "version|v" => \$versionInfo, "emacs!" => \$emacs, + "warn|w|W" => \$warnings, "header=s" => \@headers); + +# Files to validate +my @files = @ARGV; + +###################### + +my $errors = 0; + +if ($versionInfo || $help) { + if ($versionInfo) { + print "$progname\n"; + } + if ($help) { + &helpText; + } + exit $errors; +} + +if ($#files == -1) { + push(@files, '-'); +} + +# Check that nsgmls is available before we get too far +unless (-e $nsgmlsLocation) { + &error("$nsgmlsLocation is not installed"); + exit $errors; +} +unless (-x _) { + &error("$nsgmlsLocation is not executable"); + exit $errors; +} + +# Check if we can use URIs. +eval { + require URI; + require LWP::UserAgent; +}; +my $uri_ok = !$@; + +my $ua; +my $file; +foreach $file (@files) { + + my $tempname = undef; + my $tempfh = undef; + my $charset = $charsetOverride; + + # Read in document + my $document = ""; + my $fileIsURL = 0; + if ($file ne '-') { + if ($uri_ok && $file =~ m|^\w+://.+|i) { + $fileIsURL = 1; + unless ($ua) { + $ua = LWP::UserAgent->new(env_proxy => 1, keep_alive => 1); + foreach (@headers) { + if (/^([^\s:]+)\s*:\s*(.*)/) { + if (lc($1) eq 'user-agent') { + $ua->agent($2); + } else { + $ua->default_header($1 => $2); + } + } + } + } + + my $uri = URI->new($file); + unless ($ua->is_protocol_supported($uri)) { + &error('Unsupported protocol: ' . $uri->scheme()); + next; + } + my $res = $ua->get($uri->canonical()); + if ($res->is_success()) { + $document = $res->content(); + + unless ($charset) { + my $contentType = $res->header('Content-Type'); + if ($contentType && $contentType =~ /[\s;]charset\s*=\s*"?([^,"\s]+)/io) { + $charset = $1; + } + } + } else { + &error($res->status_line()); + next; + } + + } else { + unless (-e $file) { + &error("File $file does not exist."); + next; + } + unless (-r _) { + &error("File $file is not readable."); + next; + } + + open(IN, $file) || die "Unexpected error reading $file: $!\n"; + while () { + $document .= $_; + } + close(IN); + } + } else { + while (<>) { + $document .= $_; + } + } + + unless ($charset) { + # Check for a META element specifying the character encoding + if ($document =~ m#]*http\-equiv\s*=\s*["']?Content\-Type["']?[^>]*)>#iso) { + my $metaAttributes = $1; + if ($metaAttributes =~ m#\scontent\s*=\s*["']?.*[\s;]charset\s*=\s*['"]?([^"']+)#iso) { + $charset = $1; + } + } + } + + my @errors; # queue of errors + my @externalErrors; # queue of errors in an external DTD + my $lineAdjust = 0; # account for line number changes if we add a DOCTYPE + + # Determine the level of HTML + my $htmlLevel; + my $fileToValidate = $file; + if ($xml) { + $htmlLevel = 'XML'; + } else { + $htmlLevel = 'Unknown'; + } + if ($document =~ /]*)>/iso) { + + my $doctypeMeat = $1; + if ($doctypeMeat =~ /PUBLIC\s+["']([^"']*)["']/iso) { + $htmlLevel = $HTMLversion{"PUBLIC \"$1\""} || $htmlLevel; + } + + if ($fileIsURL || $file eq '-') { + ($tempname, $tempfh) = getTempFile(); + print $tempfh "$document"; + close($tempfh); + + $fileToValidate = $tempname; + } + + } else { # Missing DOCTYPE + + # Add a default DOCTYPE + my ($insertedDoctype, $doctypeError); + if ($document =~ /&1 |") + || die("Unable to execute $nsgmls: $!\n"); + + # Create a queue of errors + while () { + chomp; + + my @error = split(/:/, $_, 6); + + if ($#error < 4) { + + next; + + } elsif ($error[4] eq 'E' || $error[4] eq 'X') { + + # With warnings enabled in non-XML validation, some "errors" + # reported by lq-nsgmls are probably better reported as "warnings" + # since they are only reported with warnings enabled. + if ($warnings && !$xml) { + if ($errorAsWarning{$error[5]}) { + $error[4] = 'W'; + + # lq-nsgmls uses an XML-specific message for one of + # these warnings. Let's try something more helpful + # for HTML. + if ($error[5] eq ' net-enabling start-tag not supported in {{XML}}') { + $error[5] = ' net-enabling start-tag; possibly missing required quotes around an attribute value or using XHTML syntax in HTML'; + } + + $_ = join(':', @error); + } + } + + push(@errors, $_); + + # If the DOCTYPE is bad, bail out + last if ($error[5] eq ' unrecognized {{DOCTYPE}}; unable to check document'); + + } elsif ($error[4] eq 'W') { + + unless ($error[5] eq ' characters in the document character set with numbers exceeding 65535 not supported') + { + push(@errors, $_); + } + + } elsif ($error[1] =~ /^/o) { # error from external DTD + + push(@externalErrors, $_); + + } elsif (length($error[4]) > 1 # Allow secondary messages about preceding error + && $error[3] ne 'W') # Prevent error about SGML declaration not implied with -wxml + { + push(@errors, $_); + } + + } + close(NSGMLS); + + # If we created a tempfile, unlink it + if (defined $tempname) { + unlink($tempname); + } + + # Report errors + if ($#errors > -1 || $#externalErrors > -1) { + + &startErrors($file); + + foreach (@externalErrors) { + my @error = split(/:/, $_, 7); + + # Determine URL containing the error + my $errorURL; + if ($error[1] =~ /(.+)/o) { + $errorURL = "$1:$error[2]"; + } + + my $lineNumber = $error[3]; + my $character = $error[4] + 1; + + my $errorMsg; + if ($emacs) { + $errorMsg = "$errorURL:$lineNumber:$character:"; + } else { + $errorMsg = "$errorURL, line $lineNumber, character $character: "; + } + + if ($error[6]) { + $errorMsg .= superChomp($error[6]); + } else { + $errorMsg .= superChomp($error[5]); + } + + &htmlError(stripLqNsgmlsGunk($errorMsg)); + } + + foreach (@errors) { + my @error = split(/:/, $_, 6); + + # I don't think this should happen, but I'm not sure + next if $#error < 4; + + # Determine line number and character of error + my $lineNumber = $error[2] - $lineAdjust; + next unless $lineNumber > 0; + my $character = $error[3] + 1; + + my $msgType; + if ($error[4] eq 'E' || $error[4] eq 'X') { # Error message + $msgType = $emacs ? 'E' : 'Error at'; + } elsif ($error[4] eq 'W') { + $msgType = $emacs ? 'W' : 'Warning at'; + } + + + # Prepare error message + my $errorMsg; + if ($emacs) { + $errorMsg = "$file:$lineNumber:$character:"; + if (defined $msgType) { + $errorMsg .= "$msgType:"; + } + } else { + my $line; + if (defined $msgType) { + $line = ' line'; + } else { + $line = 'Line'; + $msgType = "\t"; + } + $errorMsg = "$msgType$line $lineNumber, character $character: "; + } + + if ($error[5]) { + $errorMsg .= superChomp($error[5]); + } else { + $errorMsg .= superChomp($error[4]); + } + + &htmlError(stripLqNsgmlsGunk($errorMsg)); + } + + } else { + + if ($verbose) { + print "No errors!\n"; + } + } + +} + +exit $errors; + +# Return an error message +# The error message must be given as the first argument +sub error { + my $error_message = shift; + print $errout wrap("", "\t", "ERROR: \t$error_message\n"); + ++$errors; +} + +# Heading to start HTML errors +# The file being validated should be given as the first argument +sub startErrors { + my $file = shift; + if (length $file) { + my $andWarnings = $warnings ? ' and warnings' : ''; + + if ($file eq '-') { + print $errout "*** Errors$andWarnings: ***\n"; + } else { + if ($emacs) { + print $errout "*** Errors" . $andWarnings . " validating $file: ***\n"; + } else { + print $errout wrap("", "\t", + "*** Errors" . $andWarnings . " validating $file: ***\n"); + } + } + } +} + +sub quoteFilename { + my $filename = shift; + + $filename =~ s/\\/\\\\/go; + $filename =~ s/"/\\"/go; + + # Untaint + if ($filename =~ /^(.*)$/) { + $filename = $1; + } + + return "\"$filename\""; +} + +# Clean the "{{foo}}" used in lq-nsgmls error messages +# The error message must be given as the first argument +sub stripLqNsgmlsGunk { + my $errorMsg = shift; + while ($errorMsg =~ m#\{\{"?(.+?)"?\}\}#gos) { + my $linkText = $1; + $errorMsg =~ s#\{\{(")?$linkText(")?\}\}#$1$linkText$2#; + } + return $errorMsg; +} + +# Report an HTML error +# The error message must be given as the first argument +sub htmlError { + my $error_message = shift; + + if ($emacs) { + print $errout "$error_message\n"; + } else { + print $errout wrap("", "\t", "$error_message\n"); + } + + ++$errors; +} + + +# Remove any newline characters (\r or \n) at the end of a string +# First argument is the string +# Returns the new string +sub superChomp { + + my $str = shift || return; + $str =~ s/[\r\n]+$//o; + return $str; + +} + + +# Create temporary file securely +# Returns the name and file handle of the created file +sub getTempFile { + my $filename; + do { + $filename = POSIX::tmpnam(); + } until sysopen(FH, $filename, O_RDWR|O_CREAT|O_EXCL, 0666); + + return ($filename, \*FH); +} + + +sub helpText { + + print<<"EndOfHelp"; +"validate", the Offline HTMLHelp.com Validator, checks the syntax of HTML +documents using an SGML parser and reports any errors. XHTML documents +may also be validated using an XML parser. + +$usage + +The program's options are as follows: + -w, --warn include warnings + --xml indicate that the documents to be validated are + XML documents. Known document types, such as + HTML 4.01 and XHTML 1.0, are automatically + handled by "validate". For unknown document + types, "validate" will assume XHTML/XML if this + option is specified and HTML/SGML otherwise. + --header='Name: value' set an HTTP header for HTTP requests (may be + used multiple times for separate headers) + --charset=ENCODING force ENCODING to be used as the character + encoding when validating HTML/SGML documents. + This option is ignored when validating XHTML/XML + documents, which are assumed to use XML rules for + specifying the character encoding. The following + encodings (case-insensitive) are supported: + "utf-8", "iso-10646-ucs-2", "euc-jp", "euc-kr", + "gb2312", "shift_jis", "big5", and "iso-8859-n" + where n is between 1 and 9 inclusive. + --verbose turn on verbose output messages + --[no]emacs (don't) use an output format intended for parsing + by (X)Emacs, autodetected + -h, --help display this help and exit + -v, --version output version information and exit + +Any number of files may be specified after the options. With no FILE, +standard input is read. + +Files can also be URIs if you have the URI and libwww-perl packages +installed. Support for different URI schemes is also determined by these +packages. Proxy settings are loaded from environment variables for +each scheme--e.g., http_proxy=http://localhost:3128. + +"validate" is written by Liam Quinn and is based on the +WDG HTML Validator, an online validation service available at +. +EndOfHelp + +} diff --git a/W/tools/validate_files_in_dir.pl b/W/tools/validate_files_in_dir.pl new file mode 100755 index 0000000..475db5d --- /dev/null +++ b/W/tools/validate_files_in_dir.pl @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use WebService::Validator::HTML::W3C; + +=head1 DESCRIPTION + +This script takes a directory as an argument and then submits every file +in that directory to the W3C validator. It will print out a line for each +file stating if it is valid or otherwise. For the invalid files it will +also print out the errors returned by the validator. + +=cut + +my $v = WebService::Validator::HTML::W3C->new( + # you should probably install a local validator if you + # are indenting to run this against a lot of files and + # then uncomment this line and change the uri + # validator_uri => 'http://localhost/w3c-validator/check', + detailed => 1 +) or die "failed to init validator object"; + +my $dir = shift; + +for my $file ( glob( "$dir/*.html" ) ) { + if ( $v->validate_file( $file ) ) { + if ( $v->is_valid ) { + print "$file: valid\n"; + } else { + print "$file: invalid\n"; + for my $err ( @{ $v->errors } ) { + printf(" line: %s, col: %s\n error: %s\n\n", + $err->line, $err->col, $err->msg); + } + } + } else { + die "failed to validate $file: " . $v->validator_error . "\n"; + } + print "\n" . '-' x 60 . "\n"; + # sleep between files so as not to hammer the validator + sleep 1; +} diff --git a/W/tools/validate_html4 b/W/tools/validate_html4 new file mode 100755 index 0000000..58dcb99 --- /dev/null +++ b/W/tools/validate_html4 @@ -0,0 +1,47 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use WebService::Validator::HTML::W3C; + +=head1 DESCRIPTION + +This script takes files as arguments and then submits those file +to the W3C validator. It will print out a line for each +file stating if it is valid or otherwise. For the invalid files it will +also print out the errors returned by the validator. + +=cut + +my $v = WebService::Validator::HTML::W3C->new( + # you should probably install a local validator if you + # are indenting to run this against a lot of files and + # then uncomment this line and change the uri + # validator_uri => 'http://localhost/w3c-validator/check', + detailed => 1 +) or die "failed to init validator object"; + +my $invalid_found = 0 ; + +for my $file ( @ARGV ) { + if ( $v->validate_file( $file ) ) { + if ( $v->is_valid ) { + print "$file: valid\n"; + } else { + $invalid_found = 1 ; + print "$file: invalid\n"; + for my $err ( @{ $v->errors } ) { + printf(" line: %s, col: %s\n error: %s\n\n", + $err->line, $err->col, $err->msg); + } + } + } else { + die "failed to validate $file: " . $v->validator_error . "\n"; + } + print "\n" . '-' x 60 . "\n"; + # sleep between files so as not to hammer the validator + sleep 1; +} + +exit( $invalid_found ) ; + diff --git a/W/tools/validate_xml_html5 b/W/tools/validate_xml_html5 index 09caa69..15877d4 100755 --- a/W/tools/validate_xml_html5 +++ b/W/tools/validate_xml_html5 @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: validate_xml_html5,v 1.3 2016/08/05 19:34:46 gilles Exp gilles $ +# $Id: validate_xml_html5,v 1.4 2017/09/11 02:19:00 gilles Exp gilles $ #set -x @@ -13,8 +13,10 @@ validate_xml_html5_one() { return $? fi if expr match "$type" '.*application/xml.*' > /dev/null; then - echo validate --verbose "$1" - validate --verbose "$1" + #echo validate --verbose "$1" + #validate --verbose "$1" + echo xmllint --noout "$1" + xmllint --noout "$1" return $? fi echo Unknown type diff --git a/W/tools/watchdog.pl b/W/tools/watchdog.pl new file mode 100755 index 0000000..730d259 --- /dev/null +++ b/W/tools/watchdog.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl +# +# $Cambridge: hermes/src/2exchange/scripts/watchdog.pl,v 1.5 2017/02/10 09:57:11 dpc22 Exp $ +# +# Watchdog wrapper which runs shell script as subprocess collecting output +# in file. Kills child process if it doesn't generate output after $TIMEOUT + +my $TIMEOUT = (30*60); # 30 minutes + +use strict; +use warnings; + +(@ARGV == 2) or die "watchdog.pl args: cmdfile outfile\n"; + +my $cmdfile=$ARGV[0]; +my $outfile=$ARGV[1]; + +# Touch outfile to make sure timestamp up to date. Don't blat existing content. +open(my $fh, ">>", $outfile) or die "Failed to open $outfile: $!\n"; +close($fh); + +open($fh, "<", $cmdfile) or die "Failed to open $cmdfile: $!\n"; +my $cmd = <$fh>; +close($fh); +chomp($cmd); + +my $cmd_pid = fork(); +die "watchdog.pl Could not fork(): $_\n" if not defined $cmd_pid; + +if (not $cmd_pid) { + open (STDOUT, '>>', $outfile); + open (STDERR, '>&', STDOUT); + exec($cmd); + exit 1; +} + +my $watchdog_pid = fork(); +die "Could not fork(): $_\n" if not defined $watchdog_pid; +if (not $watchdog_pid) { + while (1) { + my $now = time; + my @stat = stat $outfile; + my $mtime = (@stat) ? $stat[9] : $now; + + last if (($now - $mtime) > ${TIMEOUT}); + sleep(1); + } + exit 1; +} + +###################################################################### +# Wait for either subprocess to finish. Then kill the other one and wait +# for that to finish as well. Return the exit code from the first process. +my $pid = wait; +my $status = $?; +my $rc = $status >> 8; # Normally 128+N when grandchild catches signal N +my $signal = $status & 127; # Only nonzero if $cmd_pid shell itself killed +if ($rc == 0 and $signal != 0) { + $rc = 128 + $signal; # Paranoia in case $pid shell is killed directly +} + +die("watchdog.pl: No child process\n") if ($pid < 0); + +if ($pid == $cmd_pid) { + kill 'TERM', $watchdog_pid; +} elsif ($pid == $watchdog_pid) { + kill 'TERM', $cmd_pid; +} else { + die "watchdog.pl: Unexpected child process pid: ${pid}\n"; +} + +$pid=wait; +exit($rc); + diff --git a/W/uninstall_module_one.bat b/W/uninstall_module_one.bat new file mode 100755 index 0000000..071da62 --- /dev/null +++ b/W/uninstall_module_one.bat @@ -0,0 +1,27 @@ + +@REM $Id: uninstall_module_one.bat,v 1.1 2017/07/08 00:10:46 gilles Exp gilles $ + +@ECHO OFF +SET SHELL= +SET +REM EXIT + +REM CD /D %~dp0 + +perl -v +IF ERRORLEVEL 1 ECHO Perl needed. Install Strawberry Perl. Get it at http://strawberryperl.com/ ^ + && EXIT /B + +@ECHO perl is here + +FOR %%M in ( + Net::Ping ^ + ) DO perl -m%%M -e "print qq{Uninstalling %%M $%%M::VERSION \n}" ^ + & cpanm --uninstall %%M + +REM IO::Socket::SSL Net::SSLeay PAR::Packer + +@ECHO Perl modules for imapsync installed +PAUSE + + diff --git a/X/bootstrap.min.js b/X/bootstrap.min.js new file mode 100644 index 0000000..9bcd2fc --- /dev/null +++ b/X/bootstrap.min.js @@ -0,0 +1,7 @@ +/*! + * Bootstrap v3.3.7 (http://getbootstrap.com) + * Copyright 2011-2016 Twitter, Inc. + * Licensed under the MIT license + */ +if("undefined"==typeof jQuery)throw new Error("Bootstrap's JavaScript requires jQuery");+function(a){"use strict";var b=a.fn.jquery.split(" ")[0].split(".");if(b[0]<2&&b[1]<9||1==b[0]&&9==b[1]&&b[2]<1||b[0]>3)throw new Error("Bootstrap's JavaScript requires jQuery version 1.9.1 or higher, but lower than version 4")}(jQuery),+function(a){"use strict";function b(){var a=document.createElement("bootstrap"),b={WebkitTransition:"webkitTransitionEnd",MozTransition:"transitionend",OTransition:"oTransitionEnd otransitionend",transition:"transitionend"};for(var c in b)if(void 0!==a.style[c])return{end:b[c]};return!1}a.fn.emulateTransitionEnd=function(b){var c=!1,d=this;a(this).one("bsTransitionEnd",function(){c=!0});var e=function(){c||a(d).trigger(a.support.transition.end)};return setTimeout(e,b),this},a(function(){a.support.transition=b(),a.support.transition&&(a.event.special.bsTransitionEnd={bindType:a.support.transition.end,delegateType:a.support.transition.end,handle:function(b){if(a(b.target).is(this))return b.handleObj.handler.apply(this,arguments)}})})}(jQuery),+function(a){"use strict";function b(b){return this.each(function(){var c=a(this),e=c.data("bs.alert");e||c.data("bs.alert",e=new d(this)),"string"==typeof b&&e[b].call(c)})}var c='[data-dismiss="alert"]',d=function(b){a(b).on("click",c,this.close)};d.VERSION="3.3.7",d.TRANSITION_DURATION=150,d.prototype.close=function(b){function c(){g.detach().trigger("closed.bs.alert").remove()}var e=a(this),f=e.attr("data-target");f||(f=e.attr("href"),f=f&&f.replace(/.*(?=#[^\s]*$)/,""));var g=a("#"===f?[]:f);b&&b.preventDefault(),g.length||(g=e.closest(".alert")),g.trigger(b=a.Event("close.bs.alert")),b.isDefaultPrevented()||(g.removeClass("in"),a.support.transition&&g.hasClass("fade")?g.one("bsTransitionEnd",c).emulateTransitionEnd(d.TRANSITION_DURATION):c())};var e=a.fn.alert;a.fn.alert=b,a.fn.alert.Constructor=d,a.fn.alert.noConflict=function(){return a.fn.alert=e,this},a(document).on("click.bs.alert.data-api",c,d.prototype.close)}(jQuery),+function(a){"use strict";function b(b){return this.each(function(){var d=a(this),e=d.data("bs.button"),f="object"==typeof b&&b;e||d.data("bs.button",e=new c(this,f)),"toggle"==b?e.toggle():b&&e.setState(b)})}var c=function(b,d){this.$element=a(b),this.options=a.extend({},c.DEFAULTS,d),this.isLoading=!1};c.VERSION="3.3.7",c.DEFAULTS={loadingText:"loading..."},c.prototype.setState=function(b){var c="disabled",d=this.$element,e=d.is("input")?"val":"html",f=d.data();b+="Text",null==f.resetText&&d.data("resetText",d[e]()),setTimeout(a.proxy(function(){d[e](null==f[b]?this.options[b]:f[b]),"loadingText"==b?(this.isLoading=!0,d.addClass(c).attr(c,c).prop(c,!0)):this.isLoading&&(this.isLoading=!1,d.removeClass(c).removeAttr(c).prop(c,!1))},this),0)},c.prototype.toggle=function(){var a=!0,b=this.$element.closest('[data-toggle="buttons"]');if(b.length){var c=this.$element.find("input");"radio"==c.prop("type")?(c.prop("checked")&&(a=!1),b.find(".active").removeClass("active"),this.$element.addClass("active")):"checkbox"==c.prop("type")&&(c.prop("checked")!==this.$element.hasClass("active")&&(a=!1),this.$element.toggleClass("active")),c.prop("checked",this.$element.hasClass("active")),a&&c.trigger("change")}else this.$element.attr("aria-pressed",!this.$element.hasClass("active")),this.$element.toggleClass("active")};var d=a.fn.button;a.fn.button=b,a.fn.button.Constructor=c,a.fn.button.noConflict=function(){return a.fn.button=d,this},a(document).on("click.bs.button.data-api",'[data-toggle^="button"]',function(c){var d=a(c.target).closest(".btn");b.call(d,"toggle"),a(c.target).is('input[type="radio"], input[type="checkbox"]')||(c.preventDefault(),d.is("input,button")?d.trigger("focus"):d.find("input:visible,button:visible").first().trigger("focus"))}).on("focus.bs.button.data-api blur.bs.button.data-api",'[data-toggle^="button"]',function(b){a(b.target).closest(".btn").toggleClass("focus",/^focus(in)?$/.test(b.type))})}(jQuery),+function(a){"use strict";function b(b){return this.each(function(){var d=a(this),e=d.data("bs.carousel"),f=a.extend({},c.DEFAULTS,d.data(),"object"==typeof b&&b),g="string"==typeof b?b:f.slide;e||d.data("bs.carousel",e=new c(this,f)),"number"==typeof b?e.to(b):g?e[g]():f.interval&&e.pause().cycle()})}var c=function(b,c){this.$element=a(b),this.$indicators=this.$element.find(".carousel-indicators"),this.options=c,this.paused=null,this.sliding=null,this.interval=null,this.$active=null,this.$items=null,this.options.keyboard&&this.$element.on("keydown.bs.carousel",a.proxy(this.keydown,this)),"hover"==this.options.pause&&!("ontouchstart"in document.documentElement)&&this.$element.on("mouseenter.bs.carousel",a.proxy(this.pause,this)).on("mouseleave.bs.carousel",a.proxy(this.cycle,this))};c.VERSION="3.3.7",c.TRANSITION_DURATION=600,c.DEFAULTS={interval:5e3,pause:"hover",wrap:!0,keyboard:!0},c.prototype.keydown=function(a){if(!/input|textarea/i.test(a.target.tagName)){switch(a.which){case 37:this.prev();break;case 39:this.next();break;default:return}a.preventDefault()}},c.prototype.cycle=function(b){return b||(this.paused=!1),this.interval&&clearInterval(this.interval),this.options.interval&&!this.paused&&(this.interval=setInterval(a.proxy(this.next,this),this.options.interval)),this},c.prototype.getItemIndex=function(a){return this.$items=a.parent().children(".item"),this.$items.index(a||this.$active)},c.prototype.getItemForDirection=function(a,b){var c=this.getItemIndex(b),d="prev"==a&&0===c||"next"==a&&c==this.$items.length-1;if(d&&!this.options.wrap)return b;var e="prev"==a?-1:1,f=(c+e)%this.$items.length;return this.$items.eq(f)},c.prototype.to=function(a){var b=this,c=this.getItemIndex(this.$active=this.$element.find(".item.active"));if(!(a>this.$items.length-1||a<0))return this.sliding?this.$element.one("slid.bs.carousel",function(){b.to(a)}):c==a?this.pause().cycle():this.slide(a>c?"next":"prev",this.$items.eq(a))},c.prototype.pause=function(b){return b||(this.paused=!0),this.$element.find(".next, .prev").length&&a.support.transition&&(this.$element.trigger(a.support.transition.end),this.cycle(!0)),this.interval=clearInterval(this.interval),this},c.prototype.next=function(){if(!this.sliding)return this.slide("next")},c.prototype.prev=function(){if(!this.sliding)return this.slide("prev")},c.prototype.slide=function(b,d){var e=this.$element.find(".item.active"),f=d||this.getItemForDirection(b,e),g=this.interval,h="next"==b?"left":"right",i=this;if(f.hasClass("active"))return this.sliding=!1;var j=f[0],k=a.Event("slide.bs.carousel",{relatedTarget:j,direction:h});if(this.$element.trigger(k),!k.isDefaultPrevented()){if(this.sliding=!0,g&&this.pause(),this.$indicators.length){this.$indicators.find(".active").removeClass("active");var l=a(this.$indicators.children()[this.getItemIndex(f)]);l&&l.addClass("active")}var m=a.Event("slid.bs.carousel",{relatedTarget:j,direction:h});return a.support.transition&&this.$element.hasClass("slide")?(f.addClass(b),f[0].offsetWidth,e.addClass(h),f.addClass(h),e.one("bsTransitionEnd",function(){f.removeClass([b,h].join(" ")).addClass("active"),e.removeClass(["active",h].join(" ")),i.sliding=!1,setTimeout(function(){i.$element.trigger(m)},0)}).emulateTransitionEnd(c.TRANSITION_DURATION)):(e.removeClass("active"),f.addClass("active"),this.sliding=!1,this.$element.trigger(m)),g&&this.cycle(),this}};var d=a.fn.carousel;a.fn.carousel=b,a.fn.carousel.Constructor=c,a.fn.carousel.noConflict=function(){return a.fn.carousel=d,this};var e=function(c){var d,e=a(this),f=a(e.attr("data-target")||(d=e.attr("href"))&&d.replace(/.*(?=#[^\s]+$)/,""));if(f.hasClass("carousel")){var g=a.extend({},f.data(),e.data()),h=e.attr("data-slide-to");h&&(g.interval=!1),b.call(f,g),h&&f.data("bs.carousel").to(h),c.preventDefault()}};a(document).on("click.bs.carousel.data-api","[data-slide]",e).on("click.bs.carousel.data-api","[data-slide-to]",e),a(window).on("load",function(){a('[data-ride="carousel"]').each(function(){var c=a(this);b.call(c,c.data())})})}(jQuery),+function(a){"use strict";function b(b){var c,d=b.attr("data-target")||(c=b.attr("href"))&&c.replace(/.*(?=#[^\s]+$)/,"");return a(d)}function c(b){return this.each(function(){var c=a(this),e=c.data("bs.collapse"),f=a.extend({},d.DEFAULTS,c.data(),"object"==typeof b&&b);!e&&f.toggle&&/show|hide/.test(b)&&(f.toggle=!1),e||c.data("bs.collapse",e=new d(this,f)),"string"==typeof b&&e[b]()})}var d=function(b,c){this.$element=a(b),this.options=a.extend({},d.DEFAULTS,c),this.$trigger=a('[data-toggle="collapse"][href="#'+b.id+'"],[data-toggle="collapse"][data-target="#'+b.id+'"]'),this.transitioning=null,this.options.parent?this.$parent=this.getParent():this.addAriaAndCollapsedClass(this.$element,this.$trigger),this.options.toggle&&this.toggle()};d.VERSION="3.3.7",d.TRANSITION_DURATION=350,d.DEFAULTS={toggle:!0},d.prototype.dimension=function(){var a=this.$element.hasClass("width");return a?"width":"height"},d.prototype.show=function(){if(!this.transitioning&&!this.$element.hasClass("in")){var b,e=this.$parent&&this.$parent.children(".panel").children(".in, .collapsing");if(!(e&&e.length&&(b=e.data("bs.collapse"),b&&b.transitioning))){var f=a.Event("show.bs.collapse");if(this.$element.trigger(f),!f.isDefaultPrevented()){e&&e.length&&(c.call(e,"hide"),b||e.data("bs.collapse",null));var g=this.dimension();this.$element.removeClass("collapse").addClass("collapsing")[g](0).attr("aria-expanded",!0),this.$trigger.removeClass("collapsed").attr("aria-expanded",!0),this.transitioning=1;var h=function(){this.$element.removeClass("collapsing").addClass("collapse in")[g](""),this.transitioning=0,this.$element.trigger("shown.bs.collapse")};if(!a.support.transition)return h.call(this);var i=a.camelCase(["scroll",g].join("-"));this.$element.one("bsTransitionEnd",a.proxy(h,this)).emulateTransitionEnd(d.TRANSITION_DURATION)[g](this.$element[0][i])}}}},d.prototype.hide=function(){if(!this.transitioning&&this.$element.hasClass("in")){var b=a.Event("hide.bs.collapse");if(this.$element.trigger(b),!b.isDefaultPrevented()){var c=this.dimension();this.$element[c](this.$element[c]())[0].offsetHeight,this.$element.addClass("collapsing").removeClass("collapse in").attr("aria-expanded",!1),this.$trigger.addClass("collapsed").attr("aria-expanded",!1),this.transitioning=1;var e=function(){this.transitioning=0,this.$element.removeClass("collapsing").addClass("collapse").trigger("hidden.bs.collapse")};return a.support.transition?void this.$element[c](0).one("bsTransitionEnd",a.proxy(e,this)).emulateTransitionEnd(d.TRANSITION_DURATION):e.call(this)}}},d.prototype.toggle=function(){this[this.$element.hasClass("in")?"hide":"show"]()},d.prototype.getParent=function(){return a(this.options.parent).find('[data-toggle="collapse"][data-parent="'+this.options.parent+'"]').each(a.proxy(function(c,d){var e=a(d);this.addAriaAndCollapsedClass(b(e),e)},this)).end()},d.prototype.addAriaAndCollapsedClass=function(a,b){var c=a.hasClass("in");a.attr("aria-expanded",c),b.toggleClass("collapsed",!c).attr("aria-expanded",c)};var e=a.fn.collapse;a.fn.collapse=c,a.fn.collapse.Constructor=d,a.fn.collapse.noConflict=function(){return a.fn.collapse=e,this},a(document).on("click.bs.collapse.data-api",'[data-toggle="collapse"]',function(d){var e=a(this);e.attr("data-target")||d.preventDefault();var f=b(e),g=f.data("bs.collapse"),h=g?"toggle":e.data();c.call(f,h)})}(jQuery),+function(a){"use strict";function b(b){var c=b.attr("data-target");c||(c=b.attr("href"),c=c&&/#[A-Za-z]/.test(c)&&c.replace(/.*(?=#[^\s]*$)/,""));var d=c&&a(c);return d&&d.length?d:b.parent()}function c(c){c&&3===c.which||(a(e).remove(),a(f).each(function(){var d=a(this),e=b(d),f={relatedTarget:this};e.hasClass("open")&&(c&&"click"==c.type&&/input|textarea/i.test(c.target.tagName)&&a.contains(e[0],c.target)||(e.trigger(c=a.Event("hide.bs.dropdown",f)),c.isDefaultPrevented()||(d.attr("aria-expanded","false"),e.removeClass("open").trigger(a.Event("hidden.bs.dropdown",f)))))}))}function d(b){return this.each(function(){var c=a(this),d=c.data("bs.dropdown");d||c.data("bs.dropdown",d=new g(this)),"string"==typeof b&&d[b].call(c)})}var e=".dropdown-backdrop",f='[data-toggle="dropdown"]',g=function(b){a(b).on("click.bs.dropdown",this.toggle)};g.VERSION="3.3.7",g.prototype.toggle=function(d){var e=a(this);if(!e.is(".disabled, :disabled")){var f=b(e),g=f.hasClass("open");if(c(),!g){"ontouchstart"in document.documentElement&&!f.closest(".navbar-nav").length&&a(document.createElement("div")).addClass("dropdown-backdrop").insertAfter(a(this)).on("click",c);var h={relatedTarget:this};if(f.trigger(d=a.Event("show.bs.dropdown",h)),d.isDefaultPrevented())return;e.trigger("focus").attr("aria-expanded","true"),f.toggleClass("open").trigger(a.Event("shown.bs.dropdown",h))}return!1}},g.prototype.keydown=function(c){if(/(38|40|27|32)/.test(c.which)&&!/input|textarea/i.test(c.target.tagName)){var d=a(this);if(c.preventDefault(),c.stopPropagation(),!d.is(".disabled, :disabled")){var e=b(d),g=e.hasClass("open");if(!g&&27!=c.which||g&&27==c.which)return 27==c.which&&e.find(f).trigger("focus"),d.trigger("click");var h=" li:not(.disabled):visible a",i=e.find(".dropdown-menu"+h);if(i.length){var j=i.index(c.target);38==c.which&&j>0&&j--,40==c.which&&jdocument.documentElement.clientHeight;this.$element.css({paddingLeft:!this.bodyIsOverflowing&&a?this.scrollbarWidth:"",paddingRight:this.bodyIsOverflowing&&!a?this.scrollbarWidth:""})},c.prototype.resetAdjustments=function(){this.$element.css({paddingLeft:"",paddingRight:""})},c.prototype.checkScrollbar=function(){var a=window.innerWidth;if(!a){var b=document.documentElement.getBoundingClientRect();a=b.right-Math.abs(b.left)}this.bodyIsOverflowing=document.body.clientWidth
        ',trigger:"hover focus",title:"",delay:0,html:!1,container:!1,viewport:{selector:"body",padding:0}},c.prototype.init=function(b,c,d){if(this.enabled=!0,this.type=b,this.$element=a(c),this.options=this.getOptions(d),this.$viewport=this.options.viewport&&a(a.isFunction(this.options.viewport)?this.options.viewport.call(this,this.$element):this.options.viewport.selector||this.options.viewport),this.inState={click:!1,hover:!1,focus:!1},this.$element[0]instanceof document.constructor&&!this.options.selector)throw new Error("`selector` option must be specified when initializing "+this.type+" on the window.document object!");for(var e=this.options.trigger.split(" "),f=e.length;f--;){var g=e[f];if("click"==g)this.$element.on("click."+this.type,this.options.selector,a.proxy(this.toggle,this));else if("manual"!=g){var h="hover"==g?"mouseenter":"focusin",i="hover"==g?"mouseleave":"focusout";this.$element.on(h+"."+this.type,this.options.selector,a.proxy(this.enter,this)),this.$element.on(i+"."+this.type,this.options.selector,a.proxy(this.leave,this))}}this.options.selector?this._options=a.extend({},this.options,{trigger:"manual",selector:""}):this.fixTitle()},c.prototype.getDefaults=function(){return c.DEFAULTS},c.prototype.getOptions=function(b){return b=a.extend({},this.getDefaults(),this.$element.data(),b),b.delay&&"number"==typeof b.delay&&(b.delay={show:b.delay,hide:b.delay}),b},c.prototype.getDelegateOptions=function(){var b={},c=this.getDefaults();return this._options&&a.each(this._options,function(a,d){c[a]!=d&&(b[a]=d)}),b},c.prototype.enter=function(b){var c=b instanceof this.constructor?b:a(b.currentTarget).data("bs."+this.type);return c||(c=new this.constructor(b.currentTarget,this.getDelegateOptions()),a(b.currentTarget).data("bs."+this.type,c)),b instanceof a.Event&&(c.inState["focusin"==b.type?"focus":"hover"]=!0),c.tip().hasClass("in")||"in"==c.hoverState?void(c.hoverState="in"):(clearTimeout(c.timeout),c.hoverState="in",c.options.delay&&c.options.delay.show?void(c.timeout=setTimeout(function(){"in"==c.hoverState&&c.show()},c.options.delay.show)):c.show())},c.prototype.isInStateTrue=function(){for(var a in this.inState)if(this.inState[a])return!0;return!1},c.prototype.leave=function(b){var c=b instanceof this.constructor?b:a(b.currentTarget).data("bs."+this.type);if(c||(c=new this.constructor(b.currentTarget,this.getDelegateOptions()),a(b.currentTarget).data("bs."+this.type,c)),b instanceof a.Event&&(c.inState["focusout"==b.type?"focus":"hover"]=!1),!c.isInStateTrue())return clearTimeout(c.timeout),c.hoverState="out",c.options.delay&&c.options.delay.hide?void(c.timeout=setTimeout(function(){"out"==c.hoverState&&c.hide()},c.options.delay.hide)):c.hide()},c.prototype.show=function(){var b=a.Event("show.bs."+this.type);if(this.hasContent()&&this.enabled){this.$element.trigger(b);var d=a.contains(this.$element[0].ownerDocument.documentElement,this.$element[0]);if(b.isDefaultPrevented()||!d)return;var e=this,f=this.tip(),g=this.getUID(this.type);this.setContent(),f.attr("id",g),this.$element.attr("aria-describedby",g),this.options.animation&&f.addClass("fade");var h="function"==typeof this.options.placement?this.options.placement.call(this,f[0],this.$element[0]):this.options.placement,i=/\s?auto?\s?/i,j=i.test(h);j&&(h=h.replace(i,"")||"top"),f.detach().css({top:0,left:0,display:"block"}).addClass(h).data("bs."+this.type,this),this.options.container?f.appendTo(this.options.container):f.insertAfter(this.$element),this.$element.trigger("inserted.bs."+this.type);var k=this.getPosition(),l=f[0].offsetWidth,m=f[0].offsetHeight;if(j){var n=h,o=this.getPosition(this.$viewport);h="bottom"==h&&k.bottom+m>o.bottom?"top":"top"==h&&k.top-mo.width?"left":"left"==h&&k.left-lg.top+g.height&&(e.top=g.top+g.height-i)}else{var j=b.left-f,k=b.left+f+c;jg.right&&(e.left=g.left+g.width-k)}return e},c.prototype.getTitle=function(){var a,b=this.$element,c=this.options;return a=b.attr("data-original-title")||("function"==typeof c.title?c.title.call(b[0]):c.title)},c.prototype.getUID=function(a){do a+=~~(1e6*Math.random());while(document.getElementById(a));return a},c.prototype.tip=function(){if(!this.$tip&&(this.$tip=a(this.options.template),1!=this.$tip.length))throw new Error(this.type+" `template` option must consist of exactly 1 top-level element!");return this.$tip},c.prototype.arrow=function(){return this.$arrow=this.$arrow||this.tip().find(".tooltip-arrow")},c.prototype.enable=function(){this.enabled=!0},c.prototype.disable=function(){this.enabled=!1},c.prototype.toggleEnabled=function(){this.enabled=!this.enabled},c.prototype.toggle=function(b){var c=this;b&&(c=a(b.currentTarget).data("bs."+this.type),c||(c=new this.constructor(b.currentTarget,this.getDelegateOptions()),a(b.currentTarget).data("bs."+this.type,c))),b?(c.inState.click=!c.inState.click,c.isInStateTrue()?c.enter(c):c.leave(c)):c.tip().hasClass("in")?c.leave(c):c.enter(c)},c.prototype.destroy=function(){var a=this;clearTimeout(this.timeout),this.hide(function(){a.$element.off("."+a.type).removeData("bs."+a.type),a.$tip&&a.$tip.detach(),a.$tip=null,a.$arrow=null,a.$viewport=null,a.$element=null})};var d=a.fn.tooltip;a.fn.tooltip=b,a.fn.tooltip.Constructor=c,a.fn.tooltip.noConflict=function(){return a.fn.tooltip=d,this}}(jQuery),+function(a){"use strict";function b(b){return this.each(function(){var d=a(this),e=d.data("bs.popover"),f="object"==typeof b&&b;!e&&/destroy|hide/.test(b)||(e||d.data("bs.popover",e=new c(this,f)),"string"==typeof b&&e[b]())})}var c=function(a,b){this.init("popover",a,b)};if(!a.fn.tooltip)throw new Error("Popover requires tooltip.js");c.VERSION="3.3.7",c.DEFAULTS=a.extend({},a.fn.tooltip.Constructor.DEFAULTS,{placement:"right",trigger:"click",content:"",template:''}),c.prototype=a.extend({},a.fn.tooltip.Constructor.prototype),c.prototype.constructor=c,c.prototype.getDefaults=function(){return c.DEFAULTS},c.prototype.setContent=function(){var a=this.tip(),b=this.getTitle(),c=this.getContent();a.find(".popover-title")[this.options.html?"html":"text"](b),a.find(".popover-content").children().detach().end()[this.options.html?"string"==typeof c?"html":"append":"text"](c),a.removeClass("fade top bottom left right in"),a.find(".popover-title").html()||a.find(".popover-title").hide()},c.prototype.hasContent=function(){return this.getTitle()||this.getContent()},c.prototype.getContent=function(){var a=this.$element,b=this.options;return a.attr("data-content")||("function"==typeof b.content?b.content.call(a[0]):b.content)},c.prototype.arrow=function(){return this.$arrow=this.$arrow||this.tip().find(".arrow")};var d=a.fn.popover;a.fn.popover=b,a.fn.popover.Constructor=c,a.fn.popover.noConflict=function(){return a.fn.popover=d,this}}(jQuery),+function(a){"use strict";function b(c,d){this.$body=a(document.body),this.$scrollElement=a(a(c).is(document.body)?window:c),this.options=a.extend({},b.DEFAULTS,d),this.selector=(this.options.target||"")+" .nav li > a",this.offsets=[],this.targets=[],this.activeTarget=null,this.scrollHeight=0,this.$scrollElement.on("scroll.bs.scrollspy",a.proxy(this.process,this)),this.refresh(),this.process()}function c(c){return this.each(function(){var d=a(this),e=d.data("bs.scrollspy"),f="object"==typeof c&&c;e||d.data("bs.scrollspy",e=new b(this,f)),"string"==typeof c&&e[c]()})}b.VERSION="3.3.7",b.DEFAULTS={offset:10},b.prototype.getScrollHeight=function(){return this.$scrollElement[0].scrollHeight||Math.max(this.$body[0].scrollHeight,document.documentElement.scrollHeight)},b.prototype.refresh=function(){var b=this,c="offset",d=0;this.offsets=[],this.targets=[],this.scrollHeight=this.getScrollHeight(),a.isWindow(this.$scrollElement[0])||(c="position",d=this.$scrollElement.scrollTop()),this.$body.find(this.selector).map(function(){var b=a(this),e=b.data("target")||b.attr("href"),f=/^#./.test(e)&&a(e);return f&&f.length&&f.is(":visible")&&[[f[c]().top+d,e]]||null}).sort(function(a,b){return a[0]-b[0]}).each(function(){b.offsets.push(this[0]),b.targets.push(this[1])})},b.prototype.process=function(){var a,b=this.$scrollElement.scrollTop()+this.options.offset,c=this.getScrollHeight(),d=this.options.offset+c-this.$scrollElement.height(),e=this.offsets,f=this.targets,g=this.activeTarget;if(this.scrollHeight!=c&&this.refresh(),b>=d)return g!=(a=f[f.length-1])&&this.activate(a);if(g&&b=e[a]&&(void 0===e[a+1]||b .dropdown-menu > .active").removeClass("active").end().find('[data-toggle="tab"]').attr("aria-expanded",!1),b.addClass("active").find('[data-toggle="tab"]').attr("aria-expanded",!0),h?(b[0].offsetWidth,b.addClass("in")):b.removeClass("fade"),b.parent(".dropdown-menu").length&&b.closest("li.dropdown").addClass("active").end().find('[data-toggle="tab"]').attr("aria-expanded",!0),e&&e()}var g=d.find("> .active"),h=e&&a.support.transition&&(g.length&&g.hasClass("fade")||!!d.find("> .fade").length);g.length&&h?g.one("bsTransitionEnd",f).emulateTransitionEnd(c.TRANSITION_DURATION):f(),g.removeClass("in")};var d=a.fn.tab;a.fn.tab=b,a.fn.tab.Constructor=c,a.fn.tab.noConflict=function(){return a.fn.tab=d,this};var e=function(c){c.preventDefault(),b.call(a(this),"show")};a(document).on("click.bs.tab.data-api",'[data-toggle="tab"]',e).on("click.bs.tab.data-api",'[data-toggle="pill"]',e)}(jQuery),+function(a){"use strict";function b(b){return this.each(function(){var d=a(this),e=d.data("bs.affix"),f="object"==typeof b&&b;e||d.data("bs.affix",e=new c(this,f)),"string"==typeof b&&e[b]()})}var c=function(b,d){this.options=a.extend({},c.DEFAULTS,d),this.$target=a(this.options.target).on("scroll.bs.affix.data-api",a.proxy(this.checkPosition,this)).on("click.bs.affix.data-api",a.proxy(this.checkPositionWithEventLoop,this)),this.$element=a(b),this.affixed=null,this.unpin=null,this.pinnedOffset=null,this.checkPosition()};c.VERSION="3.3.7",c.RESET="affix affix-top affix-bottom",c.DEFAULTS={offset:0,target:window},c.prototype.getState=function(a,b,c,d){var e=this.$target.scrollTop(),f=this.$element.offset(),g=this.$target.height();if(null!=c&&"top"==this.affixed)return e=a-d&&"bottom"},c.prototype.getPinnedOffset=function(){if(this.pinnedOffset)return this.pinnedOffset;this.$element.removeClass(c.RESET).addClass("affix");var a=this.$target.scrollTop(),b=this.$element.offset();return this.pinnedOffset=b.top-a},c.prototype.checkPositionWithEventLoop=function(){setTimeout(a.proxy(this.checkPosition,this),1)},c.prototype.checkPosition=function(){if(this.$element.is(":visible")){var b=this.$element.height(),d=this.options.offset,e=d.top,f=d.bottom,g=Math.max(a(document).height(),a(document.body).height());"object"!=typeof d&&(f=e=d),"function"==typeof e&&(e=d.top(this.$element)),"function"==typeof f&&(f=d.bottom(this.$element));var h=this.getState(g,b,e,f);if(this.affixed!=h){null!=this.unpin&&this.$element.css("top","");var i="affix"+(h?"-"+h:""),j=a.Event(i+".bs.affix");if(this.$element.trigger(j),j.isDefaultPrevented())return;this.affixed=h,this.unpin="bottom"==h?this.getPinnedOffset():null,this.$element.removeClass(c.RESET).addClass(i).trigger(i.replace("affix","affixed")+".bs.affix")}"bottom"==h&&this.$element.offset({top:g-b-f})}};var d=a.fn.affix;a.fn.affix=b,a.fn.affix.Constructor=c,a.fn.affix.noConflict=function(){return a.fn.affix=d,this},a(window).on("load",function(){a('[data-spy="affix"]').each(function(){var c=a(this),d=c.data();d.offset=d.offset||{},null!=d.offsetBottom&&(d.offset.bottom=d.offsetBottom),null!=d.offsetTop&&(d.offset.top=d.offsetTop),b.call(c,d)})})}(jQuery); \ No newline at end of file diff --git a/X/imapsync_form.html b/X/imapsync_form.html new file mode 100644 index 0000000..61d1e81 --- /dev/null +++ b/X/imapsync_form.html @@ -0,0 +1,462 @@ + + + + + + + Imapsync online + + + + + + + + + + + + + + + + + +
        + +
        +
        + + Imapsync home + + Top + Pricing + Consoles + Bottom +
        +
        + +

        Imapsync online

        + + + + + +
        +

        Pay by usage type

        +
        + + + +
        + + + + +
        + + +
        +

        + Payment only after the job is well done are ok! +

        +
        +
        + + + +
        +
        +
        +
        + Source account + + +
        + + +
        + + +
        + + +
        + + +
        + + + + +
        + + +
        +
        +
        +
        +
        + + +
        +
        + Destination account + + +
        + + +
        + +
        + + +
        + + +
        + + + + +
        + +
        +
        +
        +
        +
        + +
        + + + + +
        + + + + +
        +
        + +
        +
        + +
        +
        +
        + + + + +
        +
        +

        Console of imapsync run

        + 
        +
+
+
+
        + Bottom of imapsync log +
        + +
        +

        Console of abort

        + 
        +
+
+
+
        +
        +
        + +
        + +

        Log of imapsync run

        + +
        +
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
        + + +
        + +

        Feel free to contact + Gilles LAMIRAL +

        + + +
        +
        +
        + + Imapsync home + + Top + Consoles + Bottom +
        + ($Id: imapsync_form.html,v 1.42 2017/09/07 00:58:48 gilles Exp gilles $)
        + Terms and conditions for anything: No limits to do anything with this work and this license!
        +
        +
        +
        + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/X/index.html b/X/index.html new file mode 120000 index 0000000..3ecb07a --- /dev/null +++ b/X/index.html @@ -0,0 +1 @@ +imapsync_form.html \ No newline at end of file diff --git a/X/jquery.min.js b/X/jquery.min.js new file mode 100644 index 0000000..644d35e --- /dev/null +++ b/X/jquery.min.js @@ -0,0 +1,4 @@ +/*! jQuery v3.2.1 | (c) JS Foundation and other contributors | jquery.org/license */ +!function(a,b){"use strict";"object"==typeof module&&"object"==typeof module.exports?module.exports=a.document?b(a,!0):function(a){if(!a.document)throw new Error("jQuery requires a window with a document");return b(a)}:b(a)}("undefined"!=typeof window?window:this,function(a,b){"use strict";var c=[],d=a.document,e=Object.getPrototypeOf,f=c.slice,g=c.concat,h=c.push,i=c.indexOf,j={},k=j.toString,l=j.hasOwnProperty,m=l.toString,n=m.call(Object),o={};function p(a,b){b=b||d;var c=b.createElement("script");c.text=a,b.head.appendChild(c).parentNode.removeChild(c)}var q="3.2.1",r=function(a,b){return new r.fn.init(a,b)},s=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g,t=/^-ms-/,u=/-([a-z])/g,v=function(a,b){return b.toUpperCase()};r.fn=r.prototype={jquery:q,constructor:r,length:0,toArray:function(){return f.call(this)},get:function(a){return null==a?f.call(this):a<0?this[a+this.length]:this[a]},pushStack:function(a){var b=r.merge(this.constructor(),a);return b.prevObject=this,b},each:function(a){return r.each(this,a)},map:function(a){return this.pushStack(r.map(this,function(b,c){return a.call(b,c,b)}))},slice:function(){return this.pushStack(f.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(a){var b=this.length,c=+a+(a<0?b:0);return this.pushStack(c>=0&&c0&&b-1 in a)}var x=function(a){var b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u="sizzle"+1*new Date,v=a.document,w=0,x=0,y=ha(),z=ha(),A=ha(),B=function(a,b){return a===b&&(l=!0),0},C={}.hasOwnProperty,D=[],E=D.pop,F=D.push,G=D.push,H=D.slice,I=function(a,b){for(var c=0,d=a.length;c+~]|"+K+")"+K+"*"),S=new RegExp("="+K+"*([^\\]'\"]*?)"+K+"*\\]","g"),T=new RegExp(N),U=new RegExp("^"+L+"$"),V={ID:new RegExp("^#("+L+")"),CLASS:new RegExp("^\\.("+L+")"),TAG:new RegExp("^("+L+"|[*])"),ATTR:new RegExp("^"+M),PSEUDO:new RegExp("^"+N),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+K+"*(even|odd|(([+-]|)(\\d*)n|)"+K+"*(?:([+-]|)"+K+"*(\\d+)|))"+K+"*\\)|)","i"),bool:new RegExp("^(?:"+J+")$","i"),needsContext:new RegExp("^"+K+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+K+"*((?:-\\d)?\\d*)"+K+"*\\)|)(?=[^-]|$)","i")},W=/^(?:input|select|textarea|button)$/i,X=/^h\d$/i,Y=/^[^{]+\{\s*\[native \w/,Z=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,$=/[+~]/,_=new RegExp("\\\\([\\da-f]{1,6}"+K+"?|("+K+")|.)","ig"),aa=function(a,b,c){var d="0x"+b-65536;return d!==d||c?b:d<0?String.fromCharCode(d+65536):String.fromCharCode(d>>10|55296,1023&d|56320)},ba=/([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g,ca=function(a,b){return b?"\0"===a?"\ufffd":a.slice(0,-1)+"\\"+a.charCodeAt(a.length-1).toString(16)+" ":"\\"+a},da=function(){m()},ea=ta(function(a){return a.disabled===!0&&("form"in a||"label"in a)},{dir:"parentNode",next:"legend"});try{G.apply(D=H.call(v.childNodes),v.childNodes),D[v.childNodes.length].nodeType}catch(fa){G={apply:D.length?function(a,b){F.apply(a,H.call(b))}:function(a,b){var c=a.length,d=0;while(a[c++]=b[d++]);a.length=c-1}}}function ga(a,b,d,e){var f,h,j,k,l,o,r,s=b&&b.ownerDocument,w=b?b.nodeType:9;if(d=d||[],"string"!=typeof a||!a||1!==w&&9!==w&&11!==w)return d;if(!e&&((b?b.ownerDocument||b:v)!==n&&m(b),b=b||n,p)){if(11!==w&&(l=Z.exec(a)))if(f=l[1]){if(9===w){if(!(j=b.getElementById(f)))return d;if(j.id===f)return d.push(j),d}else if(s&&(j=s.getElementById(f))&&t(b,j)&&j.id===f)return d.push(j),d}else{if(l[2])return G.apply(d,b.getElementsByTagName(a)),d;if((f=l[3])&&c.getElementsByClassName&&b.getElementsByClassName)return G.apply(d,b.getElementsByClassName(f)),d}if(c.qsa&&!A[a+" "]&&(!q||!q.test(a))){if(1!==w)s=b,r=a;else if("object"!==b.nodeName.toLowerCase()){(k=b.getAttribute("id"))?k=k.replace(ba,ca):b.setAttribute("id",k=u),o=g(a),h=o.length;while(h--)o[h]="#"+k+" "+sa(o[h]);r=o.join(","),s=$.test(a)&&qa(b.parentNode)||b}if(r)try{return G.apply(d,s.querySelectorAll(r)),d}catch(x){}finally{k===u&&b.removeAttribute("id")}}}return i(a.replace(P,"$1"),b,d,e)}function ha(){var a=[];function b(c,e){return a.push(c+" ")>d.cacheLength&&delete b[a.shift()],b[c+" "]=e}return b}function ia(a){return a[u]=!0,a}function ja(a){var b=n.createElement("fieldset");try{return!!a(b)}catch(c){return!1}finally{b.parentNode&&b.parentNode.removeChild(b),b=null}}function ka(a,b){var c=a.split("|"),e=c.length;while(e--)d.attrHandle[c[e]]=b}function la(a,b){var c=b&&a,d=c&&1===a.nodeType&&1===b.nodeType&&a.sourceIndex-b.sourceIndex;if(d)return d;if(c)while(c=c.nextSibling)if(c===b)return-1;return a?1:-1}function ma(a){return function(b){var c=b.nodeName.toLowerCase();return"input"===c&&b.type===a}}function na(a){return function(b){var c=b.nodeName.toLowerCase();return("input"===c||"button"===c)&&b.type===a}}function oa(a){return function(b){return"form"in b?b.parentNode&&b.disabled===!1?"label"in b?"label"in b.parentNode?b.parentNode.disabled===a:b.disabled===a:b.isDisabled===a||b.isDisabled!==!a&&ea(b)===a:b.disabled===a:"label"in b&&b.disabled===a}}function pa(a){return ia(function(b){return b=+b,ia(function(c,d){var e,f=a([],c.length,b),g=f.length;while(g--)c[e=f[g]]&&(c[e]=!(d[e]=c[e]))})})}function qa(a){return a&&"undefined"!=typeof a.getElementsByTagName&&a}c=ga.support={},f=ga.isXML=function(a){var b=a&&(a.ownerDocument||a).documentElement;return!!b&&"HTML"!==b.nodeName},m=ga.setDocument=function(a){var b,e,g=a?a.ownerDocument||a:v;return g!==n&&9===g.nodeType&&g.documentElement?(n=g,o=n.documentElement,p=!f(n),v!==n&&(e=n.defaultView)&&e.top!==e&&(e.addEventListener?e.addEventListener("unload",da,!1):e.attachEvent&&e.attachEvent("onunload",da)),c.attributes=ja(function(a){return a.className="i",!a.getAttribute("className")}),c.getElementsByTagName=ja(function(a){return a.appendChild(n.createComment("")),!a.getElementsByTagName("*").length}),c.getElementsByClassName=Y.test(n.getElementsByClassName),c.getById=ja(function(a){return o.appendChild(a).id=u,!n.getElementsByName||!n.getElementsByName(u).length}),c.getById?(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){return a.getAttribute("id")===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c=b.getElementById(a);return c?[c]:[]}}):(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){var c="undefined"!=typeof a.getAttributeNode&&a.getAttributeNode("id");return c&&c.value===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c,d,e,f=b.getElementById(a);if(f){if(c=f.getAttributeNode("id"),c&&c.value===a)return[f];e=b.getElementsByName(a),d=0;while(f=e[d++])if(c=f.getAttributeNode("id"),c&&c.value===a)return[f]}return[]}}),d.find.TAG=c.getElementsByTagName?function(a,b){return"undefined"!=typeof b.getElementsByTagName?b.getElementsByTagName(a):c.qsa?b.querySelectorAll(a):void 0}:function(a,b){var c,d=[],e=0,f=b.getElementsByTagName(a);if("*"===a){while(c=f[e++])1===c.nodeType&&d.push(c);return d}return f},d.find.CLASS=c.getElementsByClassName&&function(a,b){if("undefined"!=typeof b.getElementsByClassName&&p)return b.getElementsByClassName(a)},r=[],q=[],(c.qsa=Y.test(n.querySelectorAll))&&(ja(function(a){o.appendChild(a).innerHTML="",a.querySelectorAll("[msallowcapture^='']").length&&q.push("[*^$]="+K+"*(?:''|\"\")"),a.querySelectorAll("[selected]").length||q.push("\\["+K+"*(?:value|"+J+")"),a.querySelectorAll("[id~="+u+"-]").length||q.push("~="),a.querySelectorAll(":checked").length||q.push(":checked"),a.querySelectorAll("a#"+u+"+*").length||q.push(".#.+[+~]")}),ja(function(a){a.innerHTML="";var b=n.createElement("input");b.setAttribute("type","hidden"),a.appendChild(b).setAttribute("name","D"),a.querySelectorAll("[name=d]").length&&q.push("name"+K+"*[*^$|!~]?="),2!==a.querySelectorAll(":enabled").length&&q.push(":enabled",":disabled"),o.appendChild(a).disabled=!0,2!==a.querySelectorAll(":disabled").length&&q.push(":enabled",":disabled"),a.querySelectorAll("*,:x"),q.push(",.*:")})),(c.matchesSelector=Y.test(s=o.matches||o.webkitMatchesSelector||o.mozMatchesSelector||o.oMatchesSelector||o.msMatchesSelector))&&ja(function(a){c.disconnectedMatch=s.call(a,"*"),s.call(a,"[s!='']:x"),r.push("!=",N)}),q=q.length&&new RegExp(q.join("|")),r=r.length&&new RegExp(r.join("|")),b=Y.test(o.compareDocumentPosition),t=b||Y.test(o.contains)?function(a,b){var c=9===a.nodeType?a.documentElement:a,d=b&&b.parentNode;return a===d||!(!d||1!==d.nodeType||!(c.contains?c.contains(d):a.compareDocumentPosition&&16&a.compareDocumentPosition(d)))}:function(a,b){if(b)while(b=b.parentNode)if(b===a)return!0;return!1},B=b?function(a,b){if(a===b)return l=!0,0;var d=!a.compareDocumentPosition-!b.compareDocumentPosition;return d?d:(d=(a.ownerDocument||a)===(b.ownerDocument||b)?a.compareDocumentPosition(b):1,1&d||!c.sortDetached&&b.compareDocumentPosition(a)===d?a===n||a.ownerDocument===v&&t(v,a)?-1:b===n||b.ownerDocument===v&&t(v,b)?1:k?I(k,a)-I(k,b):0:4&d?-1:1)}:function(a,b){if(a===b)return l=!0,0;var c,d=0,e=a.parentNode,f=b.parentNode,g=[a],h=[b];if(!e||!f)return a===n?-1:b===n?1:e?-1:f?1:k?I(k,a)-I(k,b):0;if(e===f)return la(a,b);c=a;while(c=c.parentNode)g.unshift(c);c=b;while(c=c.parentNode)h.unshift(c);while(g[d]===h[d])d++;return d?la(g[d],h[d]):g[d]===v?-1:h[d]===v?1:0},n):n},ga.matches=function(a,b){return ga(a,null,null,b)},ga.matchesSelector=function(a,b){if((a.ownerDocument||a)!==n&&m(a),b=b.replace(S,"='$1']"),c.matchesSelector&&p&&!A[b+" "]&&(!r||!r.test(b))&&(!q||!q.test(b)))try{var d=s.call(a,b);if(d||c.disconnectedMatch||a.document&&11!==a.document.nodeType)return d}catch(e){}return ga(b,n,null,[a]).length>0},ga.contains=function(a,b){return(a.ownerDocument||a)!==n&&m(a),t(a,b)},ga.attr=function(a,b){(a.ownerDocument||a)!==n&&m(a);var e=d.attrHandle[b.toLowerCase()],f=e&&C.call(d.attrHandle,b.toLowerCase())?e(a,b,!p):void 0;return void 0!==f?f:c.attributes||!p?a.getAttribute(b):(f=a.getAttributeNode(b))&&f.specified?f.value:null},ga.escape=function(a){return(a+"").replace(ba,ca)},ga.error=function(a){throw new Error("Syntax error, unrecognized expression: "+a)},ga.uniqueSort=function(a){var b,d=[],e=0,f=0;if(l=!c.detectDuplicates,k=!c.sortStable&&a.slice(0),a.sort(B),l){while(b=a[f++])b===a[f]&&(e=d.push(f));while(e--)a.splice(d[e],1)}return k=null,a},e=ga.getText=function(a){var b,c="",d=0,f=a.nodeType;if(f){if(1===f||9===f||11===f){if("string"==typeof a.textContent)return a.textContent;for(a=a.firstChild;a;a=a.nextSibling)c+=e(a)}else if(3===f||4===f)return a.nodeValue}else while(b=a[d++])c+=e(b);return c},d=ga.selectors={cacheLength:50,createPseudo:ia,match:V,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(a){return a[1]=a[1].replace(_,aa),a[3]=(a[3]||a[4]||a[5]||"").replace(_,aa),"~="===a[2]&&(a[3]=" "+a[3]+" "),a.slice(0,4)},CHILD:function(a){return a[1]=a[1].toLowerCase(),"nth"===a[1].slice(0,3)?(a[3]||ga.error(a[0]),a[4]=+(a[4]?a[5]+(a[6]||1):2*("even"===a[3]||"odd"===a[3])),a[5]=+(a[7]+a[8]||"odd"===a[3])):a[3]&&ga.error(a[0]),a},PSEUDO:function(a){var b,c=!a[6]&&a[2];return V.CHILD.test(a[0])?null:(a[3]?a[2]=a[4]||a[5]||"":c&&T.test(c)&&(b=g(c,!0))&&(b=c.indexOf(")",c.length-b)-c.length)&&(a[0]=a[0].slice(0,b),a[2]=c.slice(0,b)),a.slice(0,3))}},filter:{TAG:function(a){var b=a.replace(_,aa).toLowerCase();return"*"===a?function(){return!0}:function(a){return a.nodeName&&a.nodeName.toLowerCase()===b}},CLASS:function(a){var b=y[a+" "];return b||(b=new RegExp("(^|"+K+")"+a+"("+K+"|$)"))&&y(a,function(a){return b.test("string"==typeof a.className&&a.className||"undefined"!=typeof a.getAttribute&&a.getAttribute("class")||"")})},ATTR:function(a,b,c){return function(d){var e=ga.attr(d,a);return null==e?"!="===b:!b||(e+="","="===b?e===c:"!="===b?e!==c:"^="===b?c&&0===e.indexOf(c):"*="===b?c&&e.indexOf(c)>-1:"$="===b?c&&e.slice(-c.length)===c:"~="===b?(" "+e.replace(O," ")+" ").indexOf(c)>-1:"|="===b&&(e===c||e.slice(0,c.length+1)===c+"-"))}},CHILD:function(a,b,c,d,e){var f="nth"!==a.slice(0,3),g="last"!==a.slice(-4),h="of-type"===b;return 1===d&&0===e?function(a){return!!a.parentNode}:function(b,c,i){var j,k,l,m,n,o,p=f!==g?"nextSibling":"previousSibling",q=b.parentNode,r=h&&b.nodeName.toLowerCase(),s=!i&&!h,t=!1;if(q){if(f){while(p){m=b;while(m=m[p])if(h?m.nodeName.toLowerCase()===r:1===m.nodeType)return!1;o=p="only"===a&&!o&&"nextSibling"}return!0}if(o=[g?q.firstChild:q.lastChild],g&&s){m=q,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n&&j[2],m=n&&q.childNodes[n];while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if(1===m.nodeType&&++t&&m===b){k[a]=[w,n,t];break}}else if(s&&(m=b,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n),t===!1)while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if((h?m.nodeName.toLowerCase()===r:1===m.nodeType)&&++t&&(s&&(l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),k[a]=[w,t]),m===b))break;return t-=e,t===d||t%d===0&&t/d>=0}}},PSEUDO:function(a,b){var c,e=d.pseudos[a]||d.setFilters[a.toLowerCase()]||ga.error("unsupported pseudo: "+a);return e[u]?e(b):e.length>1?(c=[a,a,"",b],d.setFilters.hasOwnProperty(a.toLowerCase())?ia(function(a,c){var d,f=e(a,b),g=f.length;while(g--)d=I(a,f[g]),a[d]=!(c[d]=f[g])}):function(a){return e(a,0,c)}):e}},pseudos:{not:ia(function(a){var b=[],c=[],d=h(a.replace(P,"$1"));return d[u]?ia(function(a,b,c,e){var f,g=d(a,null,e,[]),h=a.length;while(h--)(f=g[h])&&(a[h]=!(b[h]=f))}):function(a,e,f){return b[0]=a,d(b,null,f,c),b[0]=null,!c.pop()}}),has:ia(function(a){return function(b){return ga(a,b).length>0}}),contains:ia(function(a){return a=a.replace(_,aa),function(b){return(b.textContent||b.innerText||e(b)).indexOf(a)>-1}}),lang:ia(function(a){return U.test(a||"")||ga.error("unsupported lang: "+a),a=a.replace(_,aa).toLowerCase(),function(b){var c;do if(c=p?b.lang:b.getAttribute("xml:lang")||b.getAttribute("lang"))return c=c.toLowerCase(),c===a||0===c.indexOf(a+"-");while((b=b.parentNode)&&1===b.nodeType);return!1}}),target:function(b){var c=a.location&&a.location.hash;return c&&c.slice(1)===b.id},root:function(a){return a===o},focus:function(a){return a===n.activeElement&&(!n.hasFocus||n.hasFocus())&&!!(a.type||a.href||~a.tabIndex)},enabled:oa(!1),disabled:oa(!0),checked:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&!!a.checked||"option"===b&&!!a.selected},selected:function(a){return a.parentNode&&a.parentNode.selectedIndex,a.selected===!0},empty:function(a){for(a=a.firstChild;a;a=a.nextSibling)if(a.nodeType<6)return!1;return!0},parent:function(a){return!d.pseudos.empty(a)},header:function(a){return X.test(a.nodeName)},input:function(a){return W.test(a.nodeName)},button:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&"button"===a.type||"button"===b},text:function(a){var b;return"input"===a.nodeName.toLowerCase()&&"text"===a.type&&(null==(b=a.getAttribute("type"))||"text"===b.toLowerCase())},first:pa(function(){return[0]}),last:pa(function(a,b){return[b-1]}),eq:pa(function(a,b,c){return[c<0?c+b:c]}),even:pa(function(a,b){for(var c=0;c=0;)a.push(d);return a}),gt:pa(function(a,b,c){for(var d=c<0?c+b:c;++d1?function(b,c,d){var e=a.length;while(e--)if(!a[e](b,c,d))return!1;return!0}:a[0]}function va(a,b,c){for(var d=0,e=b.length;d-1&&(f[j]=!(g[j]=l))}}else r=wa(r===g?r.splice(o,r.length):r),e?e(null,g,r,i):G.apply(g,r)})}function ya(a){for(var b,c,e,f=a.length,g=d.relative[a[0].type],h=g||d.relative[" "],i=g?1:0,k=ta(function(a){return a===b},h,!0),l=ta(function(a){return I(b,a)>-1},h,!0),m=[function(a,c,d){var e=!g&&(d||c!==j)||((b=c).nodeType?k(a,c,d):l(a,c,d));return b=null,e}];i1&&ua(m),i>1&&sa(a.slice(0,i-1).concat({value:" "===a[i-2].type?"*":""})).replace(P,"$1"),c,i0,e=a.length>0,f=function(f,g,h,i,k){var l,o,q,r=0,s="0",t=f&&[],u=[],v=j,x=f||e&&d.find.TAG("*",k),y=w+=null==v?1:Math.random()||.1,z=x.length;for(k&&(j=g===n||g||k);s!==z&&null!=(l=x[s]);s++){if(e&&l){o=0,g||l.ownerDocument===n||(m(l),h=!p);while(q=a[o++])if(q(l,g||n,h)){i.push(l);break}k&&(w=y)}c&&((l=!q&&l)&&r--,f&&t.push(l))}if(r+=s,c&&s!==r){o=0;while(q=b[o++])q(t,u,g,h);if(f){if(r>0)while(s--)t[s]||u[s]||(u[s]=E.call(i));u=wa(u)}G.apply(i,u),k&&!f&&u.length>0&&r+b.length>1&&ga.uniqueSort(i)}return k&&(w=y,j=v),t};return c?ia(f):f}return h=ga.compile=function(a,b){var c,d=[],e=[],f=A[a+" "];if(!f){b||(b=g(a)),c=b.length;while(c--)f=ya(b[c]),f[u]?d.push(f):e.push(f);f=A(a,za(e,d)),f.selector=a}return f},i=ga.select=function(a,b,c,e){var f,i,j,k,l,m="function"==typeof a&&a,n=!e&&g(a=m.selector||a);if(c=c||[],1===n.length){if(i=n[0]=n[0].slice(0),i.length>2&&"ID"===(j=i[0]).type&&9===b.nodeType&&p&&d.relative[i[1].type]){if(b=(d.find.ID(j.matches[0].replace(_,aa),b)||[])[0],!b)return c;m&&(b=b.parentNode),a=a.slice(i.shift().value.length)}f=V.needsContext.test(a)?0:i.length;while(f--){if(j=i[f],d.relative[k=j.type])break;if((l=d.find[k])&&(e=l(j.matches[0].replace(_,aa),$.test(i[0].type)&&qa(b.parentNode)||b))){if(i.splice(f,1),a=e.length&&sa(i),!a)return G.apply(c,e),c;break}}}return(m||h(a,n))(e,b,!p,c,!b||$.test(a)&&qa(b.parentNode)||b),c},c.sortStable=u.split("").sort(B).join("")===u,c.detectDuplicates=!!l,m(),c.sortDetached=ja(function(a){return 1&a.compareDocumentPosition(n.createElement("fieldset"))}),ja(function(a){return a.innerHTML="","#"===a.firstChild.getAttribute("href")})||ka("type|href|height|width",function(a,b,c){if(!c)return a.getAttribute(b,"type"===b.toLowerCase()?1:2)}),c.attributes&&ja(function(a){return a.innerHTML="",a.firstChild.setAttribute("value",""),""===a.firstChild.getAttribute("value")})||ka("value",function(a,b,c){if(!c&&"input"===a.nodeName.toLowerCase())return a.defaultValue}),ja(function(a){return null==a.getAttribute("disabled")})||ka(J,function(a,b,c){var d;if(!c)return a[b]===!0?b.toLowerCase():(d=a.getAttributeNode(b))&&d.specified?d.value:null}),ga}(a);r.find=x,r.expr=x.selectors,r.expr[":"]=r.expr.pseudos,r.uniqueSort=r.unique=x.uniqueSort,r.text=x.getText,r.isXMLDoc=x.isXML,r.contains=x.contains,r.escapeSelector=x.escape;var y=function(a,b,c){var d=[],e=void 0!==c;while((a=a[b])&&9!==a.nodeType)if(1===a.nodeType){if(e&&r(a).is(c))break;d.push(a)}return d},z=function(a,b){for(var c=[];a;a=a.nextSibling)1===a.nodeType&&a!==b&&c.push(a);return c},A=r.expr.match.needsContext;function B(a,b){return a.nodeName&&a.nodeName.toLowerCase()===b.toLowerCase()}var C=/^<([a-z][^\/\0>:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i,D=/^.[^:#\[\.,]*$/;function E(a,b,c){return r.isFunction(b)?r.grep(a,function(a,d){return!!b.call(a,d,a)!==c}):b.nodeType?r.grep(a,function(a){return a===b!==c}):"string"!=typeof b?r.grep(a,function(a){return i.call(b,a)>-1!==c}):D.test(b)?r.filter(b,a,c):(b=r.filter(b,a),r.grep(a,function(a){return i.call(b,a)>-1!==c&&1===a.nodeType}))}r.filter=function(a,b,c){var d=b[0];return c&&(a=":not("+a+")"),1===b.length&&1===d.nodeType?r.find.matchesSelector(d,a)?[d]:[]:r.find.matches(a,r.grep(b,function(a){return 1===a.nodeType}))},r.fn.extend({find:function(a){var b,c,d=this.length,e=this;if("string"!=typeof a)return this.pushStack(r(a).filter(function(){for(b=0;b1?r.uniqueSort(c):c},filter:function(a){return this.pushStack(E(this,a||[],!1))},not:function(a){return this.pushStack(E(this,a||[],!0))},is:function(a){return!!E(this,"string"==typeof a&&A.test(a)?r(a):a||[],!1).length}});var F,G=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]+))$/,H=r.fn.init=function(a,b,c){var e,f;if(!a)return this;if(c=c||F,"string"==typeof a){if(e="<"===a[0]&&">"===a[a.length-1]&&a.length>=3?[null,a,null]:G.exec(a),!e||!e[1]&&b)return!b||b.jquery?(b||c).find(a):this.constructor(b).find(a);if(e[1]){if(b=b instanceof r?b[0]:b,r.merge(this,r.parseHTML(e[1],b&&b.nodeType?b.ownerDocument||b:d,!0)),C.test(e[1])&&r.isPlainObject(b))for(e in b)r.isFunction(this[e])?this[e](b[e]):this.attr(e,b[e]);return this}return f=d.getElementById(e[2]),f&&(this[0]=f,this.length=1),this}return a.nodeType?(this[0]=a,this.length=1,this):r.isFunction(a)?void 0!==c.ready?c.ready(a):a(r):r.makeArray(a,this)};H.prototype=r.fn,F=r(d);var I=/^(?:parents|prev(?:Until|All))/,J={children:!0,contents:!0,next:!0,prev:!0};r.fn.extend({has:function(a){var b=r(a,this),c=b.length;return this.filter(function(){for(var a=0;a-1:1===c.nodeType&&r.find.matchesSelector(c,a))){f.push(c);break}return this.pushStack(f.length>1?r.uniqueSort(f):f)},index:function(a){return a?"string"==typeof a?i.call(r(a),this[0]):i.call(this,a.jquery?a[0]:a):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(a,b){return this.pushStack(r.uniqueSort(r.merge(this.get(),r(a,b))))},addBack:function(a){return this.add(null==a?this.prevObject:this.prevObject.filter(a))}});function K(a,b){while((a=a[b])&&1!==a.nodeType);return a}r.each({parent:function(a){var b=a.parentNode;return b&&11!==b.nodeType?b:null},parents:function(a){return y(a,"parentNode")},parentsUntil:function(a,b,c){return y(a,"parentNode",c)},next:function(a){return K(a,"nextSibling")},prev:function(a){return K(a,"previousSibling")},nextAll:function(a){return y(a,"nextSibling")},prevAll:function(a){return y(a,"previousSibling")},nextUntil:function(a,b,c){return y(a,"nextSibling",c)},prevUntil:function(a,b,c){return y(a,"previousSibling",c)},siblings:function(a){return z((a.parentNode||{}).firstChild,a)},children:function(a){return z(a.firstChild)},contents:function(a){return B(a,"iframe")?a.contentDocument:(B(a,"template")&&(a=a.content||a),r.merge([],a.childNodes))}},function(a,b){r.fn[a]=function(c,d){var e=r.map(this,b,c);return"Until"!==a.slice(-5)&&(d=c),d&&"string"==typeof d&&(e=r.filter(d,e)),this.length>1&&(J[a]||r.uniqueSort(e),I.test(a)&&e.reverse()),this.pushStack(e)}});var L=/[^\x20\t\r\n\f]+/g;function M(a){var b={};return r.each(a.match(L)||[],function(a,c){b[c]=!0}),b}r.Callbacks=function(a){a="string"==typeof a?M(a):r.extend({},a);var b,c,d,e,f=[],g=[],h=-1,i=function(){for(e=e||a.once,d=b=!0;g.length;h=-1){c=g.shift();while(++h-1)f.splice(c,1),c<=h&&h--}),this},has:function(a){return a?r.inArray(a,f)>-1:f.length>0},empty:function(){return f&&(f=[]),this},disable:function(){return e=g=[],f=c="",this},disabled:function(){return!f},lock:function(){return e=g=[],c||b||(f=c=""),this},locked:function(){return!!e},fireWith:function(a,c){return e||(c=c||[],c=[a,c.slice?c.slice():c],g.push(c),b||i()),this},fire:function(){return j.fireWith(this,arguments),this},fired:function(){return!!d}};return j};function N(a){return a}function O(a){throw a}function P(a,b,c,d){var e;try{a&&r.isFunction(e=a.promise)?e.call(a).done(b).fail(c):a&&r.isFunction(e=a.then)?e.call(a,b,c):b.apply(void 0,[a].slice(d))}catch(a){c.apply(void 0,[a])}}r.extend({Deferred:function(b){var c=[["notify","progress",r.Callbacks("memory"),r.Callbacks("memory"),2],["resolve","done",r.Callbacks("once memory"),r.Callbacks("once memory"),0,"resolved"],["reject","fail",r.Callbacks("once memory"),r.Callbacks("once memory"),1,"rejected"]],d="pending",e={state:function(){return d},always:function(){return f.done(arguments).fail(arguments),this},"catch":function(a){return e.then(null,a)},pipe:function(){var a=arguments;return r.Deferred(function(b){r.each(c,function(c,d){var e=r.isFunction(a[d[4]])&&a[d[4]];f[d[1]](function(){var a=e&&e.apply(this,arguments);a&&r.isFunction(a.promise)?a.promise().progress(b.notify).done(b.resolve).fail(b.reject):b[d[0]+"With"](this,e?[a]:arguments)})}),a=null}).promise()},then:function(b,d,e){var f=0;function g(b,c,d,e){return function(){var h=this,i=arguments,j=function(){var a,j;if(!(b=f&&(d!==O&&(h=void 0,i=[a]),c.rejectWith(h,i))}};b?k():(r.Deferred.getStackHook&&(k.stackTrace=r.Deferred.getStackHook()),a.setTimeout(k))}}return r.Deferred(function(a){c[0][3].add(g(0,a,r.isFunction(e)?e:N,a.notifyWith)),c[1][3].add(g(0,a,r.isFunction(b)?b:N)),c[2][3].add(g(0,a,r.isFunction(d)?d:O))}).promise()},promise:function(a){return null!=a?r.extend(a,e):e}},f={};return r.each(c,function(a,b){var g=b[2],h=b[5];e[b[1]]=g.add,h&&g.add(function(){d=h},c[3-a][2].disable,c[0][2].lock),g.add(b[3].fire),f[b[0]]=function(){return f[b[0]+"With"](this===f?void 0:this,arguments),this},f[b[0]+"With"]=g.fireWith}),e.promise(f),b&&b.call(f,f),f},when:function(a){var b=arguments.length,c=b,d=Array(c),e=f.call(arguments),g=r.Deferred(),h=function(a){return function(c){d[a]=this,e[a]=arguments.length>1?f.call(arguments):c,--b||g.resolveWith(d,e)}};if(b<=1&&(P(a,g.done(h(c)).resolve,g.reject,!b),"pending"===g.state()||r.isFunction(e[c]&&e[c].then)))return g.then();while(c--)P(e[c],h(c),g.reject);return g.promise()}});var Q=/^(Eval|Internal|Range|Reference|Syntax|Type|URI)Error$/;r.Deferred.exceptionHook=function(b,c){a.console&&a.console.warn&&b&&Q.test(b.name)&&a.console.warn("jQuery.Deferred exception: "+b.message,b.stack,c)},r.readyException=function(b){a.setTimeout(function(){throw b})};var R=r.Deferred();r.fn.ready=function(a){return R.then(a)["catch"](function(a){r.readyException(a)}),this},r.extend({isReady:!1,readyWait:1,ready:function(a){(a===!0?--r.readyWait:r.isReady)||(r.isReady=!0,a!==!0&&--r.readyWait>0||R.resolveWith(d,[r]))}}),r.ready.then=R.then;function S(){d.removeEventListener("DOMContentLoaded",S), +a.removeEventListener("load",S),r.ready()}"complete"===d.readyState||"loading"!==d.readyState&&!d.documentElement.doScroll?a.setTimeout(r.ready):(d.addEventListener("DOMContentLoaded",S),a.addEventListener("load",S));var T=function(a,b,c,d,e,f,g){var h=0,i=a.length,j=null==c;if("object"===r.type(c)){e=!0;for(h in c)T(a,b,h,c[h],!0,f,g)}else if(void 0!==d&&(e=!0,r.isFunction(d)||(g=!0),j&&(g?(b.call(a,d),b=null):(j=b,b=function(a,b,c){return j.call(r(a),c)})),b))for(;h1,null,!0)},removeData:function(a){return this.each(function(){X.remove(this,a)})}}),r.extend({queue:function(a,b,c){var d;if(a)return b=(b||"fx")+"queue",d=W.get(a,b),c&&(!d||Array.isArray(c)?d=W.access(a,b,r.makeArray(c)):d.push(c)),d||[]},dequeue:function(a,b){b=b||"fx";var c=r.queue(a,b),d=c.length,e=c.shift(),f=r._queueHooks(a,b),g=function(){r.dequeue(a,b)};"inprogress"===e&&(e=c.shift(),d--),e&&("fx"===b&&c.unshift("inprogress"),delete f.stop,e.call(a,g,f)),!d&&f&&f.empty.fire()},_queueHooks:function(a,b){var c=b+"queueHooks";return W.get(a,c)||W.access(a,c,{empty:r.Callbacks("once memory").add(function(){W.remove(a,[b+"queue",c])})})}}),r.fn.extend({queue:function(a,b){var c=2;return"string"!=typeof a&&(b=a,a="fx",c--),arguments.length\x20\t\r\n\f]+)/i,la=/^$|\/(?:java|ecma)script/i,ma={option:[1,""],thead:[1,"","
        "],col:[2,"","
        "],tr:[2,"","
        "],td:[3,"","
        "],_default:[0,"",""]};ma.optgroup=ma.option,ma.tbody=ma.tfoot=ma.colgroup=ma.caption=ma.thead,ma.th=ma.td;function na(a,b){var c;return c="undefined"!=typeof a.getElementsByTagName?a.getElementsByTagName(b||"*"):"undefined"!=typeof a.querySelectorAll?a.querySelectorAll(b||"*"):[],void 0===b||b&&B(a,b)?r.merge([a],c):c}function oa(a,b){for(var c=0,d=a.length;c-1)e&&e.push(f);else if(j=r.contains(f.ownerDocument,f),g=na(l.appendChild(f),"script"),j&&oa(g),c){k=0;while(f=g[k++])la.test(f.type||"")&&c.push(f)}return l}!function(){var a=d.createDocumentFragment(),b=a.appendChild(d.createElement("div")),c=d.createElement("input");c.setAttribute("type","radio"),c.setAttribute("checked","checked"),c.setAttribute("name","t"),b.appendChild(c),o.checkClone=b.cloneNode(!0).cloneNode(!0).lastChild.checked,b.innerHTML="",o.noCloneChecked=!!b.cloneNode(!0).lastChild.defaultValue}();var ra=d.documentElement,sa=/^key/,ta=/^(?:mouse|pointer|contextmenu|drag|drop)|click/,ua=/^([^.]*)(?:\.(.+)|)/;function va(){return!0}function wa(){return!1}function xa(){try{return d.activeElement}catch(a){}}function ya(a,b,c,d,e,f){var g,h;if("object"==typeof b){"string"!=typeof c&&(d=d||c,c=void 0);for(h in b)ya(a,h,c,d,b[h],f);return a}if(null==d&&null==e?(e=c,d=c=void 0):null==e&&("string"==typeof c?(e=d,d=void 0):(e=d,d=c,c=void 0)),e===!1)e=wa;else if(!e)return a;return 1===f&&(g=e,e=function(a){return r().off(a),g.apply(this,arguments)},e.guid=g.guid||(g.guid=r.guid++)),a.each(function(){r.event.add(this,b,e,d,c)})}r.event={global:{},add:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.get(a);if(q){c.handler&&(f=c,c=f.handler,e=f.selector),e&&r.find.matchesSelector(ra,e),c.guid||(c.guid=r.guid++),(i=q.events)||(i=q.events={}),(g=q.handle)||(g=q.handle=function(b){return"undefined"!=typeof r&&r.event.triggered!==b.type?r.event.dispatch.apply(a,arguments):void 0}),b=(b||"").match(L)||[""],j=b.length;while(j--)h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n&&(l=r.event.special[n]||{},n=(e?l.delegateType:l.bindType)||n,l=r.event.special[n]||{},k=r.extend({type:n,origType:p,data:d,handler:c,guid:c.guid,selector:e,needsContext:e&&r.expr.match.needsContext.test(e),namespace:o.join(".")},f),(m=i[n])||(m=i[n]=[],m.delegateCount=0,l.setup&&l.setup.call(a,d,o,g)!==!1||a.addEventListener&&a.addEventListener(n,g)),l.add&&(l.add.call(a,k),k.handler.guid||(k.handler.guid=c.guid)),e?m.splice(m.delegateCount++,0,k):m.push(k),r.event.global[n]=!0)}},remove:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.hasData(a)&&W.get(a);if(q&&(i=q.events)){b=(b||"").match(L)||[""],j=b.length;while(j--)if(h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n){l=r.event.special[n]||{},n=(d?l.delegateType:l.bindType)||n,m=i[n]||[],h=h[2]&&new RegExp("(^|\\.)"+o.join("\\.(?:.*\\.|)")+"(\\.|$)"),g=f=m.length;while(f--)k=m[f],!e&&p!==k.origType||c&&c.guid!==k.guid||h&&!h.test(k.namespace)||d&&d!==k.selector&&("**"!==d||!k.selector)||(m.splice(f,1),k.selector&&m.delegateCount--,l.remove&&l.remove.call(a,k));g&&!m.length&&(l.teardown&&l.teardown.call(a,o,q.handle)!==!1||r.removeEvent(a,n,q.handle),delete i[n])}else for(n in i)r.event.remove(a,n+b[j],c,d,!0);r.isEmptyObject(i)&&W.remove(a,"handle events")}},dispatch:function(a){var b=r.event.fix(a),c,d,e,f,g,h,i=new Array(arguments.length),j=(W.get(this,"events")||{})[b.type]||[],k=r.event.special[b.type]||{};for(i[0]=b,c=1;c=1))for(;j!==this;j=j.parentNode||this)if(1===j.nodeType&&("click"!==a.type||j.disabled!==!0)){for(f=[],g={},c=0;c-1:r.find(e,this,null,[j]).length),g[e]&&f.push(d);f.length&&h.push({elem:j,handlers:f})}return j=this,i\x20\t\r\n\f]*)[^>]*)\/>/gi,Aa=/\s*$/g;function Ea(a,b){return B(a,"table")&&B(11!==b.nodeType?b:b.firstChild,"tr")?r(">tbody",a)[0]||a:a}function Fa(a){return a.type=(null!==a.getAttribute("type"))+"/"+a.type,a}function Ga(a){var b=Ca.exec(a.type);return b?a.type=b[1]:a.removeAttribute("type"),a}function Ha(a,b){var c,d,e,f,g,h,i,j;if(1===b.nodeType){if(W.hasData(a)&&(f=W.access(a),g=W.set(b,f),j=f.events)){delete g.handle,g.events={};for(e in j)for(c=0,d=j[e].length;c1&&"string"==typeof q&&!o.checkClone&&Ba.test(q))return a.each(function(e){var f=a.eq(e);s&&(b[0]=q.call(this,e,f.html())),Ja(f,b,c,d)});if(m&&(e=qa(b,a[0].ownerDocument,!1,a,d),f=e.firstChild,1===e.childNodes.length&&(e=f),f||d)){for(h=r.map(na(e,"script"),Fa),i=h.length;l")},clone:function(a,b,c){var d,e,f,g,h=a.cloneNode(!0),i=r.contains(a.ownerDocument,a);if(!(o.noCloneChecked||1!==a.nodeType&&11!==a.nodeType||r.isXMLDoc(a)))for(g=na(h),f=na(a),d=0,e=f.length;d0&&oa(g,!i&&na(a,"script")),h},cleanData:function(a){for(var b,c,d,e=r.event.special,f=0;void 0!==(c=a[f]);f++)if(U(c)){if(b=c[W.expando]){if(b.events)for(d in b.events)e[d]?r.event.remove(c,d):r.removeEvent(c,d,b.handle);c[W.expando]=void 0}c[X.expando]&&(c[X.expando]=void 0)}}}),r.fn.extend({detach:function(a){return Ka(this,a,!0)},remove:function(a){return Ka(this,a)},text:function(a){return T(this,function(a){return void 0===a?r.text(this):this.empty().each(function(){1!==this.nodeType&&11!==this.nodeType&&9!==this.nodeType||(this.textContent=a)})},null,a,arguments.length)},append:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.appendChild(a)}})},prepend:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.insertBefore(a,b.firstChild)}})},before:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this)})},after:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this.nextSibling)})},empty:function(){for(var a,b=0;null!=(a=this[b]);b++)1===a.nodeType&&(r.cleanData(na(a,!1)),a.textContent="");return this},clone:function(a,b){return a=null!=a&&a,b=null==b?a:b,this.map(function(){return r.clone(this,a,b)})},html:function(a){return T(this,function(a){var b=this[0]||{},c=0,d=this.length;if(void 0===a&&1===b.nodeType)return b.innerHTML;if("string"==typeof a&&!Aa.test(a)&&!ma[(ka.exec(a)||["",""])[1].toLowerCase()]){a=r.htmlPrefilter(a);try{for(;c1)}});function _a(a,b,c,d,e){return new _a.prototype.init(a,b,c,d,e)}r.Tween=_a,_a.prototype={constructor:_a,init:function(a,b,c,d,e,f){this.elem=a,this.prop=c,this.easing=e||r.easing._default,this.options=b,this.start=this.now=this.cur(),this.end=d,this.unit=f||(r.cssNumber[c]?"":"px")},cur:function(){var a=_a.propHooks[this.prop];return a&&a.get?a.get(this):_a.propHooks._default.get(this)},run:function(a){var b,c=_a.propHooks[this.prop];return this.options.duration?this.pos=b=r.easing[this.easing](a,this.options.duration*a,0,1,this.options.duration):this.pos=b=a,this.now=(this.end-this.start)*b+this.start,this.options.step&&this.options.step.call(this.elem,this.now,this),c&&c.set?c.set(this):_a.propHooks._default.set(this),this}},_a.prototype.init.prototype=_a.prototype,_a.propHooks={_default:{get:function(a){var b;return 1!==a.elem.nodeType||null!=a.elem[a.prop]&&null==a.elem.style[a.prop]?a.elem[a.prop]:(b=r.css(a.elem,a.prop,""),b&&"auto"!==b?b:0)},set:function(a){r.fx.step[a.prop]?r.fx.step[a.prop](a):1!==a.elem.nodeType||null==a.elem.style[r.cssProps[a.prop]]&&!r.cssHooks[a.prop]?a.elem[a.prop]=a.now:r.style(a.elem,a.prop,a.now+a.unit)}}},_a.propHooks.scrollTop=_a.propHooks.scrollLeft={set:function(a){a.elem.nodeType&&a.elem.parentNode&&(a.elem[a.prop]=a.now)}},r.easing={linear:function(a){return a},swing:function(a){return.5-Math.cos(a*Math.PI)/2},_default:"swing"},r.fx=_a.prototype.init,r.fx.step={};var ab,bb,cb=/^(?:toggle|show|hide)$/,db=/queueHooks$/;function eb(){bb&&(d.hidden===!1&&a.requestAnimationFrame?a.requestAnimationFrame(eb):a.setTimeout(eb,r.fx.interval),r.fx.tick())}function fb(){return a.setTimeout(function(){ab=void 0}),ab=r.now()}function gb(a,b){var c,d=0,e={height:a};for(b=b?1:0;d<4;d+=2-b)c=ca[d],e["margin"+c]=e["padding"+c]=a;return b&&(e.opacity=e.width=a),e}function hb(a,b,c){for(var d,e=(kb.tweeners[b]||[]).concat(kb.tweeners["*"]),f=0,g=e.length;f1)},removeAttr:function(a){return this.each(function(){r.removeAttr(this,a)})}}),r.extend({attr:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return"undefined"==typeof a.getAttribute?r.prop(a,b,c):(1===f&&r.isXMLDoc(a)||(e=r.attrHooks[b.toLowerCase()]||(r.expr.match.bool.test(b)?lb:void 0)),void 0!==c?null===c?void r.removeAttr(a,b):e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:(a.setAttribute(b,c+""),c):e&&"get"in e&&null!==(d=e.get(a,b))?d:(d=r.find.attr(a,b), +null==d?void 0:d))},attrHooks:{type:{set:function(a,b){if(!o.radioValue&&"radio"===b&&B(a,"input")){var c=a.value;return a.setAttribute("type",b),c&&(a.value=c),b}}}},removeAttr:function(a,b){var c,d=0,e=b&&b.match(L);if(e&&1===a.nodeType)while(c=e[d++])a.removeAttribute(c)}}),lb={set:function(a,b,c){return b===!1?r.removeAttr(a,c):a.setAttribute(c,c),c}},r.each(r.expr.match.bool.source.match(/\w+/g),function(a,b){var c=mb[b]||r.find.attr;mb[b]=function(a,b,d){var e,f,g=b.toLowerCase();return d||(f=mb[g],mb[g]=e,e=null!=c(a,b,d)?g:null,mb[g]=f),e}});var nb=/^(?:input|select|textarea|button)$/i,ob=/^(?:a|area)$/i;r.fn.extend({prop:function(a,b){return T(this,r.prop,a,b,arguments.length>1)},removeProp:function(a){return this.each(function(){delete this[r.propFix[a]||a]})}}),r.extend({prop:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return 1===f&&r.isXMLDoc(a)||(b=r.propFix[b]||b,e=r.propHooks[b]),void 0!==c?e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:a[b]=c:e&&"get"in e&&null!==(d=e.get(a,b))?d:a[b]},propHooks:{tabIndex:{get:function(a){var b=r.find.attr(a,"tabindex");return b?parseInt(b,10):nb.test(a.nodeName)||ob.test(a.nodeName)&&a.href?0:-1}}},propFix:{"for":"htmlFor","class":"className"}}),o.optSelected||(r.propHooks.selected={get:function(a){var b=a.parentNode;return b&&b.parentNode&&b.parentNode.selectedIndex,null},set:function(a){var b=a.parentNode;b&&(b.selectedIndex,b.parentNode&&b.parentNode.selectedIndex)}}),r.each(["tabIndex","readOnly","maxLength","cellSpacing","cellPadding","rowSpan","colSpan","useMap","frameBorder","contentEditable"],function(){r.propFix[this.toLowerCase()]=this});function pb(a){var b=a.match(L)||[];return b.join(" ")}function qb(a){return a.getAttribute&&a.getAttribute("class")||""}r.fn.extend({addClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).addClass(a.call(this,b,qb(this)))});if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])d.indexOf(" "+f+" ")<0&&(d+=f+" ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},removeClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).removeClass(a.call(this,b,qb(this)))});if(!arguments.length)return this.attr("class","");if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])while(d.indexOf(" "+f+" ")>-1)d=d.replace(" "+f+" "," ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},toggleClass:function(a,b){var c=typeof a;return"boolean"==typeof b&&"string"===c?b?this.addClass(a):this.removeClass(a):r.isFunction(a)?this.each(function(c){r(this).toggleClass(a.call(this,c,qb(this),b),b)}):this.each(function(){var b,d,e,f;if("string"===c){d=0,e=r(this),f=a.match(L)||[];while(b=f[d++])e.hasClass(b)?e.removeClass(b):e.addClass(b)}else void 0!==a&&"boolean"!==c||(b=qb(this),b&&W.set(this,"__className__",b),this.setAttribute&&this.setAttribute("class",b||a===!1?"":W.get(this,"__className__")||""))})},hasClass:function(a){var b,c,d=0;b=" "+a+" ";while(c=this[d++])if(1===c.nodeType&&(" "+pb(qb(c))+" ").indexOf(b)>-1)return!0;return!1}});var rb=/\r/g;r.fn.extend({val:function(a){var b,c,d,e=this[0];{if(arguments.length)return d=r.isFunction(a),this.each(function(c){var e;1===this.nodeType&&(e=d?a.call(this,c,r(this).val()):a,null==e?e="":"number"==typeof e?e+="":Array.isArray(e)&&(e=r.map(e,function(a){return null==a?"":a+""})),b=r.valHooks[this.type]||r.valHooks[this.nodeName.toLowerCase()],b&&"set"in b&&void 0!==b.set(this,e,"value")||(this.value=e))});if(e)return b=r.valHooks[e.type]||r.valHooks[e.nodeName.toLowerCase()],b&&"get"in b&&void 0!==(c=b.get(e,"value"))?c:(c=e.value,"string"==typeof c?c.replace(rb,""):null==c?"":c)}}}),r.extend({valHooks:{option:{get:function(a){var b=r.find.attr(a,"value");return null!=b?b:pb(r.text(a))}},select:{get:function(a){var b,c,d,e=a.options,f=a.selectedIndex,g="select-one"===a.type,h=g?null:[],i=g?f+1:e.length;for(d=f<0?i:g?f:0;d-1)&&(c=!0);return c||(a.selectedIndex=-1),f}}}}),r.each(["radio","checkbox"],function(){r.valHooks[this]={set:function(a,b){if(Array.isArray(b))return a.checked=r.inArray(r(a).val(),b)>-1}},o.checkOn||(r.valHooks[this].get=function(a){return null===a.getAttribute("value")?"on":a.value})});var sb=/^(?:focusinfocus|focusoutblur)$/;r.extend(r.event,{trigger:function(b,c,e,f){var g,h,i,j,k,m,n,o=[e||d],p=l.call(b,"type")?b.type:b,q=l.call(b,"namespace")?b.namespace.split("."):[];if(h=i=e=e||d,3!==e.nodeType&&8!==e.nodeType&&!sb.test(p+r.event.triggered)&&(p.indexOf(".")>-1&&(q=p.split("."),p=q.shift(),q.sort()),k=p.indexOf(":")<0&&"on"+p,b=b[r.expando]?b:new r.Event(p,"object"==typeof b&&b),b.isTrigger=f?2:3,b.namespace=q.join("."),b.rnamespace=b.namespace?new RegExp("(^|\\.)"+q.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,b.result=void 0,b.target||(b.target=e),c=null==c?[b]:r.makeArray(c,[b]),n=r.event.special[p]||{},f||!n.trigger||n.trigger.apply(e,c)!==!1)){if(!f&&!n.noBubble&&!r.isWindow(e)){for(j=n.delegateType||p,sb.test(j+p)||(h=h.parentNode);h;h=h.parentNode)o.push(h),i=h;i===(e.ownerDocument||d)&&o.push(i.defaultView||i.parentWindow||a)}g=0;while((h=o[g++])&&!b.isPropagationStopped())b.type=g>1?j:n.bindType||p,m=(W.get(h,"events")||{})[b.type]&&W.get(h,"handle"),m&&m.apply(h,c),m=k&&h[k],m&&m.apply&&U(h)&&(b.result=m.apply(h,c),b.result===!1&&b.preventDefault());return b.type=p,f||b.isDefaultPrevented()||n._default&&n._default.apply(o.pop(),c)!==!1||!U(e)||k&&r.isFunction(e[p])&&!r.isWindow(e)&&(i=e[k],i&&(e[k]=null),r.event.triggered=p,e[p](),r.event.triggered=void 0,i&&(e[k]=i)),b.result}},simulate:function(a,b,c){var d=r.extend(new r.Event,c,{type:a,isSimulated:!0});r.event.trigger(d,null,b)}}),r.fn.extend({trigger:function(a,b){return this.each(function(){r.event.trigger(a,b,this)})},triggerHandler:function(a,b){var c=this[0];if(c)return r.event.trigger(a,b,c,!0)}}),r.each("blur focus focusin focusout resize scroll click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup contextmenu".split(" "),function(a,b){r.fn[b]=function(a,c){return arguments.length>0?this.on(b,null,a,c):this.trigger(b)}}),r.fn.extend({hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}}),o.focusin="onfocusin"in a,o.focusin||r.each({focus:"focusin",blur:"focusout"},function(a,b){var c=function(a){r.event.simulate(b,a.target,r.event.fix(a))};r.event.special[b]={setup:function(){var d=this.ownerDocument||this,e=W.access(d,b);e||d.addEventListener(a,c,!0),W.access(d,b,(e||0)+1)},teardown:function(){var d=this.ownerDocument||this,e=W.access(d,b)-1;e?W.access(d,b,e):(d.removeEventListener(a,c,!0),W.remove(d,b))}}});var tb=a.location,ub=r.now(),vb=/\?/;r.parseXML=function(b){var c;if(!b||"string"!=typeof b)return null;try{c=(new a.DOMParser).parseFromString(b,"text/xml")}catch(d){c=void 0}return c&&!c.getElementsByTagName("parsererror").length||r.error("Invalid XML: "+b),c};var wb=/\[\]$/,xb=/\r?\n/g,yb=/^(?:submit|button|image|reset|file)$/i,zb=/^(?:input|select|textarea|keygen)/i;function Ab(a,b,c,d){var e;if(Array.isArray(b))r.each(b,function(b,e){c||wb.test(a)?d(a,e):Ab(a+"["+("object"==typeof e&&null!=e?b:"")+"]",e,c,d)});else if(c||"object"!==r.type(b))d(a,b);else for(e in b)Ab(a+"["+e+"]",b[e],c,d)}r.param=function(a,b){var c,d=[],e=function(a,b){var c=r.isFunction(b)?b():b;d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(null==c?"":c)};if(Array.isArray(a)||a.jquery&&!r.isPlainObject(a))r.each(a,function(){e(this.name,this.value)});else for(c in a)Ab(c,a[c],b,e);return d.join("&")},r.fn.extend({serialize:function(){return r.param(this.serializeArray())},serializeArray:function(){return this.map(function(){var a=r.prop(this,"elements");return a?r.makeArray(a):this}).filter(function(){var a=this.type;return this.name&&!r(this).is(":disabled")&&zb.test(this.nodeName)&&!yb.test(a)&&(this.checked||!ja.test(a))}).map(function(a,b){var c=r(this).val();return null==c?null:Array.isArray(c)?r.map(c,function(a){return{name:b.name,value:a.replace(xb,"\r\n")}}):{name:b.name,value:c.replace(xb,"\r\n")}}).get()}});var Bb=/%20/g,Cb=/#.*$/,Db=/([?&])_=[^&]*/,Eb=/^(.*?):[ \t]*([^\r\n]*)$/gm,Fb=/^(?:about|app|app-storage|.+-extension|file|res|widget):$/,Gb=/^(?:GET|HEAD)$/,Hb=/^\/\//,Ib={},Jb={},Kb="*/".concat("*"),Lb=d.createElement("a");Lb.href=tb.href;function Mb(a){return function(b,c){"string"!=typeof b&&(c=b,b="*");var d,e=0,f=b.toLowerCase().match(L)||[];if(r.isFunction(c))while(d=f[e++])"+"===d[0]?(d=d.slice(1)||"*",(a[d]=a[d]||[]).unshift(c)):(a[d]=a[d]||[]).push(c)}}function Nb(a,b,c,d){var e={},f=a===Jb;function g(h){var i;return e[h]=!0,r.each(a[h]||[],function(a,h){var j=h(b,c,d);return"string"!=typeof j||f||e[j]?f?!(i=j):void 0:(b.dataTypes.unshift(j),g(j),!1)}),i}return g(b.dataTypes[0])||!e["*"]&&g("*")}function Ob(a,b){var c,d,e=r.ajaxSettings.flatOptions||{};for(c in b)void 0!==b[c]&&((e[c]?a:d||(d={}))[c]=b[c]);return d&&r.extend(!0,a,d),a}function Pb(a,b,c){var d,e,f,g,h=a.contents,i=a.dataTypes;while("*"===i[0])i.shift(),void 0===d&&(d=a.mimeType||b.getResponseHeader("Content-Type"));if(d)for(e in h)if(h[e]&&h[e].test(d)){i.unshift(e);break}if(i[0]in c)f=i[0];else{for(e in c){if(!i[0]||a.converters[e+" "+i[0]]){f=e;break}g||(g=e)}f=f||g}if(f)return f!==i[0]&&i.unshift(f),c[f]}function Qb(a,b,c,d){var e,f,g,h,i,j={},k=a.dataTypes.slice();if(k[1])for(g in a.converters)j[g.toLowerCase()]=a.converters[g];f=k.shift();while(f)if(a.responseFields[f]&&(c[a.responseFields[f]]=b),!i&&d&&a.dataFilter&&(b=a.dataFilter(b,a.dataType)),i=f,f=k.shift())if("*"===f)f=i;else if("*"!==i&&i!==f){if(g=j[i+" "+f]||j["* "+f],!g)for(e in j)if(h=e.split(" "),h[1]===f&&(g=j[i+" "+h[0]]||j["* "+h[0]])){g===!0?g=j[e]:j[e]!==!0&&(f=h[0],k.unshift(h[1]));break}if(g!==!0)if(g&&a["throws"])b=g(b);else try{b=g(b)}catch(l){return{state:"parsererror",error:g?l:"No conversion from "+i+" to "+f}}}return{state:"success",data:b}}r.extend({active:0,lastModified:{},etag:{},ajaxSettings:{url:tb.href,type:"GET",isLocal:Fb.test(tb.protocol),global:!0,processData:!0,async:!0,contentType:"application/x-www-form-urlencoded; charset=UTF-8",accepts:{"*":Kb,text:"text/plain",html:"text/html",xml:"application/xml, text/xml",json:"application/json, text/javascript"},contents:{xml:/\bxml\b/,html:/\bhtml/,json:/\bjson\b/},responseFields:{xml:"responseXML",text:"responseText",json:"responseJSON"},converters:{"* text":String,"text html":!0,"text json":JSON.parse,"text xml":r.parseXML},flatOptions:{url:!0,context:!0}},ajaxSetup:function(a,b){return b?Ob(Ob(a,r.ajaxSettings),b):Ob(r.ajaxSettings,a)},ajaxPrefilter:Mb(Ib),ajaxTransport:Mb(Jb),ajax:function(b,c){"object"==typeof b&&(c=b,b=void 0),c=c||{};var e,f,g,h,i,j,k,l,m,n,o=r.ajaxSetup({},c),p=o.context||o,q=o.context&&(p.nodeType||p.jquery)?r(p):r.event,s=r.Deferred(),t=r.Callbacks("once memory"),u=o.statusCode||{},v={},w={},x="canceled",y={readyState:0,getResponseHeader:function(a){var b;if(k){if(!h){h={};while(b=Eb.exec(g))h[b[1].toLowerCase()]=b[2]}b=h[a.toLowerCase()]}return null==b?null:b},getAllResponseHeaders:function(){return k?g:null},setRequestHeader:function(a,b){return null==k&&(a=w[a.toLowerCase()]=w[a.toLowerCase()]||a,v[a]=b),this},overrideMimeType:function(a){return null==k&&(o.mimeType=a),this},statusCode:function(a){var b;if(a)if(k)y.always(a[y.status]);else for(b in a)u[b]=[u[b],a[b]];return this},abort:function(a){var b=a||x;return e&&e.abort(b),A(0,b),this}};if(s.promise(y),o.url=((b||o.url||tb.href)+"").replace(Hb,tb.protocol+"//"),o.type=c.method||c.type||o.method||o.type,o.dataTypes=(o.dataType||"*").toLowerCase().match(L)||[""],null==o.crossDomain){j=d.createElement("a");try{j.href=o.url,j.href=j.href,o.crossDomain=Lb.protocol+"//"+Lb.host!=j.protocol+"//"+j.host}catch(z){o.crossDomain=!0}}if(o.data&&o.processData&&"string"!=typeof o.data&&(o.data=r.param(o.data,o.traditional)),Nb(Ib,o,c,y),k)return y;l=r.event&&o.global,l&&0===r.active++&&r.event.trigger("ajaxStart"),o.type=o.type.toUpperCase(),o.hasContent=!Gb.test(o.type),f=o.url.replace(Cb,""),o.hasContent?o.data&&o.processData&&0===(o.contentType||"").indexOf("application/x-www-form-urlencoded")&&(o.data=o.data.replace(Bb,"+")):(n=o.url.slice(f.length),o.data&&(f+=(vb.test(f)?"&":"?")+o.data,delete o.data),o.cache===!1&&(f=f.replace(Db,"$1"),n=(vb.test(f)?"&":"?")+"_="+ub++ +n),o.url=f+n),o.ifModified&&(r.lastModified[f]&&y.setRequestHeader("If-Modified-Since",r.lastModified[f]),r.etag[f]&&y.setRequestHeader("If-None-Match",r.etag[f])),(o.data&&o.hasContent&&o.contentType!==!1||c.contentType)&&y.setRequestHeader("Content-Type",o.contentType),y.setRequestHeader("Accept",o.dataTypes[0]&&o.accepts[o.dataTypes[0]]?o.accepts[o.dataTypes[0]]+("*"!==o.dataTypes[0]?", "+Kb+"; q=0.01":""):o.accepts["*"]);for(m in o.headers)y.setRequestHeader(m,o.headers[m]);if(o.beforeSend&&(o.beforeSend.call(p,y,o)===!1||k))return y.abort();if(x="abort",t.add(o.complete),y.done(o.success),y.fail(o.error),e=Nb(Jb,o,c,y)){if(y.readyState=1,l&&q.trigger("ajaxSend",[y,o]),k)return y;o.async&&o.timeout>0&&(i=a.setTimeout(function(){y.abort("timeout")},o.timeout));try{k=!1,e.send(v,A)}catch(z){if(k)throw z;A(-1,z)}}else A(-1,"No Transport");function A(b,c,d,h){var j,m,n,v,w,x=c;k||(k=!0,i&&a.clearTimeout(i),e=void 0,g=h||"",y.readyState=b>0?4:0,j=b>=200&&b<300||304===b,d&&(v=Pb(o,y,d)),v=Qb(o,v,y,j),j?(o.ifModified&&(w=y.getResponseHeader("Last-Modified"),w&&(r.lastModified[f]=w),w=y.getResponseHeader("etag"),w&&(r.etag[f]=w)),204===b||"HEAD"===o.type?x="nocontent":304===b?x="notmodified":(x=v.state,m=v.data,n=v.error,j=!n)):(n=x,!b&&x||(x="error",b<0&&(b=0))),y.status=b,y.statusText=(c||x)+"",j?s.resolveWith(p,[m,x,y]):s.rejectWith(p,[y,x,n]),y.statusCode(u),u=void 0,l&&q.trigger(j?"ajaxSuccess":"ajaxError",[y,o,j?m:n]),t.fireWith(p,[y,x]),l&&(q.trigger("ajaxComplete",[y,o]),--r.active||r.event.trigger("ajaxStop")))}return y},getJSON:function(a,b,c){return r.get(a,b,c,"json")},getScript:function(a,b){return r.get(a,void 0,b,"script")}}),r.each(["get","post"],function(a,b){r[b]=function(a,c,d,e){return r.isFunction(c)&&(e=e||d,d=c,c=void 0),r.ajax(r.extend({url:a,type:b,dataType:e,data:c,success:d},r.isPlainObject(a)&&a))}}),r._evalUrl=function(a){return r.ajax({url:a,type:"GET",dataType:"script",cache:!0,async:!1,global:!1,"throws":!0})},r.fn.extend({wrapAll:function(a){var b;return this[0]&&(r.isFunction(a)&&(a=a.call(this[0])),b=r(a,this[0].ownerDocument).eq(0).clone(!0),this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstElementChild)a=a.firstElementChild;return a}).append(this)),this},wrapInner:function(a){return r.isFunction(a)?this.each(function(b){r(this).wrapInner(a.call(this,b))}):this.each(function(){var b=r(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=r.isFunction(a);return this.each(function(c){r(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(a){return this.parent(a).not("body").each(function(){r(this).replaceWith(this.childNodes)}),this}}),r.expr.pseudos.hidden=function(a){return!r.expr.pseudos.visible(a)},r.expr.pseudos.visible=function(a){return!!(a.offsetWidth||a.offsetHeight||a.getClientRects().length)},r.ajaxSettings.xhr=function(){try{return new a.XMLHttpRequest}catch(b){}};var Rb={0:200,1223:204},Sb=r.ajaxSettings.xhr();o.cors=!!Sb&&"withCredentials"in Sb,o.ajax=Sb=!!Sb,r.ajaxTransport(function(b){var c,d;if(o.cors||Sb&&!b.crossDomain)return{send:function(e,f){var g,h=b.xhr();if(h.open(b.type,b.url,b.async,b.username,b.password),b.xhrFields)for(g in b.xhrFields)h[g]=b.xhrFields[g];b.mimeType&&h.overrideMimeType&&h.overrideMimeType(b.mimeType),b.crossDomain||e["X-Requested-With"]||(e["X-Requested-With"]="XMLHttpRequest");for(g in e)h.setRequestHeader(g,e[g]);c=function(a){return function(){c&&(c=d=h.onload=h.onerror=h.onabort=h.onreadystatechange=null,"abort"===a?h.abort():"error"===a?"number"!=typeof h.status?f(0,"error"):f(h.status,h.statusText):f(Rb[h.status]||h.status,h.statusText,"text"!==(h.responseType||"text")||"string"!=typeof h.responseText?{binary:h.response}:{text:h.responseText},h.getAllResponseHeaders()))}},h.onload=c(),d=h.onerror=c("error"),void 0!==h.onabort?h.onabort=d:h.onreadystatechange=function(){4===h.readyState&&a.setTimeout(function(){c&&d()})},c=c("abort");try{h.send(b.hasContent&&b.data||null)}catch(i){if(c)throw i}},abort:function(){c&&c()}}}),r.ajaxPrefilter(function(a){a.crossDomain&&(a.contents.script=!1)}),r.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/\b(?:java|ecma)script\b/},converters:{"text script":function(a){return r.globalEval(a),a}}}),r.ajaxPrefilter("script",function(a){void 0===a.cache&&(a.cache=!1),a.crossDomain&&(a.type="GET")}),r.ajaxTransport("script",function(a){if(a.crossDomain){var b,c;return{send:function(e,f){b=r(" + + + + diff --git a/X/wget-S.txt b/X/wget-S.txt new file mode 100644 index 0000000..92633fa --- /dev/null +++ b/X/wget-S.txt @@ -0,0 +1,56 @@ + +gilles@petite:~/public_html/imapsync/X 82$ wget -S https://ajax.googleapis.com/ajax/libs/jquery/3.2.1/jquery.min.js +--2017-07-06 14:13:38-- https://ajax.googleapis.com/ajax/libs/jquery/3.2.1/jquery.min.js +Résolution de ajax.googleapis.com (ajax.googleapis.com)… 2a00:1450:4007:80f::200a, 216.58.198.202, 216.58.204.106, ... +Connexion à ajax.googleapis.com (ajax.googleapis.com)|2a00:1450:4007:80f::200a|:443… connecté. +requête HTTP transmise, en attente de la réponse… + HTTP/1.1 200 OK + Accept-Ranges: none + Vary: Accept-Encoding + Content-Type: text/javascript; charset=UTF-8 + Access-Control-Allow-Origin: * + Timing-Allow-Origin: * + Date: Thu, 11 May 2017 02:23:21 GMT + Expires: Fri, 11 May 2018 02:23:21 GMT + Last-Modified: Fri, 24 Mar 2017 20:55:54 GMT + X-Content-Type-Options: nosniff + Server: sffe + X-XSS-Protection: 1; mode=block + Cache-Control: public, max-age=31536000, stale-while-revalidate=2592000 + Age: 4873817 + Alt-Svc: quic=":443"; ma=2592000; v="39,38,37,36,35" + Transfer-Encoding: chunked +Taille : non indiqué [text/javascript] +Enregistre : «jquery.min.js» + +jquery.min.js [ <=> ] 84,63K 494KB/s in 0,2s + +2017-07-06 14:13:38 (494 KB/s) - «jquery.min.js» enregistré [86659] + +gilles@petite:~/public_html/imapsync/X 84$ wget -S https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js +--2017-07-06 14:15:33-- https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js +Résolution de maxcdn.bootstrapcdn.com (maxcdn.bootstrapcdn.com)… 198.232.125.123, 94.31.29.55 +Connexion à maxcdn.bootstrapcdn.com (maxcdn.bootstrapcdn.com)|198.232.125.123|:443… connecté. +requête HTTP transmise, en attente de la réponse… + HTTP/1.1 200 OK + Date: Thu, 06 Jul 2017 12:15:33 GMT + Content-Type: application/javascript + Content-Length: 37045 + Connection: keep-alive + Last-Modified: Mon, 25 Jul 2016 16:08:02 GMT + ETag: "5869c96cc8f19086aee625d670d741f9" + Server: NetDNA-cache/2.2 + Expires: Sun, 01 Jul 2018 12:15:33 GMT + Cache-Control: max-age=31104000 + Vary: Accept-Encoding + Access-Control-Allow-Origin: * + X-Hello-Human: Say hello back! @getBootstrapCDN on Twitter + X-Cache: HIT + Accept-Ranges: bytes +Taille : 37045 (36K) [application/javascript] +Enregistre : «bootstrap.min.js» + +bootstrap.min.js 100%[=====================================================================================================>] 36,18K --.-KB/s in 0,02s + +2017-07-06 14:15:34 (1,64 MB/s) - «bootstrap.min.js» enregistré [37045/37045] + diff --git a/doc/GOOD_PRACTICES.html b/doc/GOOD_PRACTICES.html index 4414519..2b1eada 100644 --- a/doc/GOOD_PRACTICES.html +++ b/doc/GOOD_PRACTICES.html @@ -2,8 +2,12 @@ +Good practices for imapsync
        +

        Good practices for imapsync

        +Gilles LAMIRAL gilles.lamiral@laposte.net
        +% $Id: GOOD_PRACTICES.t2t,v 1.8 2017/08/31 02:12:11 gilles Exp gilles $

        @@ -11,7 +15,7 @@

          -
        • Best practices for imapsync +
        • Good practices for imapsync
          • Simple transfer
          • Exact backup @@ -25,7 +29,7 @@

            -

            Best practices for imapsync

            +

            Good practices for imapsync

            You are not supposed to have read the TUTORIAL documentation but it diff --git a/doc/GOOD_PRACTICES.t2t b/doc/GOOD_PRACTICES.t2t index d75a24f..0b126b1 100644 --- a/doc/GOOD_PRACTICES.t2t +++ b/doc/GOOD_PRACTICES.t2t @@ -1,7 +1,8 @@ +Good practices for imapsync +Gilles LAMIRAL gilles.lamiral@laposte.net +% $Id: GOOD_PRACTICES.t2t,v 1.8 2017/08/31 02:12:11 gilles Exp gilles $ -% $Id: GOOD_PRACTICES.t2t,v 1.7 2016/01/18 13:27:31 gilles Exp gilles $ - -= Best practices for imapsync = += Good practices for imapsync = You are not supposed to have read the TUTORIAL documentation but it reading it should help to understand and master the following best practices. diff --git a/doc/TUTORIAL_Unix.html b/doc/TUTORIAL_Unix.html index 541e6bc..cea6286 100644 --- a/doc/TUTORIAL_Unix.html +++ b/doc/TUTORIAL_Unix.html @@ -7,7 +7,7 @@

            Imapsync tutorial

            Gilles LAMIRAL gilles.lamiral@laposte.net
            -$Id: TUTORIAL_Unix.t2t,v 1.18 2016/02/04 03:27:01 gilles Exp gilles $ +$Id: TUTORIAL_Unix.t2t,v 1.23 2017/09/07 12:09:15 gilles Exp gilles $

            @@ -15,7 +15,7 @@

            @@ -36,10 +38,10 @@

            -

            1. Good practices

            +

            1. Good practices overview

              -
            • Do the basic steps showing imapsync works by itself. +
            • Do the basic checks showing imapsync works by itself where you run it.

            • Next, applying imapsync to your data, continue with a real user account on the source imap server (host1) @@ -64,7 +66,7 @@ change to a real user account on host2 or just stop consider it a test one. Open a terminal and go to the imapsync directory. The imapsync directory is the directory created by extraction of the tarball (.tgz), its name is imapsync-1.xxx where 1.xxx -is imapsync release number (1.675 or upper). +is imapsync release number (1.836 at the time of this writing). 

              @@ -80,18 +82,18 @@ Verify imapsync runs on your system

              -It should outpout the help message. The help message is also at -http://imapsync.lamiral.info/OPTIONS but you don't have to read it now. +It should outpout the help message.

              If the previous command fails then there is an installation issue. -Go back to http://imapsync.lamiral.info/#doc and read INSTALL file -or drop me an email. +Go back to https://imapsync.lamiral.info/#install then +and read and apply the installation file corresponding to your +system and drop me an email about your issue.

              -Next, verify imapsync runs live tests. This check needs internet +Next, verify imapsync runs live tests. This check needs an internet access. It does a simple sync between two real dedicated -imap maiboxes located at test.lamiral.info. +imap maiboxes located at the host test.lamiral.info 

              @@ -119,7 +121,7 @@ for your future own script.
 You're still in the imapsync directory.
 
              
 
              
-Copy the script examples/imapsync_example.sh
+Make a copy of the script examples/imapsync_example.sh
 
              
 
 
              @@ -146,18 +148,18 @@ An IMAP account is accessed with 3 parameters,
 
              
 
 
                
-
              • the imap server host. It's a server name or an ip address.
-
              • the user name.
-
              • the password.
+
              • the imap server host. It's a server name or an ip address
+
              • the user name
+
              • the password
 
              
 
 
              
-Since imapsync job is to sync two imap accounts we need 3 + 3 = 6 parameters.
+Since imapsync job is to sync two imap accounts we need 3 + 3 = 6 parameters:
 
              
 
 
                
-
              • Three parameters to read from the source account, host1, user1 and password1.
-
              • Three parameters to write to the destination account, host2, user2 and password2.
+
              • Three parameters in order to read data from the source account: host1, user1 and password1
+
              • Three parameters in order to copy this data to the destination account: host2, user2 and password2
 
              
 
 
@@ -165,17 +167,18 @@ Since imapsync job is to sync two imap accounts we need 3 + 3 = 6 parameters.
 
 
              
 Even to learn and get familiar with imapsync, you can take a 
-real user account as a source. No problem if it's currently used
-by a user.
+real user account as a source. There is also no problem if this account is 
+currently used by a user. By default, this account will only be read, no change will
+be made by imapsync on it.
 
              
 
              
-Assuming that the imap source server name host1 is imaphost1.mydomain.tld, 
+Assuming that the imap source server name host1 is origin.example.com, 
 the user1 account name is myuser1 and its password is mysecret1,
 we now have the first three parameters.
 
              
 
 
                
-
              • --host1 imaphost1.mydomain.tld
+
              • --host1 origin.example.com
 
              • --user1 myuser1
 
              • --password1 mysecret1 
 
              
@@ -191,16 +194,17 @@ the first times you play with imapsync.
 
              
 
              
 If you really can't afford a test account on host2, it's ok,
-imapsync is not that bad but you may have work to fix unwanted behaviour.
+imapsync is not that bad but you may have some work to do to fix some unwanted behaviour.
+Unwanted behaviour is mostly folders names that you don't want to be the same on both sides.
 
              
 
              
-Assuming that the imap destination server name host2 is imaphost2.mydomain.tld, 
+Assuming that the imap destination server name host2 is destiny.example.com, 
 the user2 account name is myuser2 and its password is mysecret2,
 we now have the next three parameters.
 
              
 
 
                
-
              • --host2 imaphost2.mydomain.tld
+
              • --host2 destiny.example.com
 
              • --user2 myuser2
 
              • --password2 mysecret2 
 
              
@@ -220,13 +224,13 @@ You're ready for a dry test on your accounts.
 
              
 
 
              
-Since mysync script is a copy of examples/imapsync_example.sh, 
+Since the mysync script is a copy of examples/imapsync_example.sh, 
 your first run with your data should include three other options
---automap --justfolders --dry. 
-With --dry option, nothing will really be  done on host2 
-but you will test whether the credentials are ok on both sides
+--automap --justfolders --dry. 
+With --dry option, nothing will really be done on host2 
+but yet it will test whether the credentials are ok on both sides
 or not, by a successful login or a failure. You will also observe  
-if the folders mapping is ok. 
+if the folders mapping is ok.
 
              
 
              
 If a login fails then double-check all three values that identify
@@ -234,7 +238,10 @@ the account, which are the host, the login name, and the password.
 
              
 
              
 If the folders mapping proposed is not ok then you can fix it with
-option --f1f2, like this example:
+option --f1f2, like the following example mapping source folder
+"Sent Messages" to the destination folder "Sent". The double-quotes
+are not part of the folders names but they should be used when special
+characters like blanks are in the folders names:
 
              
 
 
              @@ -251,7 +258,7 @@ As explained in the inline help or in the README:
 
 
              
 You're ready for a real test on your accounts, resticted to
-folders. Remove --dry from mysync and rerun it:
+folders. Remove --dry from the mysync script and rerun mysync:
 
              
 
 
              @@ -266,17 +273,18 @@ Three Internet protocols are used to access almost all email accounts:
 POP3, IMAP, HTTP.
 
              
 
              
-The oldest one still used is POP3, Post Office Protocol.  POP3 allows only 
-one main box called INBOX. With POP3 messages have no flags, no Seen/UnSeen 
-Forwarded Flagged labels. Messages are often
-removed from the POP3 server each time a software client looks into it,
-so messages only appear on the client host that fetched them, they are
-unavailable from any other system located elsewhere.
+The oldest protocol still used to access mailboxes is POP3, the Post Office Protocol.  
+POP3 gives access to only one main box called INBOX. 
+With POP3, messages have no flags at all, no Seen/UnSeen, Forwarded, or Flagged labels. 
+It's not systematic but messages are often removed from the POP3 server 
+each time a software client looks into it,
+so messages only appear on the client host that fetched them, 
+then they are unavailable from any other system located elsewhere.
 
              
 
              
 The second protocol to deal with email messages is IMAP, Internet Message Access Protocol.
- IMAP allows a hierarchy of mailboxes also called folders, also concurrent accesses, 
-tagging with flags, search by many criterium like date, subject, size etc.
+IMAP gives access to a hierarchy of mailboxes also called folders. Other IMAP features are
+ concurrent accesses, tagging with flags, search by many criterium like date, subject, size etc.
 The IMAP protocol presents most of the features POP lacks.
 Messages stay on the imap server so any client on the network can access them
 at any time from anywhere, the same messages with the same flags.
@@ -284,16 +292,26 @@ at any time from anywhere, the same messages with the same flags.
 
              
 The third protocol to access email messages is HTTP, HyperText Transfer Protocol.
 HTTP is the protocol to browse the web. 
-Web browsers like Google Chrome, Mozilla Firefox, Internet Explorer, Safari,
-are HTTP client softwares.
-Webmails often offer the same features than imap servers because 
-webmails underlying storage systems are often imap servers. 
-So webmail mailboxes like Gmail, Yahoo, Exchange, Zimbra or Office365 are also accessible via imap. 
+Web browsers like Google Chrome, Mozilla Firefox, Internet Explorer and Safari
+are HTTP client softwares. You already know that so what's the point with HTTP mailboxes?
+HTTP mailboxes are called webmails. 
+Webmails often offer the same features as imap servers do 
+because webmails underlying storage systems are often imap servers. 
+So webmails systems like Gmail, Yahoo, Exchange, Zimbra or Office365 are also accessible via imap. 
 
              
 
              
-The conclusion of this protocol review is that IMAP can be used
-to access mailboxes most of the time. Here comes imapsync.
+The conclusion of this protocol review is that mailboxes can be
+accessed using the IMAP protocol, most of the time. 
+Here comes imapsync.
 
              
+
              
+In case the source mailbox is only accessible by the POP protocol,
+you can use the tool pop2imap located at http://www.linux-france.org/prj/pop2imap/
+
              
+
+
+
              4. Imapsync presentation
              
+
 
              
 Software imapsync is a command line tool to 
 copy, migrate, backup or synchronize IMAP mailboxes.
@@ -302,7 +320,7 @@ copy, migrate, backup or synchronize IMAP mailboxes.
 Command line means imapsync is not graphical, it is textual.
 Usually with command line tools you have to type characters 
 on your keyboard. But your fingers won't suffer much pain 
-typing on the keyboard because working script examples are available,
+typing on the keyboard because script examples are given,
 nearly ready to run. Most of the time you only have to change 
 the main values in those files and adapt them to your context.
 
              
@@ -315,7 +333,7 @@ and run the little script with a doubleclick.
 
              
 Imapsync runs on Linux, Windows and OS X (Macintosh world).
 Imapsync is written in the Perl language and thanks to the 
-Perl developpers, Perl runs everywhere, so does imapsync.
+Perl developpers, Perl runs mostly everywhere, so does imapsync.
 
              
 
              
 While operating systems have a lot in common, they sometimes differ,
@@ -325,14 +343,14 @@ decided it would be very cool to not share exactly the same syntax
 for doing the same things. Thanks guys, great thinking!
 
              
 
              
-To avoid you to learn by headaches a system you do not master 
-I will give examples in both worlds, Unix and Windows. 
+To avoid you some headaches with systems no one masters
+I will give examples in both worlds, Unix and Windows.
 OS X users are in the Unix world nowadays so they must follow 
 the Unix examples.
 
              
 
-
-
              4. Conventions
              
+
+
              5. Conventions
              
 
 
              
 In order to simplify display or print,
@@ -341,14 +359,13 @@ but it could be written in one single line.
 
              
 
              
 If you prefer to use the whole command written in one single line then 
-just remove the last visible character of each line and
+just remove the last visible character of each line ( \ or ^ ) and
 also the carriage return character. 
-The last visible character meaning "command continues on next line"
-is the backslash \ character on Unix examples 
-or the caret ^ character on Windows examples.
+The last visible character means "command continues on next line";
+it is the backslash \ character on Unix and the caret ^ character on Windows.
 
              
 
              
-For example, on Unix
+For example, on Unix, a command like the following
 
              
 
 
              @@ -387,15 +404,16 @@ is equivalent to
     imapsync --host1 test.lamiral.info --user1 test1 --password1 secret1 ...
 
              
 
-
-
              5. Why start with a test account on destination host2?
              
+
+
              6. Why start with a test account on destination host2?
              
 
 
              
 A little explanation about this hint.
 Imapsync is safe with accounts on host1, 
 it doesn't change anything on them, it just read them. 
-The exception of this safe principle is when --delete option is used, 
-since --delete removes on host1 each message successfully copied to host2. 
+The exception of this safe principle is when --delete1 option is used, 
+since --delete1 removes on host1 each message successfully copied to host2,
+messages that couldn't be transferred stay on host1.
 
              
 
              
 It's not the same for destination accounts as imapsync writes on host2 accounts. 
@@ -407,42 +425,42 @@ to test imapsync. Learn to use it and see what it does on a test account at host
 What can badly happen? The most common bad behaviour is
 the folders mapping won't be what you expect because it is strictly
 reproduced from  host1 to  host2. The second bad behaviour is
-duplicates on second run and after, it's rare but it can happen, 
-depending on imap server software changing headers. Solutions
-to avoid duplicates are often easy. It's also possible to remove 
-the duplicates on host2 but it's better to avoid them on user accounts,
-users won't like you mess up their mailboxes.
+duplicates on second run and after, it's rare but it can happen
+when a imap server software changes headers "Message-Id" or "Received". 
+Solutions to avoid duplicates are often easy (There's a FAQ called FAQ.Duplicates.txt about that). 
+It's also possible to remove the duplicates on host2 but it's better to avoid them on user accounts at first,
+users won't like that you mess up their mailboxes.
 
              
 
-
-
              6. Imapsync default behaviour
              
+
+
              7. Imapsync default behaviour
              
 
 
              
-By default, so unless explicitely told to do something else:
+By default, unless explicitely told to do something else:
 
              
 
 
                
-
              • Imapsync syncs all folders of host1
-
              • Imapsync syncs all messages from host1, except duplicates.
-
              • Imapsync syncs all flags, at least all allowed by host2.
-
                
+
              • Imapsync goes ssl or tls if possible
+
              • Imapsync syncs all folders of host1
+
              • Imapsync syncs all messages from host1, except duplicates.
+
              • Imapsync syncs all flags, at least all allowed by host2.
 
              
 
-
                
-
              1. To go further with imapsync +
-
                
+
+
                8. To go further with imapsync
                
+
+
                
 Imapsync has many options but you can ignore most of them 
 and still make great transfers. 
-
                
-
              
+
              
 
 
                
-
              • Option names all begin with two minus characters --, like --automap or --dry etc.
-
              • Option names relative to the source account are ended with 1, like --host1
-
              • Option names relative to the destination account are ended with 2, like --host2
-
              • Some options need a value, like --host1 source.server.tld
-
              • Some options are standalone, like --ssl1
-
              • Any order is possible but when an option needs a value then the value must follow its option name, of course.
+
              • Option names all begin with two minus characters --, like --automap or --dry etc. (using one minus, like -dry, is ok)
+
              • Option names relative to the source account are ended with the number one 1, like in --host1
+
              • Option names relative to the destination account are ended with the number two 2, like in --host2
+
              • Some options need a value just after them, like --host1 source.example.com, (the value is source.example.com)
+
              • Some options are standalone, like --automap
+
              • Any order is possible but when an option needs a value then the value must follow immediately its option name.
 
              
 
 
diff --git a/doc/TUTORIAL_Unix.t2t b/doc/TUTORIAL_Unix.t2t
index 2d25c7a..3420b2b 100644
--- a/doc/TUTORIAL_Unix.t2t
+++ b/doc/TUTORIAL_Unix.t2t
@@ -1,10 +1,10 @@
 Imapsync tutorial
 Gilles LAMIRAL   gilles.lamiral@laposte.net
-$Id: TUTORIAL_Unix.t2t,v 1.18 2016/02/04 03:27:01 gilles Exp gilles $ 
+$Id: TUTORIAL_Unix.t2t,v 1.23 2017/09/07 12:09:15 gilles Exp gilles $ 
 
-+ Good practices +
++ Good practices overview +
 
-- Do the basic steps showing imapsync works by itself.
+- Do the basic checks showing imapsync works by itself where you run it.
 
 - Next, applying imapsync to your data, 
 continue with a **real user** account on the source imap server (host1)
@@ -28,7 +28,7 @@ change to a real user account on host2 or just stop consider it a test one.
 Open a terminal and go to the imapsync directory. 
 The imapsync directory is the directory created by extraction
 of the tarball (.tgz), its name is ``imapsync-1.xxx`` where ``1.xxx`` 
-is imapsync release number (1.675 or upper).
+is imapsync release number (1.836 at the time of this writing).
 
 ```
 cd imapsync-1.xxx/
@@ -38,16 +38,16 @@ Verify imapsync runs on your system
 ```
 ./imapsync
 ```
-It should outpout the help message. The help message is also at
-http://imapsync.lamiral.info/OPTIONS but you don't have to read it now.
+It should outpout the help message.
 
 If the previous command fails then there is an installation issue.
-Go back to http://imapsync.lamiral.info/#doc and read INSTALL file
-or drop me an email.
+Go back to https://imapsync.lamiral.info/#install then 
+and read and apply the installation file corresponding to your 
+system and drop me an email about your issue.
 
-Next, verify imapsync runs live tests. This check needs internet
+Next, verify imapsync runs live tests. This check needs an internet
 access. It does a simple sync between two real dedicated
-imap maiboxes located at test.lamiral.info.
+imap maiboxes located at the host test.lamiral.info
 ```
 ./imapsync --testslive
 ```
@@ -64,7 +64,7 @@ for your future own script.
 
 You're still in the imapsync directory.
 
-Copy the script ``examples/imapsync_example.sh``
+Make a copy of the script ``examples/imapsync_example.sh``
 ```
 cp examples/imapsync_example.sh   mysync
 ```
@@ -78,27 +78,28 @@ So far so good, now we're going to work with your data.
 ++ Prepare your credentials ++
 
 An IMAP account is accessed with 3 parameters, 
-- the imap server **host**. It's a server name or an ip address.
-- the **user** name.
-- the **password**.
+- the imap server **host**. It's a server name or an ip address
+- the **user** name
+- the **password**
 
 
-Since imapsync job is to sync two imap accounts we need 3 + 3 = 6 parameters.
-- Three parameters to read from the source account, **host1**, **user1** and **password1**.
-- Three parameters to write to the destination account, **host2**, **user2** and **password2**.
+Since imapsync job is to sync two imap accounts we need 3 + 3 = 6 parameters:
+- Three parameters in order to read data from the source account: **host1**, **user1** and **password1**
+- Three parameters in order to copy this data to the destination account: **host2**, **user2** and **password2**
 
 
 ++ Take a real user account as source ++
 
 Even to learn and get familiar with imapsync, you can take a 
-real user account as a source. No problem if it's currently used
-by a user.
+real user account as a source. There is also no problem if this account is 
+currently used by a user. By default, this account will only be read, no change will
+be made by imapsync on it.
 
-Assuming that the imap source server name host1 is **imaphost1.mydomain.tld**, 
+Assuming that the imap source server name host1 is **origin.example.com**, 
 the user1 account name is **myuser1** and its password is **mysecret1**,
 we now have the first three parameters.
 
-- --host1 **imaphost1.mydomain.tld**
+- --host1 **origin.example.com**
 - --user1 **myuser1**
 - --password1 **mysecret1** 
 
@@ -111,13 +112,14 @@ it is not a very good idea to use a real user imap account
 the first times you play with imapsync.
 
 If you really can't afford a test account on host2, it's ok,
-imapsync is not that bad but you may have work to fix unwanted behaviour.
+imapsync is not that bad but you may have some work to do to fix some unwanted behaviour.
+Unwanted behaviour is mostly folders names that you don't want to be the same on both sides.
 
-Assuming that the imap destination server name host2 is **imaphost2.mydomain.tld**, 
+Assuming that the imap destination server name host2 is **destiny.example.com**, 
 the user2 account name is **myuser2** and its password is **mysecret2**,
 we now have the next three parameters.
 
-- --host2 **imaphost2.mydomain.tld**
+- --host2 **destiny.example.com**
 - --user2 **myuser2**
 - --password2 **mysecret2** 
 
@@ -132,19 +134,22 @@ You're ready for a dry test on your accounts.
 sh mysync
 ```
 
-Since mysync script is a copy of examples/imapsync_example.sh, 
+Since the ``mysync`` script is a copy of ``examples/imapsync_example.sh``, 
 your first run with your data should include three other options
---automap --justfolders --dry. 
-With --dry option, nothing will really be  done on host2 
-but you will test whether the credentials are ok on both sides
+``--automap`` ``--justfolders`` ``--dry``. 
+With ``--dry`` option, nothing will really be done on host2 
+but yet it will test whether the credentials are ok on both sides
 or not, by a successful login or a failure. You will also observe  
-if the folders mapping is ok. 
+if the folders mapping is ok.
 
 If a login fails then double-check all three values that identify
 the account, which are the host, the login name, and the password.
 
 If the folders mapping proposed is not ok then you can fix it with
-option --f1f2, like this example:
+option ``--f1f2``, like the following example mapping source folder
+"Sent Messages" to the destination folder "Sent". The double-quotes
+are not part of the folders names but they should be used when special
+characters like blanks are in the folders names:
 
 
 ```
@@ -157,8 +162,7 @@ As explained in the inline help or in the README:
 ```
 
 You're ready for a real test on your accounts, resticted to
-folders. Remove --dry from mysync and rerun it:
-
+folders. Remove ``--dry`` from the ``mysync`` script and rerun ``mysync``:
 
 ```
 sh mysync
@@ -171,40 +175,48 @@ sh mysync
 Three Internet protocols are used to access almost all email accounts: 
 POP3, IMAP, HTTP.
 
-The oldest one still used is POP3, Post Office Protocol.  POP3 allows only 
-one main box called INBOX. With POP3 messages have no flags, no Seen/UnSeen 
-Forwarded Flagged labels. Messages are often
-removed from the POP3 server each time a software client looks into it,
-so messages only appear on the client host that fetched them, they are
-unavailable from any other system located elsewhere.
+The oldest protocol still used to access mailboxes is POP3, the Post Office Protocol.  
+POP3 gives access to only one main box called INBOX. 
+With POP3, messages have no flags at all, no Seen/UnSeen, Forwarded, or Flagged labels. 
+It's not systematic but messages are often removed from the POP3 server 
+each time a software client looks into it,
+so messages only appear on the client host that fetched them, 
+then they are unavailable from any other system located elsewhere.
 
 
 The second protocol to deal with email messages is IMAP, Internet Message Access Protocol.
- IMAP allows a hierarchy of mailboxes also called folders, also concurrent accesses, 
-tagging with flags, search by many criterium like date, subject, size etc.
+IMAP gives access to a hierarchy of mailboxes also called folders. Other IMAP features are
+ concurrent accesses, tagging with flags, search by many criterium like date, subject, size etc.
 The IMAP protocol presents most of the features POP lacks.
 Messages stay on the imap server so any client on the network can access them
 at any time from anywhere, the same messages with the same flags.
 
 The third protocol to access email messages is HTTP, HyperText Transfer Protocol.
 HTTP is the protocol to browse the web. 
-Web browsers like Google Chrome, Mozilla Firefox, Internet Explorer, Safari,
-are HTTP client softwares.
-Webmails often offer the same features than imap servers because 
-webmails underlying storage systems are often imap servers. 
-So webmail mailboxes like Gmail, Yahoo, Exchange, Zimbra or Office365 are also accessible via imap. 
+Web browsers like Google Chrome, Mozilla Firefox, Internet Explorer and Safari
+are HTTP client softwares. You already know that so what's the point with HTTP mailboxes?
+HTTP mailboxes are called webmails. 
+Webmails often offer the same features as imap servers do 
+because webmails underlying storage systems are often imap servers. 
+So webmails systems like Gmail, Yahoo, Exchange, Zimbra or Office365 are also accessible via imap. 
 
-The conclusion of this protocol review is that IMAP can be used
-to access mailboxes most of the time. Here comes imapsync.
+The conclusion of this protocol review is that mailboxes can be
+accessed using the IMAP protocol, most of the time. 
+Here comes imapsync.
+
+In case the source mailbox is only accessible by the POP protocol,
+you can use the tool ``pop2imap`` located at http://www.linux-france.org/prj/pop2imap/
+
+
++ Imapsync presentation +
 
 Software imapsync is a command line tool to 
 copy, migrate, backup or synchronize IMAP mailboxes.
 
-
 Command line means imapsync is not graphical, it is textual.
 Usually with command line tools you have to type characters 
 on your keyboard. But your fingers won't suffer much pain 
-typing on the keyboard because working script examples are available,
+typing on the keyboard because script examples are given,
 nearly ready to run. Most of the time you only have to change 
 the main values in those files and adapt them to your context.
 
@@ -215,7 +227,7 @@ and run the little script with a doubleclick.
 
 Imapsync runs on Linux, Windows and OS X (Macintosh world).
 Imapsync is written in the Perl language and thanks to the 
-Perl developpers, Perl runs everywhere, so does imapsync.
+Perl developpers, Perl runs mostly everywhere, so does imapsync.
 
 While operating systems have a lot in common, they sometimes differ,
 especially within syntax. I won't blame anyone, historically Windows 
@@ -223,8 +235,8 @@ came after Unix. The marvelous designers in this old times
 decided it would be very cool to not share exactly the same syntax 
 for doing the same things. Thanks guys, great thinking!
 
-To avoid you to learn by headaches a system you do not master 
-I will give examples in both worlds, Unix and Windows. 
+To avoid you some headaches with systems no one masters
+I will give examples in both worlds, Unix and Windows.
 OS X users are in the Unix world nowadays so they must follow 
 the Unix examples.
 
@@ -236,13 +248,12 @@ each imapsync command line is usually written in several lines
 but it could be written in one single line.
 
 If you prefer to use the whole command written in one single line then 
-just remove the last visible character of each line and
+just remove the last visible character of each line ( \ or ^ ) and
 also the carriage return character. 
-The last visible character meaning "command continues on next line"
-is the backslash \ character on Unix examples 
-or the caret ^ character on Windows examples.
+The last visible character means "command continues on next line";
+it is the backslash \ character on Unix and the caret ^ character on Windows.
 
-For example, on Unix
+For example, on Unix, a command like the following
 
 ```
   imapsync \
@@ -274,8 +285,9 @@ is equivalent to
 A little explanation about this hint.
 Imapsync is safe with accounts on host1, 
 it doesn't change anything on them, it just read them. 
-The exception of this safe principle is when --delete option is used, 
-since --delete removes on host1 each message successfully copied to host2. 
+The exception of this safe principle is when ``--delete1`` option is used, 
+since ``--delete1`` removes on host1 each message successfully copied to host2,
+messages that couldn't be transferred stay on host1.
 
 
 It's not the same for destination accounts as imapsync writes on host2 accounts. 
@@ -286,29 +298,31 @@ to test imapsync. Learn to use it and see what it does on a test account at host
 What can badly happen? The most common bad behaviour is
 the folders mapping won't be what you expect because it is strictly
 reproduced from  host1 to  host2. The second bad behaviour is
-duplicates on second run and after, it's rare but it can happen, 
-depending on imap server software changing headers. Solutions
-to avoid duplicates are often easy. It's also possible to remove 
-the duplicates on host2 but it's better to avoid them on user accounts,
-users won't like you mess up their mailboxes.
+duplicates on second run and after, it's rare but it can happen
+when a imap server software changes headers "``Message-Id``" or "``Received``". 
+Solutions to avoid duplicates are often easy (There's a FAQ called ``FAQ.Duplicates.txt`` about that). 
+It's also possible to remove the duplicates on host2 but it's better to avoid them on user accounts at first,
+users won't like that you mess up their mailboxes.
 
 + Imapsync default behaviour +
 
-By default, so unless explicitely told to do something else:
-- Imapsync syncs all folders of host1
-- Imapsync syncs all messages from host1, except duplicates.
-- Imapsync syncs all flags, at least all allowed by host2.
+By default, unless explicitely told to do something else:
+- Imapsync **goes ssl or tls** if possible
+- Imapsync syncs **all folders** of host1
+- Imapsync syncs **all messages** from host1, except duplicates.
+- Imapsync syncs **all flags**, at least all allowed by host2.
+
 
 + To go further with imapsync +
 
 Imapsync has many options but you can ignore most of them 
 and still make great transfers. 
 
-- Option names all begin with two minus characters ``--``, like ``--automap`` or ``--dry`` etc.
-- Option names relative to the **source** account are ended with **1**, like ``--host1``
-- Option names relative to the **destination** account are ended with **2**, like ``--host2``
-- Some options need a **value**, like ``--host1`` **``source.server.tld``**
-- Some options are standalone, like **``--ssl1``**
-- Any order is possible but when an option needs a value then the value must follow its option name, of course.
+- Option names all begin with two minus characters ``--``, like ``--automap`` or ``--dry`` etc. (using one minus, like ``-dry``, is ok)
+- Option names relative to the **source** account are ended with the number one **``1``**, like in ``--host1``
+- Option names relative to the **destination** account are ended with the number two **``2``**, like in ``--host2``
+- Some options need a **value** just after them, like ``--host1`` **``source.example.com``**, (the value is ``source.example.com``)
+- Some options are standalone, like **``--automap``**
+- Any order is possible but when an option needs a value then the value must follow immediately its option name.
 
 
diff --git a/examples/sync_loop_windows.bat b/examples/sync_loop_windows.bat
index c1974f1..521e742 100644
--- a/examples/sync_loop_windows.bat
+++ b/examples/sync_loop_windows.bat
@@ -1,5 +1,5 @@
 @REM
-@REM $Id: sync_loop_windows.bat,v 1.14 2016/03/09 01:22:33 gilles Exp gilles $
+@REM $Id: sync_loop_windows.bat,v 1.15 2017/05/13 04:43:01 gilles Exp gilles $
 @REM
 @REM imapsync massive sync example batch for Windows users
 @REM lines beginning with @REM are just comments 
@@ -82,12 +82,9 @@ SET csvfile=file.txt
 
 FOR /F "tokens=1,2,3,4,5,6,7 delims=; eol=#" %%G IN (%csvfile%) DO (
 @ECHO ==== Starting imapsync from --host1 %%G --user1 %%H to --host2 %%J --user2 %%K ====
-@ECHO.
-
-imapsync ^
+@imapsync ^
   --host1 %%G --user1 %%H --password1 %%I ^
   --host2 %%J --user2 %%K --password2 %%L %%M %arguments%
-
 @ECHO ==== Ended imapsync from --host1 %%G --user1 %%H to --host2 %%J --user2 %%K ====
 @ECHO.
 )
diff --git a/guestbook/guestbook_2013_11_05_01_19_28 b/guestbook/guestbook_2013_11_05_01_19_28
deleted file mode 100644
index 3e12e71..0000000
--- a/guestbook/guestbook_2013_11_05_01_19_28
+++ /dev/null
@@ -1,9 +0,0 @@
-Bonjour Gilles,
-
-Just a quick note to say thank you for a great piece of software. It’s good to pay for something that does what it says - nice work! 
-
-All accounts migrated without a hitch.
-
-Cheers,
-
-Tim Jones
diff --git a/i3 b/i3
index c7151ac..f295aec 100755
--- a/i3
+++ b/i3
@@ -1,7 +1,7 @@
 #!/bin/sh
 
-# $Id: i3,v 1.16 2016/03/07 02:54:23 gilles Exp gilles $
+# $Id: i3,v 1.17 2017/02/17 02:09:42 gilles Exp gilles $
 
 BASE=`dirname $0`
-perl -I${BASE}/W/Mail-IMAPClient-3.38/lib ${BASE}/imapsync "$@"
+perl -I${BASE}/W/Mail-IMAPClient-3.39/lib ${BASE}/imapsync "$@"
 
diff --git a/imapsync b/imapsync
index 8df547c..40a4d3e 100755
--- a/imapsync
+++ b/imapsync
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-# $Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $
+# $Id: imapsync,v 1.836 2017/09/05 16:14:53 gilles Exp gilles $
 # structure
 # pod documentation
 # pragmas
@@ -11,7 +11,7 @@
 # folder loop
 # subroutines
 # sub usage {
-# IMAPClient 3.xx ads
+
 
 # pod documentation
 
@@ -19,15 +19,15 @@
 
 =head1 NAME
 
-imapsync - Email IMAP tool for syncing, copying and migrating email mailboxes.
+imapsync - Email IMAP tool for syncing, copying and migrating 
+email mailboxes between two imap servers, one way, 
+and without duplicates.
 
-The imapsync command synchronises mailboxes between two imap servers.
-More than 69 different IMAP server softwares supported with success, 
-few failures.
+=head1 VERSION
 
-$Revision: 1.727 $
+This documentation refers to Imapsync $Revision: 1.836 $
 
-=head1 SYNOPSIS
+=head1 USAGE
 
  To synchronize the source imap account
    "test1" on server "test1.lamiral.info" with password "secret1"
@@ -39,12 +39,547 @@ $Revision: 1.727 $
    --host1 test1.lamiral.info --user1 test1 --password1 secret1 \
    --host2 test2.lamiral.info --user2 test2 --password2 secret2
 
-=head1 REQUIRED ARGUMENTS
+=head1 DESCRIPTION
 
-The required argmuments are the six values, three on each sides,
-needed to login into the IMAP servers, 
+We sometimes need to transfer mailboxes from one imap server to
+another.
+
+Imapsync command is a tool allowing incremental and
+recursive imap transfers from one mailbox to another.
+
+By default all folders are transferred, recursively, meaning 
+the whole folder hierarchy is taken, all messages in them, 
+and all messages flags (\Seen \Answered \Flagged etc.) 
+are synced too.
+
+Imapsync reduces the amount
+of data transferred by not transferring a given message
+if it resides already on both sides. Same specific headers
+and the transfer is done only once (by default it's
+"Message-Id:" and "Received:" lines but it can be changed with
+--useheader option).
+
+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 and interruptions.
+
+You can decide to delete the messages from the source mailbox
+after a successful transfer, it can be a good feature when migrating
+live mailboxes since messages will be only on one side.
+In that case, use the --delete1 option. Option --delete1 implies
+also option --expunge1 so all messages marked deleted on host1
+will be really deleted.
+
+A different scenario is synchronizing a mailbox B from another mailbox A
+in case you just want to keep a "live" copy of A in B.
+In that case --delete2 has to be used, it deletes messages in host2
+folder B that are not in host1 folder A. If you also need to destroy
+host2 folders that are not in host1 then use --delete2folders (see also
+--delete2foldersonly and --delete2foldersbutnot).
+
+Imapsync is not adequate for maintaining two active imap accounts
+in synchronization when the user plays independently on both sides.
+Use offlineimap (written by John Goerzen) or mbsync (written by
+Michael R. Elkins) for a 2 ways synchronization.
+
+
+=head1 OPTIONS
+
+ usage: imapsync [options]
+
+Mandatory options are the six values, three on each sides,
+needed to log in into the IMAP servers, ie, 
 a host, a username, and a password, two times.
 
+Conventions used:
+
+ str means string
+ int means integer
+ reg means regular expression
+ cmd means command
+
+ --dry               : Makes imapsync doing nothing for real, just print what 
+                       would be done without --dry.
+
+=head2 OPTIONS/credentials
+
+
+ --host1        str  : Source or "from" imap server. Mandatory.
+ --port1        int  : Port to connect on host1. Default is 143, 993 if --ssl1
+ --user1        str  : User to login on host1. Mandatory.
+ --password1    str  : Password for the user1.
+ --host2        str  : "destination" imap server. Mandatory.
+ --port2        int  : Port to connect on host2. Default is 143, 993 if --ssl2
+ --user2        str  : User to login on host2. Mandatory.
+ --password2    str  : Password for the user2.
+
+ --showpasswords     : Shows passwords on output instead of "MASKED".
+                       Useful to restart a complete run by just reading the log,
+                       or to debug passwords. It's not a secure practice.
+
+ --passfile1    str  : Password file for the user1. It must contain the
+                       password on the first line. This option avoids to show
+                       the password on the command line like --password1 does.
+ --passfile2    str  : Password file for the user2. Contains the password.
+
+=head2 OPTIONS/encryption
+
+ --nossl1            : Do not use a SSL connection on host1.
+ --ssl1              : Use a SSL connection on host1. On by default if possible.
+ --nossl2            : Do not use a SSL connection on host2.
+ --ssl2              : Use a SSL connection on host2. On by default if possible.
+ --notls1            : Do not use a TLS connection on host1.
+ --tls1              : Use a TLS connection on host1. On by default if possible.
+ --notls2            : Do not use a TLS connection on host2.
+ --tls2              : Use a TLS connection on host2. On by default if possible.
+ --debugssl     int  : SSL debug mode from 0 to 4.
+ --sslargs1     str  : Pass any ssl parameter for host1 ssl or tls connection. Example:
+                       --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3
+                       See all possibilities in the new() method of IO::Socket::SSL
+                       http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods
+ --sslargs2     str  : Pass any ssl parameter for host2 ssl or tls connection.
+                       See --sslargs1
+
+ --timeout1     int  : Connection timeout in seconds for host1.
+                       Default is 120 and 0 means no timeout at all.
+ --timeout2     int  : Connection timeout in seconds for host2.
+                       Default is 120 and 0 means no timeout at all.
+
+
+=head2 OPTIONS/authentication
+
+ --authmech1    str  : Auth mechanism to use with host1:
+                       PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
+ --authmech2    str  : Auth mechanism to use with host2. See --authmech1
+
+ --authuser1    str  : User to auth with on host1 (admin user).
+                       Avoid using --authmech1 SOMETHING with --authuser1.
+ --authuser2    str  : User to auth with on host2 (admin user).
+ --proxyauth1        : Use proxyauth on host1. Requires --authuser1.
+                       Required by Sun/iPlanet/Netscape IMAP servers to
+                       be able to use an administrative user.
+ --proxyauth2        : Use proxyauth on host2. Requires --authuser2.
+
+ --authmd51          : Use MD5 authentication for host1.
+ --authmd52          : Use MD5 authentication for host2.
+ --domain1      str  : Domain on host1 (NTLM authentication).
+ --domain2      str  : Domain on host2 (NTLM authentication).
+
+
+=head2 OPTIONS/folders
+
+
+ --folder       str  : Sync this folder.
+ --folder       str  : and this one, etc.
+ --folderrec    str  : Sync this folder recursively.
+ --folderrec    str  : and this one, etc.
+
+ --folderfirst  str  : Sync this folder first. --folderfirst "Work"
+ --folderfirst  str  : then this one, etc.
+ --folderlast   str  : Sync this folder last. --folderlast "[Gmail]/All Mail"
+ --folderlast   str  : then this one, etc.
+
+ --nomixfolders      : Do not merge folders when host1 is case-sensitive
+                       while host2 is not (like Exchange). Only the first
+                       similar folder is synced (ex: Sent SENT sent -> Sent).
+
+ --skipemptyfolders  : Empty host1 folders are not created on host2.
+
+ --include      reg  : Sync folders matching this regular expression
+ --include      reg  : or this one, etc.
+                       If both --include --exclude options are used, then
+                       include is done before.
+ --exclude      reg  : Skips folders matching this regular expression
+                       Several folders to avoid:
+                        --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
+ --exclude      reg  : or this one, etc.
+
+ --subfolder2   str  : Move whole host1 folders hierarchy under this
+                       host2 folder  str    .
+                       It does it by adding two --regextrans2 options before
+                       all others. Add --debug to see what's really going on.
+
+ --automap           : guesses folders mapping, for folders like
+                       "Sent", "Junk", "Drafts", "All", "Archive", "Flagged".
+ --f1f2    str1=str2 : Force folder str1 to be synced to str2,
+                       --f1f2 overrides --automap and --regextrans2.
+
+ --nomixfolders      : Avoid merging folders that are considered different on
+                       host1 but the same on destination host2 because of
+                       case sensitivities and insensitivities.
+
+ --subscribed        : Transfers subscribed folders.
+ --subscribe         : Subscribe to the folders transferred on the
+                       host2 that are subscribed on host1. On by default.
+ --subscribeall      : Subscribe to the folders transferred on the
+                       host2 even if they are not subscribed on host1.
+
+ --prefix1      str  : Remove prefix str to all destination folders,
+                       usually INBOX. or INBOX/ or an empty string "".
+                       imapsync guesses the prefix if host1 imap server
+                       does not have NAMESPACE capability. This option
+                       should not be used, most of the time.
+ --prefix2      str  : Add prefix to all host2 folders. See --prefix1
+ --sep1         str  : Host1 separator in case NAMESPACE is not supported.
+ --sep2         str  : Host2 separator in case NAMESPACE is not supported.
+
+ --regextrans2  reg  : Apply the whole regex to each destination folders.
+ --regextrans2  reg  : 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.
+                       Have in mind that --regextrans2 is applied after prefix
+                       and separator inversion. For examples see
+                       http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt
+
+=head2 OPTIONS/folders sizes
+
+ --nofoldersizes     : Do not calculate the size of each folder at the
+                       beginning of the sync. Default is to calculate them.
+ --nofoldersizesatend: Do not calculate the size of each folder at the 
+                       end of the sync. Default is to calculate them.
+ --justfoldersizes   : Exit after having printed the initial folder sizes.
+
+
+=head2 OPTIONS/tmp
+
+
+ --tmpdir       str  : Where to store temporary files and subdirectories.
+                       Will be created if it doesn't exist.
+                       Default is system specific, Unix is /tmp but
+                       /tmp is often too small and deleted at reboot.
+                       --tmpdir /var/tmp should be better.
+ --pidfile      str  : The file where imapsync pid is written,
+                       it can be dirname/filename.
+                       Default name is imapsync.pid in tmpdir.
+ --pidfilelocking    : Abort if pidfile already exists. Useful to avoid
+                       concurrent transfers on the same mailbox.
+
+
+=head2 OPTIONS/log
+
+ --nolog             : Turn off logging on file
+ --logfile      str  : Change the default log filename (can be dirname/filename).
+ --logdir       str  : Change the default log directory. Default is LOG_imapsync/
+
+
+=head2 OPTIONS/messages
+
+ --skipmess     reg  : Skips messages matching the regex.
+                       Example: 'm/[\x80-ff]/' # to avoid 8bits messages.
+                       --skipmess is applied before --regexmess
+ --skipmess     reg  : or this one, etc.
+
+ --pipemess     cmd  : Apply this cmd command to each message content
+                       before the copy.
+ --pipemess     cmd  : and this one, etc.
+
+ --disarmreadreceipts : Disarms read receipts (host2 Exchange issue)
+
+ --regexmess    reg  : Apply the whole regex to each message before transfer.
+                       Example: 's/\000/ /g' # to replace null by space.
+ --regexmess    reg  : and this one, etc.
+
+
+=head2 OPTIONS/flags
+
+ --regexflag    reg  : Apply the whole regex to each flags list.
+                       Example: 's/"Junk"//g' # to remove "Junk" flag.
+ --regexflag    reg  : then this one, etc.
+
+
+=head2 OPTIONS/deletions
+
+ --delete1           : Deletes messages on host1 server after a successful
+                       transfer. Option --delete1 has the following behavior:
+                       it marks messages as deleted with the IMAP flag
+                       \Deleted, then messages are really deleted with an
+                       EXPUNGE IMAP command. If expunging after each message
+                       slows down too much the sync then use
+                       --noexpungeaftereach to speed up.
+ --expunge1          : Expunge messages on host1 just before syncing a folder.
+                       Expunge is done per folder.
+                       Expunge aims is to really delete messages marked deleted.
+                       An expunge is also done after each message copied
+                       if option --delete1 is set.
+ --noexpunge1        : Do not expunge messages on host1.
+ --delete1emptyfolders : Deletes empty folders on host1, INBOX excepted.
+                         Useful with --delete1 since what remains on host1
+                         is only what failed to be synced.
+
+ --delete2           : Delete messages in host2 that are not in
+                       host1 server. Useful for backup or pre-sync.
+ --delete2duplicates : Delete messages in host2 that are duplicates.
+                       Works only without --useuid since duplicates are
+                       detected with an header part of each message.
+
+ --delete2folders    : Delete folders in host2 that are not in host1 server.
+                       For safety, first try it like this (it is safe):
+                       --delete2folders --dry --justfolders --nofoldersizes
+ --delete2foldersonly   reg : Deleted only folders matching regex.
+                              Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/"
+ --delete2foldersbutnot reg : Do not delete folders matching regex.
+                              Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/"
+
+ --expunge2          : Expunge messages on host2 after messages transfer.
+ --uidexpunge2       : uidexpunge messages on the host2 account
+                       that are not on the host1 account, requires --delete2
+
+
+=head2 OPTIONS/dates
+
+ --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.
+
+
+=head2 OPTIONS/message selection
+
+ --maxsize      int  : Skip messages larger  (or equal) than  int  bytes
+ --minsize      int  : Skip messages smaller (or equal) than  int  bytes
+ --maxage       int  : Skip messages older than  int  days.
+                       final stats (skipped) don't count older messages
+                       see also --minage
+ --minage       int  : Skip messages newer than  int  days.
+                       final stats (skipped) don't count newer messages
+                       You can do (+ are the messages selected):
+                       past|----maxage+++++++++++++++>now
+                       past|+++++++++++++++minage---->now
+                       past|----maxage+++++minage---->now (intersection)
+                       past|++++minage-----maxage++++>now (union)
+
+ --search       str  : Selects only messages returned by this IMAP SEARCH
+                       command. Applied on both sides.
+ --search1      str  : Same as --search for selecting host1 messages only.
+ --search2      str  : Same as --search for selecting host2 messages only.
+                       --search CRIT equals --search1 CRIT --search2 CRIT
+
+ --maxlinelength int : skip messages with a line length longer than  int  bytes.
+                       RFC 2822 says it must be no more than 1000 bytes.
+
+
+ --useheader    str  : Use this header to compare messages on both sides.
+                       Ex: Message-ID or Subject or Date.
+ --useheader    str    and this one, etc.
+
+ --usecache          : Use cache to speed up the sync.
+ --nousecache        : Do not use cache. Caveat: --useuid --nousecache creates
+                       duplicates on multiple runs.
+ --useuid            : Use uid instead of header as a criterium to recognize
+                       messages. Option --usecache is then implied unless
+                       --nousecache is used.
+
+
+=head2 OPTIONS/miscelaneous
+
+ --syncacls          : Synchronizes acls (Access Control Lists).
+ --nosyncacls        : Does not synchronize acls. This is the default.
+                       Acls in IMAP are not standardized, be careful.
+
+
+
+=head2 OPTIONS/debugging
+
+ --debug             : Debug mode.
+ --debugfolders      : Debug mode for the folders part only.
+ --debugcontent      : Debug content of the messages transferred. Huge output.
+ --debugflags        : Debug mode for flags.
+ --debugimap1        : IMAP debug mode for host1. Very verbose.
+ --debugimap2        : IMAP debug mode for host2. Very verbose.
+ --debugimap         : IMAP debug mode for host1 and host2.
+ --debugmemory       : Debug mode showing memory consumption after each copy.
+
+ --errorsmax     int : Exit when int number of errors is reached. Default is 50.
+
+ --tests             : Run local non-regression tests. Exit code 0 means all ok.
+ --testslive         : Run a live test with test1.lamiral.info imap server.
+                       Useful to check the basics. Needs internet connexion.
+ --testslive6        : Run a live test with ks2ipv6.lamiral.info imap server.
+                       Useful to check the ipv6 connectivity. Needs internet.
+
+
+=head2 OPTIONS/specific 
+
+  --gmail1           : sets --host1 to Gmail and options from FAQ.Gmail.txt
+  --gmail2           : sets --host2 to Gmail and options from FAQ.Gmail.txt
+  
+  --office1          : sets --host1 to Office365 options from FAQ.Exchange.txt
+  --office2          : sets --host2 to Office365 options from FAQ.Exchange.txt
+
+  --exchange1        : sets options from FAQ.Exchange.txt, account1 part
+  --exchange2        : sets options from FAQ.Exchange.txt, account2 part
+  
+  --domino1          : sets options from FAQ.Domino.txt, account1 part
+  --domino2          : sets options from FAQ.Domino.txt, account2 part
+  
+  
+  
+
+=head2 OPTIONS/behavior 
+
+ --maxmessagespersecond int : limits the number of messages transferred per second.
+ 
+ --maxbytespersecond int : limits the average transfer rate per second.
+ --maxbytesafter     int : starts --maxbytespersecond limitation only after 
+                           --maxbytesafter amount of data transferred.
+ 
+ --maxsleep      int : do not sleep more than int seconds.
+                       On by default, 2 seconds max, like --maxsleep 2
+
+ --abort             : terminates a previous call still running. 
+                       It uses the pidfile to know what processus to abort.
+
+ --exitwhenover int  : Stop syncing when total bytes transferred reached.
+
+ --version           : Print only software version.
+ --noreleasecheck    : Do not check for new imapsync release (a http request).
+ --releasecheck      : Check for new imapsync release (a http request).
+ --noid              : Do not send/receive ID command to imap servers.
+ --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       : Do only things about folders (ignore messages).
+
+ --help              : print this help.
+
+ Example: to synchronize imap account "test1" on "test1.lamiral.info"
+                     to  imap account "test2" on "test2.lamiral.info"
+                     with test1 password "secret1"
+                     and  test2 password "secret2"
+
+ imapsync \
+    --host1 test1.lamiral.info --user1 test1 --password1 secret1 \
+    --host2 test2.lamiral.info --user2 test2 --password2 secret2
+
+
+=cut
+# comment
+
+=pod
+
+
+
+=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.
+
+Imapsync activates ssl or tls encryption by default, if possible. 
+What details are under this "if possible"? 
+Imapsync activates ssl if the well known port imaps port (993) is open 
+on the imap servers. If the imaps port is closed then it open a 
+normal (clear) connection on port 143 but it looks for TLS support 
+in the CAPABILITY list of the servers. If TLS is supported 
+then imapsync goes to encryption.
+
+If the automatic ssl/tls detection fails then imapsync will
+not protect against sniffing activities on the
+network, especially for passwords.
+
+See also the document FAQ.Security.txt in the FAQ.d/ directory
+or at https://imapsync.lamiral.info/FAQ.d/FAQ.Security.txt
+
+=head1 EXIT STATUS
+
+Imapsync will exit with a 0 status (return code) if everything went good.
+Otherwise, it exits with a non-zero status.
+
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Imapsync is free, open, public but not always gratis software
+cover by the NOLIMIT Public License.
+See the LICENSE file included in the distribution or just read this
+simple sentence as it IS the licence text:
+
+ "No limit to do anything with this work and this license."
+
+In case it is not long enough, I repeat:
+
+ "No limit to do anything with this work and this license."
+
+https://imapsync.lamiral.info/LICENSE
+
+=head1 AUTHOR
+
+Gilles LAMIRAL 
+
+Feedback good or bad is very often welcome.
+
+Gilles LAMIRAL earns his living by writing, installing,
+configuring and teaching free, open and often gratis
+software. Imapsync used to be "always gratis" but now it is
+only "often gratis" because imapsync is sold by its author, 
+a good way to maintain and support free open public
+software over decades.
+
+=head1 BUGS AND LIMITATIONS
+
+See https://imapsync.lamiral.info/FAQ.d/FAQ.Reporting_Bugs.txt
+
+=head1 IMAP SERVERS supported
+
+See https://imapsync.lamiral.info/S/imapservers.shtml
+
+=head1 HUGE MIGRATION
+
+Pay special attention to options
+--subscribed
+--subscribe
+--delete1
+--delete2
+--delete2folders
+--maxage
+--minage
+--maxsize
+--useuid
+--usecache
+
+If you have many mailboxes to migrate think about a little
+shell program. Write a file called file.txt (for example)
+containing users and passwords.
+The separator used in this example is ';'
+
+The file.txt file contains:
+
+user001_1;password001_1;user001_2;password001_2
+user002_1;password002_1;user002_2;password002_2
+user003_1;password003_1;user003_2;password003_2
+user004_1;password004_1;user004_2;password004_2
+user005_1;password005_1;user005_2;password005_2
+...
+
+On Unix the shell program can be:
+
+ { while IFS=';' read  u1 p1 u2 p2; do
+        imapsync --host1 imap.side1.org --user1 "$u1" --password1 "$p1" \
+                 --host2 imap.side2.org --user2 "$u2" --password2 "$p2" ...
+ done ; } < file.txt
+
+On Windows the batch program can be:
+
+  FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO imapsync ^
+  --host1 imap.side1.org --user1 %%G --password1 %%H ^
+  --host2 imap.side2.org --user2 %%I --password2 %%J ...
+
+The ... have to be replaced by nothing or any imapsync option.
+Welcome in shell or batch programming !
+
+You will find already written scripts at
+http://imapsync.lamiral.info/examples/
+
 =head1 INSTALL
 
  Imapsync works under any Unix with perl.
@@ -72,598 +607,14 @@ a host, a username, and a password, two times.
 =head1 CONFIGURATION
 
 There is no specific configuration file for imapsync,
-everything is specified by the command line parameteres
+everything is specified by the command line parameters
 and the default behavior.
 
-=head1 USAGE
-
-To get a description of each option just run imapsync
-with no argument, like this:
-
-  imapsync
-
-This description of options is also available at
-http://imapsync.lamiral.info/OPTIONS and is
-reproduced here:
-
- usage: ./imapsync [options]
-
- Several options are mandatory.
- str means string
- int means integer
- reg means regular expression
- cmd means command
-
- --dry               : Makes imapsync doing nothing, just print what would
-                       be done without --dry.
-
- --host1        str  : Source or "from" imap server. Mandatory.
- --port1        int  : Port to connect on host1. Default is 143, 993 if --ssl1
- --user1        str  : User to login on host1. Mandatory.
- --showpasswords     : Shows passwords on output instead of "MASKED".
-                       Useful to restart a complete run by just reading the log.
- --password1    str  : Password for the user1.
- --host2        str  : "destination" imap server. Mandatory.
- --port2        int  : Port to connect on host2. Default is 143, 993 if --ssl2
- --user2        str  : User to login on host2. Mandatory.
- --password2    str  : Password for the user2.
-
- --passfile1    str  : Password file for the user1. It must contain the
-                       password on the first line. This option avoids to show
-                       the password on the command line like --password1 does.
- --passfile2    str  : Password file for the user2. Contains the password.
-
- --ssl1              : Use a SSL connection on host1.
- --ssl2              : Use a SSL connection on host2.
- --tls1              : Use a TLS connection on host1.
- --tls2              : Use a TLS connection on host2.
- --debugssl     int  : SSL debug mode from 0 to 4.
- --sslargs1     str  : Pass any ssl parameter for host1 ssl or tls connection. Example:
-                       --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3
-                       See all possibilities in the new() method of IO::Socket::SSL
-                       http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods
- --sslargs2     str  : Pass any ssl parameter for host2 ssl or tls connection.
-                       See --sslargs1
-
- --timeout1     int  : Connection timeout in seconds for host1.
-                       Default is 120 and 0 means no timeout at all.
- --timeout2     int  : Connection timeout in seconds for host2.
-                       Default is 120 and 0 means no timeout at all.
-
- --authmech1    str  : Auth mechanism to use with host1:
-                       PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
- --authmech2    str  : Auth mechanism to use with host2. See --authmech1
-
- --authuser1    str  : User to auth with on host1 (admin user).
-                       Avoid using --authmech1 SOMETHING with --authuser1.
- --authuser2    str  : User to auth with on host2 (admin user).
- --proxyauth1        : Use proxyauth on host1. Requires --authuser1.
-                       Required by Sun/iPlanet/Netscape IMAP servers to
-                       be able to use an administrative user.
- --proxyauth2        : Use proxyauth on host2. Requires --authuser2.
-
- --authmd51          : Use MD5 authentification for host1.
- --authmd52          : Use MD5 authentification for host2.
- --domain1      str  : Domain on host1 (NTLM authentication).
- --domain2      str  : Domain on host2 (NTLM authentication).
-
-
- --folder       str  : Sync this folder.
- --folder       str  : and this one, etc.
- --folderrec    str  : Sync this folder recursively.
- --folderrec    str  : and this one, etc.
-
- --folderfirst  str  : Sync this folder first. --folderfirst "Work"
- --folderfirst  str  : then this one, etc.
- --folderlast   str  : Sync this folder last. --folderlast "[Gmail]/All Mail"
- --folderlast   str  : then this one, etc.
-
- --nomixfolders      : Do not merge folders when host1 is case sensitive
-                       while host2 is not (like Exchange). Only the first
-                       similar folder is synced (ex: Sent SENT sent -> Sent).
-
- --skipemptyfolders  : Empty host1 folders are not created on host2.
-
- --f1f2    str1=str2 : Force folder str1 to be synced to str2.
- --include      reg  : Sync folders matching this regular expression
- --include      reg  : or this one, etc.
-                       in case both --include --exclude options are
-                       use, include is done before.
- --exclude      reg  : Skips folders matching this regular expression
-                       Several folders to avoid:
-                        --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
- --exclude      reg  : or this one, etc.
-
- --subfolder2   str  : Move whole host1 folders hierarchy under this
-                       host2 folder  str    .
-                       It does it by adding two --regextrans2 options before
-                       all others. Add --debug to see what's really going on.
-
- --regextrans2  reg  : Apply the whole regex to each destination folders.
- --regextrans2  reg  : 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.
-                       Have in mind that --regextrans2 is applied after prefix
-                       and separator inversion.
-
- --tmpdir       str  : Where to store temporary files and subdirectories.
-                       Will be created if it doesn't exist.
-                       Default is system specific, Unix is /tmp but
-                       it's often small and deleted at reboot.
-                       --tmpdir /var/tmp should be better.
- --pidfile      str  : The file where imapsync pid is written.
- --pidfilelocking    : Abort if pidfile already exists. Usefull to avoid
-                       concurrent transfers on the same mailbox.
-
- --nolog             : Turn off logging on file
- --logfile      str  : Change the default log filename (can be dirname/filename).
- --logdir       str  : Change the default log directory. Default is LOG_imapsync
-
- --prefix1      str  : Remove prefix to all destination folders
-                       (usually INBOX. or INBOX/ or an empty string "")
-                       you have to use --prefix1 if host1 imap server
-                       does not have NAMESPACE capability, so imapsync
-                       suggests to use it. All other cases are bad.
- --prefix2      str  : Add prefix to all host2 folders. See --prefix1
- --sep1         str  : Host1 separator in case NAMESPACE is not supported.
- --sep2         str  : Host2 separator in case NAMESPACE is not supported.
-
- --skipmess     reg  : Skips messages maching the regex.
-                       Example: 'm/[\x80-ff]/' # to avoid 8bits messages.
-                       --skipmess is applied before --regexmess
- --skipmess     reg  : or this one, etc.
-
- --pipemess     cmd  : Apply this cmd command to each message content
-                       before the copy.
- --pipemess     cmd  : and this one, etc.
-
- --disarmreadreceipts : Disarms read receipts (host2 Exchange issue)
-
- --regexmess    reg  : Apply the whole regex to each message before transfer.
-                       Example: 's/\000/ /g' # to replace null by space.
- --regexmess    reg  : and this one, etc.
-
- --regexflag    reg  : Apply the whole regex to each flags list.
-                       Example: 's/"Junk"//g' # to remove "Junk" flag.
- --regexflag    reg  : and this one, etc.
-
- --delete            : Deletes messages on host1 server after a successful
-                       transfer. Option --delete has the following behavior:
-                       it marks messages as deleted with the IMAP flag
-                       \Deleted, then messages are really deleted with an
-                       EXPUNGE IMAP command.
-
- --delete2           : Delete messages in host2 that are not in
-                       host1 server. Useful for backup or pre-sync.
- --delete2duplicates : Delete messages in host2 that are duplicates.
-                       Works only without --useuid since duplicates are
-                       detected with an header part of each message.
-
- --delete2folders    : Delete folders in host2 that are not in host1 server.
-                       For safety, first try it like this (it is safe):
-                       --delete2folders --dry --justfolders --nofoldersizes
- --delete2foldersonly   reg : Deleted only folders matching regex.
-                              Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/"
- --delete2foldersbutnot reg : Do not delete folders matching regex.
-                              Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/"
- --noexpunge         : Do not expunge messages on host1.
-                       Expunge really deletes messages marked deleted.
-                       Expunge is made at the beginning, on host1 only.
-                       Newly transferred messages are also expunged if
-                       option --delete is given.
-                       No expunge is done on host2 account (unless --expunge2)
- --expunge1          : Expunge messages on host1 after messages transfer.
- --expunge2          : Expunge messages on host2 after messages transfer.
- --uidexpunge2       : uidexpunge messages on the host2 account
-                       that are not on the host1 account, requires --delete2
- --nomixfolders      : Avoid merging folders that are considered different on
-                       host1 but the same on destination host2 because of
-                       case sensitivities and insensitivities.
-
- --syncinternaldates : Sets the internal dates on host2 same as host1.
-                       Turned on by default. Internal date is the date
-                       a message arrived on a host (mtime).
- --idatefromheader   : Sets the internal dates on host2 same as the
-                       "Date:" headers.
-
- --maxsize      int  : Skip messages larger  (or equal) than  int  bytes
- --minsize      int  : Skip messages smaller (or equal) than  int  bytes
- --maxage       int  : Skip messages older than  int  days.
-                       final stats (skipped) don't count older messages
-                       see also --minage
- --minage       int  : Skip messages newer than  int  days.
-                       final stats (skipped) don't count newer messages
-                       You can do (+ are the messages selected):
-                       past|----maxage+++++++++++++++>now
-                       past|+++++++++++++++minage---->now
-                       past|----maxage+++++minage---->now (intersection)
-                       past|++++minage-----maxage++++>now (union)
-
- --search       str  : Selects only messages returned by this IMAP SEARCH
-                       command. Applied on both sides.
- --search1      str  : Same as --search for selecting host1 messages only.
- --search2      str  : Same as --search for selecting host2 messages only.
-                       --search CRIT equals --search1 CRIT --search2 CRIT
-
- --exitwhenover int  : Stop syncing when total bytes transferred reached.
-                       Gmail per day allows
-                       2500000000 = 2.5 GB downloaded from Gmail as host2
-                        500000000 = 500 MB uploaded to Gmail as host1.
-
- --maxlinelength int : skip messages with a line length longer than  int  bytes.
-                       RFC 2822 says it must be no more than 1000 bytes.
-
- --useheader    str  : Use this header to compare messages on both sides.
-                       Ex: Message-ID or Subject or Date.
- --useheader    str    and this one, etc.
-
- --subscribed        : Transfers subscribed folders.
- --subscribe         : Subscribe to the folders transferred on the
-                       host2 that are subscribed on host1. On by default.
- --subscribeall      : Subscribe to the folders transferred on the
-                       host2 even if they are not subscribed on host1.
-
- --nofoldersizes     : Do not calculate the size of each folder in bytes
-                       and message counts. Default is to calculate them.
- --nofoldersizesatend: Do not calculate the size of each folder in bytes
-                       and message counts at the end. Default is on.
- --justfoldersizes   : Exit after having printed the folder sizes.
-
- --syncacls          : Synchronises acls (Access Control Lists).
- --nosyncacls        : Does not synchronize acls. This is the default.
-                       Acls in IMAP are not standardized, be careful.
-
- --usecache          : Use cache to speedup.
- --nousecache        : Do not use cache. Caveat: --useuid --nousecache creates
-                       duplicates on multiple runs.
- --useuid            : Use uid instead of header as a criterium to recognize
-                       messages. Option --usecache is then implied unless
-                       --nousecache is used.
-
- --debug             : Debug mode.
- --debugfolders      : Debug mode for the folders part only.
- --debugcontent      : Debug content of the messages transfered. Huge ouput.
- --debugflags        : Debug mode for flags.
- --debugimap1        : IMAP debug mode for host1. Very verbose.
- --debugimap2        : IMAP debug mode for host2. Very verbose.
- --debugimap         : IMAP debug mode for host1 and host2.
- --debugmemory       : Debug mode showing memory consumption after each copy.
-
- --errorsmax     int : Exit when int number of errors is reached. Default is 50.
-
- --tests             : Run local non-regression tests. Exit code 0 means all ok.
- --testslive         : Run a live test with test1.lamiral.info imap server.
-                       Useful to check the basics. Needs internet connexion.
-
- --version           : Print only software version.
- --noreleasecheck    : Do not check for new imapsync release (a http request).
- --releasecheck      : Check for new imapsync release (a http request).
- --noid              : Do not send/receive ID command to imap servers.
- --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       : Do only things about folders (ignore messages).
-
- --help              : print this help.
-
- Example:
- To synchronize the source imap account
-   "test1" on server "test1.lamiral.info" with password "secret1"
- to the destination imap account
-   "test2" on server "test2.lamiral.info" with password "secret2"
- do:
-
- imapsync \
-    --host1 test1.lamiral.info --user1 test1 --password1 secret1 \
-    --host2 test2.lamiral.info --user2 test2 --password2 secret2
-
-=cut
-# comment
-
-=pod
-
-=head1 DESCRIPTION
-
-Imapsync command is a tool allowing incremental and
-recursive imap transfers from one mailbox to another.
-
-By default all folders are transferred, recursively, all
-possible flags (\Seen \Answered \Flagged etc.) are synced too.
-
-We sometimes need to transfer mailboxes from one imap server to
-another. This is called migration.
-
-Imapsync reduces the amount
-of data transferred by not transferring a given message
-if it resides already on both sides. Same specific headers
-and the transfer is done only once; taken into account are by default
-Message-Id and Received header lines.
-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 and interruptions.
-
-You can decide to delete the messages from the source mailbox
-after a successful transfer, it can be a good feature when migrating
-live mailboxes since messages will be only on one side.
-In that case, use the --delete option. Option --delete implies
-also option --expunge so all messages marked deleted on host1
-will be really deleted.
-(you can use --noexpunge to avoid this but I don't see any
-good real world scenario for the combination --delete --noexpunge).
-
-A different scenario is synchronizing a mailbox B from another mailbox A
-in case you just want to keep a "live" copy of A in B.
-In that case --delete2 has to be used, it deletes messages in host2
-folder B that are not in host1 folder A. If you also need to destroy
-host2 folders that are not in host1 then use --delete2folders (see also
---delete2foldersonly and --delete2foldersbutnot).
-
-Imapsync is not adequate for maintaining two active imap accounts
-in synchronization when the user plays independently on both sides.
-Use offlineimap (written by John Goerzen) or mbsync (written by
-Michael R. Elkins) for 2 ways synchronizations.
-
-
-=head1 OPTIONS
-
-To get a description of each option just invoke:
-
-  imapsync
-
-or read the previous section named USAGE,
-
-or read http://imapsync.lamiral.info/OPTIONS
-
-=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 its 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.
-Authenticate with an admin account must be supported by your
-imap server to work with imapsync.
-
-When working on Sun/iPlanet/Netscape IMAP servers you must use
---proxyauth1 to enable administrative user to masquerade as another user.
-Can also be used on destination server with --proxyauth2
-
-You can authenticate with OAUTH when transfering from Google Apps.
-The consumer key will be the domain part of the --user, and the
---password will be used as the consumer secret. It does not work
-with Google Apps free edition.
-
-=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 AND COPYRIGHT
-
-imapsync is free, open, public but not always gratis software
-cover by the NOLIMIT Public License.
-See the LICENSE file included in the distribution or just read this
-simple sentence as it is the licence text:
-
- "No limit to do anything with this work and this license."
-
-In case it is not long enough I repeat:
-
- "No limit to do anything with this work and this license."
-
-=head1 MAILING-LIST
-
-The public mailing-list may be the best way to get free support.
-
-To write on the mailing-list, the address is:
-
-
-To subscribe, send any message (even empty) to:
-
-then just reply to the confirmation message.
-
-To unsubscribe, send a message to:
-
-
-To contact the person in charge for the list:
-
-
-The list archives are 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 very often welcome.
-
-Gilles LAMIRAL earns his living by writing, installing,
-configuring and teaching free, open and often gratis
-softwares. It used to be "always gratis" but now it is
-"often" because imapsync is sold by its author, a good
-way to stay maintening and supporting free open public
-softwares (see the license) over decades.
-
-=head1 BUGS AND LIMITATIONS
-
-Help me 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 FAQs, the README and the
-TODO files. http://imapsync.lamiral.info/
-
-Upgrade to last imapsync release, maybe the bug
-is already fixed.
-
-Upgrade to last Mail-IMAPClient Perl module.
-http://search.cpan.org/dist/Mail-IMAPClient/
-maybe the bug is already fixed there.
-
-Make a good title with word "imapsync" in it (my spam filters won't filter it),
-Try to write an email title with more words than just "imapsync" or "problem",
-a good title is made of keywords summary, but not too long (one visible line).
-
-Help us to help you: in your report, please include:
-
- - imapsync version.
-
- - output near the first failures, a few lines before is good to get the context
-   of the issue. First failures messages are often more significant than
-   the last ones.
-
- - if the issue is always related to the same messages, include the output
-   with --debug --debugimap, near the failure point. For example,
-   Isolate a buggy message or two in a folder 'BUG' and use
-
-     imapsync ... --folder 'BUG' --debug --debugimap
-
- - imap server softwares on both sides and their version number.
-
- - imapsync with all the options you use,  the full command line
-   you use (except the passwords of course).
-
- - IMAPClient.pm version.
-
- - the run context. Do you run imapsync.exe, a unix binary
-   or the perl script imapsync.
-
- - operating system running imapsync.
-
- - virtual software context (vmware, xen etc.)
-
- - operating systems on both sides and the third side in case
-   you run imapsync on a foreign host from the both.
-
-Most of those values can be found as a copy/paste at the begining of the output,
-so a carbon copy of the output is a very easy and very good debug report for me.
-
-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
-
-See http://imapsync.lamiral.info/S/imapservers.shtml
-
-=head1 HUGE MIGRATION
-
-Pay special attention to options
---subscribed
---subscribe
---delete
---delete2
---delete2folders
---maxage
---minage
---maxsize
---useuid
---usecache
-
-If you have many mailboxes to migrate think about a little
-shell program. Write a file called file.txt (for example)
-containing users and passwords.
-The separator used in this example is ';'
-
-The file.txt file contains:
-
-user001_1;password001_1;user001_2;password001_2
-user002_1;password002_1;user002_2;password002_2
-user003_1;password003_1;user003_2;password003_2
-user004_1;password004_1;user004_2;password004_2
-user005_1;password005_1;user005_2;password005_2
-...
-
-On Unix the shell program can be:
-
- { while IFS=';' read  u1 p1 u2 p2; do
-	imapsync --host1 imap.side1.org --user1 "$u1" --password1 "$p1" \
-                 --host2 imap.side2.org --user2 "$u2" --password2 "$p2" ...
- done ; } < file.txt
-
-On Windows the batch program can be:
-
-  FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO imapsync ^
-  --host1 imap.side1.org --user1 %%G --password1 %%H ^
-  --host2 imap.side2.org --user2 %%I --password2 %%J ...
-
-The ... have to be replaced by nothing or any imapsync option.
-Welcome in shell programming !
-
-You will find already written scripts at
-http://imapsync.lamiral.info/examples/
-
 
 =head1 HACKING
 
 Feel free to hack imapsync as the NOLIMIT license permits it.
 
-=head1 LINKS
-
-Entries for imapsync:
-https://web.archive.org/web/20070202005121/http://www.imap.org/products/showall.php
 
 =head1 SIMILAR SOFTWARES
 
@@ -686,7 +637,18 @@ https://web.archive.org/web/20070202005121/http://www.imap.org/products/showall.
 
 Feedback (good or bad) will often be welcome.
 
-$Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $
+=head1 HISTORY
+
+I wrote imapsync because an enterprise (basystemes) paid me to install
+a new imap server without losing huge old mailboxes located in 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 then delete it after a good
+transfer. Imapsync started its life as a patch of the copy_folder.pl 
+script. The script copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl
+module tarball source (more precisely in the examples/ directory of the 
+Mail-IMAPClient tarball).
+
 
 =cut
 
@@ -695,11 +657,9 @@ $Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $
 
 use strict ;
 use warnings ;
-++$| ;
-
 use Carp ;
 use Data::Dumper ;
-use Digest::HMAC_SHA1 qw( hmac_sha1 ) ;
+use Digest::HMAC_SHA1 qw( hmac_sha1 hmac_sha1_hex ) ;
 use Digest::MD5  qw( md5 md5_hex md5_base64 ) ;
 use English qw( -no_match_vars ) ;
 use Errno qw(EAGAIN EPIPE ECONNRESET) ;
@@ -710,15 +670,18 @@ use File::Glob qw( :glob ) ;
 use File::Path qw( mkpath rmtree ) ;
 use File::Spec ;
 use File::stat ;
-#use Imapsync::Getopt::Long ;
+use Getopt::Long (  ) ;
 use IO::File ;
-use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE) ;
-#use IO::Socket::SSL ;
+use IO::Socket qw( :crlf SOL_SOCKET SO_KEEPALIVE ) ;
+use IO::Socket::INET6 ;
+use IO::Socket::SSL ;
 use IO::Tee ;
 use IPC::Open3 'open3' ;
 use Mail::IMAPClient 3.30 ;
 use MIME::Base64 ;
+use Pod::Usage qw(pod2usage) ;
 use POSIX qw(uname SIGALRM) ;
+use Sys::Hostname ;
 use Term::ReadKey ;
 use Test::More ;
 use Time::HiRes qw( time sleep ) ;
@@ -726,6 +689,10 @@ use Time::Local ;
 use Unicode::String ;
 use Cwd ;
 use Readonly ;
+#use Net::Ping ;
+use Sys::MemInfo ;
+
+local $OUTPUT_AUTOFLUSH = 1 ;
 
 # constants
 
@@ -735,10 +702,10 @@ use Readonly ;
 Readonly my $EX_OK          => 0  ; #/* successful termination */
 Readonly my $EX_USAGE       => 64 ; #/* command line usage error */
 #Readonly my $EX_DATAERR     => 65 ; #/* data format error */
-#Readonly my $EX_NOINPUT     => 66 ; #/* cannot open input */
+Readonly my $EX_NOINPUT     => 66 ; #/* cannot open input */
 #Readonly my $EX_NOUSER      => 67 ; #/* addressee unknown */
 #Readonly my $EX_NOHOST      => 68 ; #/* host name unknown */
-#Readonly my $EX_UNAVAILABLE => 69 ; #/* service unavailable */
+Readonly my $EX_UNAVAILABLE => 69 ; #/* service unavailable */
 Readonly my $EX_SOFTWARE    => 70 ; #/* internal software error */
 #Readonly my $EX_OSERR       => 71 ; #/* system error (e.g., can't fork) */
 #Readonly my $EX_OSFILE      => 72 ; #/* critical OS file missing */
@@ -752,11 +719,17 @@ Readonly my $EX_SOFTWARE    => 70 ; #/* internal software error */
 # Mine
 Readonly my $EXIT_BY_SIGNAL              =>   6 ;
 Readonly my $EXIT_PID_FILE_ALREADY_EXIST =>   8 ;
+
 Readonly my $EXIT_WITH_ERRORS            => 111 ;
 Readonly my $EXIT_WITH_ERRORS_MAX        => 112 ;
 Readonly my $EXIT_UNKNOWN                => 126 ;
 
-Readonly my $ERRORS_MAX =>  50 ; # exit after 50 errors.
+Readonly my $EXIT_TESTS_FAILED           => 254 ; # Like Test::More API
+
+
+
+Readonly my $ERRORS_MAX     =>  50 ; # exit after 50 errors.
+Readonly my $ERRORS_MAX_CGI =>  20 ; # exit after 20 errors in CGI context.
 
 
 Readonly my $INTERVAL_TO_EXIT => 2 ; # interval max to exit instead of reconnect
@@ -768,18 +741,20 @@ Readonly my $SPLIT_FACTOR =>  10 ; # init_imap() calls Maxcommandlength( $SPLIT_
 Readonly my $IMAP_PORT     => 143 ; # Well know port for IMAP
 Readonly my $IMAP_SSL_PORT => 993 ; # Well know port for IMAP over SSL
 
-Readonly my $LAST => -1 ; 
-Readonly my $MINUS_ONE => -1 ; 
+Readonly my $LAST => -1 ;
+Readonly my $MINUS_ONE => -1 ;
 
-Readonly my $RELEASE_NUMBER_EXAMPLE_1 => '1.351' ; 
+Readonly my $RELEASE_NUMBER_EXAMPLE_1 => '1.351' ;
 Readonly my $RELEASE_NUMBER_EXAMPLE_2 => 42.4242 ;
 
-
+Readonly my $TCP_PING_TIMEOUT => 5 ;
 Readonly my $DEFAULT_TIMEOUT => 120 ;
 Readonly my $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND => 3 ;
-Readonly my $DEFAULT_UIDNEXT => 999999 ;
+Readonly my $DEFAULT_UIDNEXT => 999_999 ;
 Readonly my $DEFAULT_BUFFER_SIZE => 4096 ;
 
+Readonly my $MAX_SLEEP => 2 ; # 2 seconds max for limiting too long sleeps from --maxbytespersecond and --maxmessagespersecond
+
 Readonly my $DEFAULT_EXPIRATION_TIME_OAUTH2_PK12 => 3600 ;
 
 Readonly my $PERMISSION_FILTER => 7777 ;
@@ -796,11 +771,11 @@ Readonly my $NUMBER_20_000 => 20_000 ;
 
 Readonly my $QUOTA_PERCENT_LIMIT => 90 ;
 
-Readonly my $NUMBER_104857600 => 104857600 ;
+Readonly my $NUMBER_104_857_600 => 104_857_600 ;
 
 Readonly my $SIZE_MAX_STR => 64 ;
 
-Readonly my $NB_SECONDS_IN_A_DAY => 86400 ;
+Readonly my $NB_SECONDS_IN_A_DAY => 86_400 ;
 
 Readonly my $STD_CHAR_PER_LINE => 80 ;
 
@@ -809,20 +784,22 @@ Readonly my $FALSE => 0 ;
 
 Readonly my $LAST_RESSORT_SEPARATOR => q{/} ;
 
+Readonly my $CGI_TMPDIR_TOP => '/var/tmp/imapsync_cgi' ;
+Readonly my $CGI_HASHFILE   => '/var/tmp/imapsync_hash' ;
+Readonly my $UMASK_PARANO   => '0077' ;
+
 # global variables
 
 my(
-	$sync,
-	$rcs,
+        $sync,
         $debug, $debugimap, $debugimap1, $debugimap2, $debugcontent, $debugflags,
         $debuglist, $debugdev, $debugmaxlinelength, @debugbasket, $debugcgi,
-        $host1, $host2, $port1, $port2,
-        $user1, $user2, $domain1, $domain2,
-        $password1, $password2, $passfile1, $passfile2,
+        $domain1, $domain2,
+        $passfile1, $passfile2,
         @folder, @include, @exclude, @folderrec,
         @folderfirst, @folderlast,
         $prefix1, $prefix2,
-	$subfolder2,
+        $subfolder2,
         @regextrans2, @regexmess, @regexflag, @skipmess, @pipemess, $pipemesscheck,
         $flagscase, $filterflags, $syncflagsaftercopy,
         $sep1, $sep2,
@@ -835,19 +812,16 @@ my(
         $search, $search1, $search2,
         $skipheader, @useheader,
         $skipsize, $allowsizemismatch, $foldersizes, $foldersizesatend, $buffersize,
-        $delete, $delete2, $delete2duplicates,
-        $expunge, $expunge1, $expunge2, $uidexpunge2, $dry,
+        $delete1, $delete2, $delete2duplicates,
+        $expunge1, $expunge2, $uidexpunge2,
         $justfoldersizes,
         $authmd5, $authmd51, $authmd52,
         $subscribed, $subscribe, $subscribeall,
         $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,
@@ -867,18 +841,14 @@ my(
         $h2_nb_msg_end, $h2_bytes_end,
 
         $timeout,
-        $timestart_int, $timeend,
+        $timestart_int,
         $timebefore,
-        $ssl1, $ssl2,
-        $ssl1_ssl_version, $ssl2_ssl_version,
-        $tls1, $tls2,
         $uid1, $uid2,
         $authuser1, $authuser2,
         $proxyauth1, $proxyauth2,
         $authmech1, $authmech2,
         $split1, $split2,
         $reconnectretry1, $reconnectretry2,
-        $tests, $test_builder, $testsdebug, $testslive,
         $justlogin,
         $tmpdir,
         $releasecheck,
@@ -891,8 +861,6 @@ my(
         %h1, %h2,
         $checkselectable, $checkmessageexists,
         $expungeaftereach,
-        $abletosearch,
-        $showpasswords,
         $fixslash2,
         $messageidnodomain,
         $fixInboxINBOX,
@@ -901,24 +869,36 @@ my(
         $uidnext_default,
         $fixcolonbug,
         $create_folder_old,
-        $maxmessagespersecond,
-        $maxbytespersecond,
         $skipcrossduplicates, $debugcrossduplicates,
         $disarmreadreceipts,
         $mixfolders, $skipemptyfolders,
-	$fetch_hash_set,
+        $fetch_hash_set,
 );
 
-# main program
 
+# main program
 # global variables initialisation
 
-$rcs = q{$Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $} ;
+# Currently removing all global variables except $sync
+# passing each of them under $sync->{variable_name}
 
-$total_bytes_transferred   = 0;
+$sync->{timestart} = time ; # Is a float because of use Time::HiRres
+
+$sync->{rcs} = q{$Id: imapsync,v 1.836 2017/09/05 16:14:53 gilles Exp gilles $} ;
+
+
+
+my @loadavg = loadavg(  ) ;
+$sync->{cpu_number} = cpu_number(  ) ;
+$sync->{loaddelay} = load_and_delay( $sync->{cpu_number}, @loadavg ) ;
+$sync->{loadavg} = join( q{ }, @loadavg ) . " on $sync->{cpu_number} cores." ;
+
+
+
+$sync->{total_bytes_transferred} = 0 ;
 $total_bytes_skipped = 0;
 $total_bytes_error   = 0;
-$nb_msg_transferred = 0;
+$sync->{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;
@@ -952,30 +932,54 @@ my %month_abrev = (
 );
 
 
+my $cgidir ;
 
+# CGI environment in case
+cgibegin( $sync ) ;
+# In cgi context, printing must start by the header so we delay other prints by using output() storage
+my $options_good = get_options( $sync, @ARGV ) ;
+docker_context( $sync ) ;
+cgibuildheader( $sync ) ;
+myprint( output( $sync ) ) ;
+output_reset_with( $sync ) ;
 
-# @ARGV will be eat by get_options()
-my @argv_copy = @ARGV;
+# Can break here if load is too heavy
+cgiload( $sync ) ;
 
-my $cgi_dir = '/var/tmp/imapsync_cgi' ;
+# don't go on if options are not all known.
+if ( ! defined $options_good ) { exit $EX_USAGE ; }
 
-# Under CGI environment
-if ( $ENV{SERVER_SOFTWARE} ) {
-        myprint( "\n" ) ;
-        myprint( "
              \n" ) ;
-        -d $cgi_dir or mkpath $cgi_dir or die "Can not create $cgi_dir: $!\n" ;
-        chdir  $cgi_dir or die "Can not cd to $cgi_dir: $!\n" ;
+# just the version
+myprint( imapsync_version( $sync ), "\n" ) and exit 0 if ( $version ) ;
+
+$sync->{debugenv} and printenv( $sync ) ; # if option --debugenv
+load_modules(  ) ;
+
+# after_get_options call usage and exit if --help or options were not well got
+after_get_options( $options_good ) ;
+
+# Under CGI environment, fix caveat emptor potentiel issues
+cgisetcontext( $sync ) ;
+
+easyany( $sync ) ;
+
+$tmpdir ||= File::Spec->tmpdir(  ) ;
+
+# Unit tests
+testsexit( $sync ) ;
+
+# init live varaiables
+testslive( $sync ) if ( $sync->{testslive} ) ;
+testslive6( $sync ) if ( $sync->{testslive6} )  ;
+
+#
+$sync->{pidfile} =  defined  $sync->{pidfile}  ? $sync->{pidfile} : $tmpdir . '/imapsync.pid' ;
+$sync->{pidfilelocking} = defined  $sync->{pidfilelocking}  ? $sync->{pidfilelocking} : 0 ;
+
+if ( $sync->{abort} ) {
+	abort( $sync ) ;
 }
 
-get_options(  ) ;
-unsetunsafe(  ) if ( $ENV{SERVER_SOFTWARE} ) ;
-
-# Under CGI environment
-if ( $ENV{SERVER_SOFTWARE} ) {
-        myprint( 'Current directory is ' . getcwd(  ) . "\n" ) ;
-        myprint( 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
-        myprint( 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;
-}
 
 local $SIG{ INT } = sub {
         my $signame = shift ;
@@ -983,18 +987,15 @@ local $SIG{ INT } = sub {
 } ;
 
 local $SIG{ QUIT } = local $SIG{ TERM } = sub {
-	my $signame = shift ;
+        my $signame = shift ;
         catch_exit( $sync, $signame ) ;
 } ;
 
 
-$sync->{timestart} = $BASETIME ; # Never too let reading books and perlvar
-
 $sync->{log}        = defined $sync->{log}        ? $sync->{log}        :  1 ;
 $sync->{errorsdump} = defined $sync->{errorsdump} ? $sync->{errorsdump} :  1 ;
 $sync->{errorsmax}  = defined $sync->{errorsmax}  ? $sync->{errorsmax}  : $ERRORS_MAX ;
 
-$sync->{user2} = $user2 ;
 
 if ( $sync->{log} ) {
         setlogfile( $sync ) ;
@@ -1008,23 +1009,23 @@ my $timestart_str = localtime( $sync->{timestart} ) ;
 myprint( "Transfer started at $timestart_str\n" ) ;
 myprint( "PID is $PROCESS_ID\n" ) ;
 myprint( "Log file is $sync->{logfile} ( to change it, use --logfile path ; or use --nolog to turn off logging )\n" ) if ( $sync->{log} ) ;
+myprint( "Load is " . ( join( q{ }, loadavg(  ) ) || 'unknown' ), " on $sync->{cpu_number} cores\n" ) ;
+myprint( 'Current directory is ' . getcwd(  ) . "\n" ) ;
+myprint( 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
+myprint( 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;
+
 $modulesversion = defined  $modulesversion  ? $modulesversion : 1 ;
 
 # If you want releasecheck not to be done by default (like the github maintainer),
-# then uncomment the first "$releasecheck =" line, the line ending with "0 ;".
-# The second line (ending with "1 ;") can stay active or be commented,
-# the result will be the same: no releasecheck by default.
+# then just uncomment the first "$releasecheck =" line, the line ending with "0 ;",
+# the second line (ending with "1 ;") can then stay active or be commented,
+# the result will be the same: no releasecheck by default (because 0 is then defined value).
 
-$releasecheck = defined  $releasecheck  ? $releasecheck : 0 ;
-#$releasecheck = defined  $releasecheck  ? $releasecheck : 1 ;
+#$releasecheck = defined  $releasecheck  ? $releasecheck : 0 ;
+$releasecheck = defined  $releasecheck  ? $releasecheck : 1 ;
 
 my $warn_release = ( $releasecheck ) ? check_last_release(  ) : q{} ;
 
-# default values
-
-$sync->{pidfile} =  defined  $sync->{pidfile}  ? $sync->{pidfile} : $tmpdir . '/imapsync.pid' ;
-
-$sync->{pidfilelocking} = defined  $sync->{pidfilelocking}  ? $sync->{pidfilelocking} : 0 ;
 
 $wholeheaderifneeded  = defined  $wholeheaderifneeded   ? $wholeheaderifneeded  : 1;
 
@@ -1047,9 +1048,15 @@ $cacheaftercopy = 1 if ( $usecache and ( ! defined  $cacheaftercopy  ) ) ;
 $checkselectable    = defined  $checkselectable  ? $checkselectable : 1 ;
 $checkmessageexists = defined  $checkmessageexists  ? $checkmessageexists : 0 ;
 $expungeaftereach   = defined  $expungeaftereach  ? $expungeaftereach : 1 ;
-$abletosearch       = defined  $abletosearch  ? $abletosearch : 1 ;
-$checkmessageexists = 0 if ( not $abletosearch ) ;
-$showpasswords      = defined  $showpasswords  ? $showpasswords : 0 ;
+
+# abletosearch is on by default
+$sync->{abletosearch}    = defined  $sync->{abletosearch}   ? $sync->{abletosearch} : 1 ;
+$sync->{abletosearch1}   = defined  $sync->{abletosearch1}  ? $sync->{abletosearch1} : $sync->{abletosearch} ;
+$sync->{abletosearch2}   = defined  $sync->{abletosearch2}  ? $sync->{abletosearch2} : $sync->{abletosearch} ;
+$checkmessageexists      = 0 if ( not $sync->{abletosearch1} ) ;
+
+
+$sync->{showpasswords}   = defined  $sync->{showpasswords}  ? $sync->{showpasswords} : 0 ;
 $fixslash2          = defined  $fixslash2  ? $fixslash2 : 1 ;
 $fixInboxINBOX      = defined  $fixInboxINBOX  ? $fixInboxINBOX : 1 ;
 $create_folder_old  = defined  $create_folder_old  ? $create_folder_old : 0 ;
@@ -1058,62 +1065,49 @@ $sync->{automap}    = defined  $sync->{automap}  ? $sync->{automap} : 0 ;
 
 $delete2duplicates = 1 if ( $delete2 and ( ! defined  $delete2duplicates  ) ) ;
 
-$maxmessagespersecond = defined  $maxmessagespersecond  ? $maxmessagespersecond : 0 ;
-$maxbytespersecond    = defined  $maxbytespersecond     ? $maxbytespersecond    : 0 ;
+$sync->{maxmessagespersecond} = defined  $sync->{maxmessagespersecond}  ? $sync->{maxmessagespersecond} : 0 ;
+$sync->{maxbytespersecond}    = defined  $sync->{maxbytespersecond}     ? $sync->{maxbytespersecond}    : 0 ;
 
-myprint( banner_imapsync( @argv_copy ) ) ;
+$sync->{sslcheck} = defined $sync->{sslcheck} ? $sync->{sslcheck} : 1 ;
+
+myprint( banner_imapsync( @ARGV ) ) ;
 
 myprint( "Temp directory is $tmpdir  ( to change it use --tmpdir dirpath )\n") ;
+myprint( output( $sync ) ) ;
 
-is_valid_directory( $tmpdir ) || croak "Error creating tmpdir $tmpdir : $!" ;
+do_valid_directory( $tmpdir ) || croak "Error creating tmpdir $tmpdir : $OS_ERROR" ;
 
 if ( $sync->{pidfile} ) {
         write_pidfile( $sync->{pidfile}, $sync->{pidfilelocking} ) ;
 }
 
+if ( $sync->{simulong} ) { simulong( $sync->{simulong} ) ; }
+
+
+
 $fixcolonbug = defined  $fixcolonbug  ? $fixcolonbug : 1 ;
 
 if ( $usecache and $fixcolonbug ) { tmpdir_fix_colon_bug(  ) } ;
 
 $modulesversion and myprint( "Modules version list:\n", modulesversion(), "( use --no-modulesversion to turn off printing this Perl modules list )\n" ) ;
 
-my $DEFAULT_SSL_VERIFY ;
-my %SSL_VERIFY_STR ;
-
-if ( $ssl1 or $ssl2 or $tls1 or $tls2) {
-        Readonly $DEFAULT_SSL_VERIFY => IO::Socket::SSL::SSL_VERIFY_NONE(  ) ;
-        Readonly %SSL_VERIFY_STR => (
-                IO::Socket::SSL::SSL_VERIFY_NONE(  ) => 'SSL_VERIFY_NONE' ,
-                IO::Socket::SSL::SSL_VERIFY_PEER(  ) => 'SSL_VERIFY_PEER' ,
-        ) ;
-        $IO::Socket::SSL::DEBUG = $sync->{debugssl} || 1 ;
-        myprint( "SSL debug mode level is --debugssl $IO::Socket::SSL::DEBUG (can be set from 0 meaning no debug to 4 meaning max debug)\n" ) ;
-}
-
-if ( $ssl1 ) {
-        myprint( 'Host1: SSL default mode is like --sslargs1 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host1 (do not check the certificate server)\n" ) ;
-        myprint( 'Host1: Use --sslargs1 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host1\n" ) ;
-}
-if ( $ssl2 ) {
-        myprint( 'Host2: SSL default mode is like --sslargs2 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host2 (do not check the certificate server)\n" ) ;
-        myprint( 'Host2: Use --sslargs2 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host2\n" ) ;
-}
-
 
 check_lib_version(  ) or
   croak "imapsync needs perl lib Mail::IMAPClient release 3.30 or superior.\n";
 
 exit_clean( $sync, $EX_OK ) if ( $justbanner ) ;
 
+sslcheck( $sync ) ;
+
 
 $split1 ||= $SPLIT ;
 $split2 ||= $SPLIT ;
 
-$host1 || missing_option( '--host1' ) ;
-$port1 ||= ( $ssl1 ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
+$sync->{host1} || missing_option( '--host1' ) ;
+$sync->{port1} ||= ( $sync->{ssl1} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
 
-$host2 || missing_option( '--host2' ) ;
-$port2 ||= ( $ssl2 ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
+$sync->{host2} || missing_option( '--host2' ) ;
+$sync->{port2} ||= ( $sync->{ssl2} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
 
 $debugimap1 = $debugimap2 = 1 if ( $debugimap ) ;
 $debug = 1 if ( $debugimap1 or $debugimap2 ) ;
@@ -1129,30 +1123,60 @@ $subscribe = defined $subscribe ? $subscribe : 1;
 # Allow size mismatch by default
 $allowsizemismatch = defined $allowsizemismatch ? $allowsizemismatch : 1;
 
-$delete2folders = 1
-    if ( defined  $delete2foldersbutnot  or defined  $delete2foldersonly  ) ;
 
-if ( $justconnect ) {
-	justconnect(  ) ;
-	exit_clean( $sync, $EX_OK ) ;
+if ( defined  $delete2foldersbutnot  or defined  $delete2foldersonly  ) {
+	$delete2folders = 1 ;
 }
 
-$user1 || missing_option( '--user1' ) ;
-$user2 || missing_option( '--user2' ) ;
+my $DEFAULT_SSL_VERIFY ;
+my %SSL_VERIFY_STR ;
+
+Readonly $DEFAULT_SSL_VERIFY => IO::Socket::SSL::SSL_VERIFY_NONE(  ) ;
+Readonly %SSL_VERIFY_STR => (
+	IO::Socket::SSL::SSL_VERIFY_NONE(  ) => 'SSL_VERIFY_NONE' ,
+	IO::Socket::SSL::SSL_VERIFY_PEER(  ) => 'SSL_VERIFY_PEER' ,
+) ;
+$IO::Socket::SSL::DEBUG = $sync->{debugssl} || 1 ;
+
+
+
+if ( $sync->{ssl1} or $sync->{ssl2} or $sync->{tls1} or $sync->{tls2}) {
+        myprint( "SSL debug mode level is --debugssl $IO::Socket::SSL::DEBUG (can be set from 0 meaning no debug to 4 meaning max debug)\n" ) ;
+}
+
+if ( $sync->{ssl1} ) {
+        myprint( 'Host1: SSL default mode is like --sslargs1 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host1 (do not check the certificate server)\n" ) ;
+        myprint( 'Host1: Use --sslargs1 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host1\n" ) ;
+}
+
+if ( $sync->{ssl2} ) {
+        myprint( 'Host2: SSL default mode is like --sslargs2 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host2 (do not check the certificate server)\n" ) ;
+        myprint( 'Host2: Use --sslargs2 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host2\n" ) ;
+}
+
+
+
+if ( $justconnect ) {
+        justconnect(  ) ;
+        exit_clean( $sync, $EX_OK ) ;
+}
+
+$sync->{user1} || missing_option( '--user1' ) ;
+$sync->{user2} || missing_option( '--user2' ) ;
 
 $syncinternaldates = defined $syncinternaldates ? $syncinternaldates : 1;
 
-# Turn on expunge if there is not explicit option --noexpunge and option
-# --delete is given.
-# Done because --delete --noexpunge is very dangerous on the second run:
-# the Deleted flag is then synced to all previously transfered messages.
-# So --delete implies --expunge is a better usability default behaviour.
-if ( $delete ) {
-	if ( ! defined  $expunge  ) {
-		myprint( "Info: turning on --expunge1 because --delete --noexpunge1 is very dangerous on the second run.\n" ) ;
-		$expunge = 1 ;
-	}
-		myprint( "Info: if expunging after each message slows down too much the sync then use --noexpungeaftereach to speed up\n" ) ;
+# Turn on expunge if there is not explicit option --noexpunge1 and option
+# --delete1 is given.
+# Done because --delete1 --noexpunge1 is very dangerous on the second run:
+# the Deleted flag is then synced to all previously transferred messages.
+# So --delete1 implies --expunge1 is a better usability default behavior.
+if ( $delete1 ) {
+        if ( ! defined  $expunge1  ) {
+                myprint( "Info: turning on --expunge1 because --delete1 --noexpunge1 is very dangerous on the second run.\n" ) ;
+                $expunge1 = 1 ;
+        }
+                myprint( "Info: if expunging after each message slows down too much the sync then use --noexpungeaftereach to speed up\n" ) ;
 }
 
 if ( $uidexpunge2 and not Mail::IMAPClient->can( 'uidexpunge' ) ) {
@@ -1163,48 +1187,48 @@ if ( $uidexpunge2 and not Mail::IMAPClient->can( 'uidexpunge' ) ) {
 if ( ( $delete2 or $delete2duplicates ) and not defined  $uidexpunge2  ) {
         if ( Mail::IMAPClient->can( 'uidexpunge' ) ) {
                 myprint( "Info: will act as --uidexpunge2\n" ) ;
-		$uidexpunge2 = 1 ;
+                $uidexpunge2 = 1 ;
         }elsif ( not defined  $expunge2  ) {
                  myprint( "Info: will act as --expunge2 (no uidexpunge support)\n" ) ;
                 $expunge2 = 1 ;
         }
 }
 
-if ( $delete and $delete2 ) {
-	myprint( "Warning: using --delete and --delete2 together is almost always a bad idea, exiting imapsync\n" ) ;
-	exit_clean( $sync, $EX_USAGE ) ;
+if ( $delete1 and $delete2 ) {
+        myprint( "Warning: using --delete1 and --delete2 together is almost always a bad idea, exiting imapsync\n" ) ;
+        exit_clean( $sync, $EX_USAGE ) ;
 }
 
 if ( $idatefromheader ) {
-	myprint( 'Turned ON idatefromheader, ',
-	      "will set the internal dates on host2 from the 'Date:' header line.\n" ) ;
-	$syncinternaldates = 0 ;
+        myprint( 'Turned ON idatefromheader, ',
+              "will set the internal dates on host2 from the 'Date:' header line.\n" ) ;
+        $syncinternaldates = 0 ;
 }
 
 if ( $syncinternaldates ) {
-	myprint( 'Info: turned ON syncinternaldates, ',
-	      "will set the internal dates (arrival dates) on host2 same as host1.\n" ) ;
+        myprint( 'Info: turned ON syncinternaldates, ',
+              "will set the internal dates (arrival dates) on host2 same as host1.\n" ) ;
 }else{
         myprint( "Info: turned OFF syncinternaldates\n" ) ;
 }
 
 if ( defined $authmd5 and $authmd5 ) {
-	$authmd51 = 1 ;
-	$authmd52 = 1 ;
+        $authmd51 = 1 ;
+        $authmd52 = 1 ;
 }
 
 if ( defined $authmd51 and $authmd51 ) {
-	$authmech1 ||= 'CRAM-MD5';
+        $authmech1 ||= 'CRAM-MD5';
 }
 else{
-	$authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN';
+        $authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN';
 }
 
 if ( defined $authmd52 and $authmd52 ) {
-	$authmech2 ||= 'CRAM-MD5';
+        $authmech2 ||= 'CRAM-MD5';
 }
 else{
-	$authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN';
+        $authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN';
 }
 
 $authmech1 = uc $authmech1;
@@ -1218,8 +1242,8 @@ if (defined $proxyauth2 && !$authuser2) {
         missing_option( 'With --proxyauth2, --authuser2' ) ;
 }
 
-$authuser1 ||= $user1;
-$authuser2 ||= $user2;
+$authuser1 ||= $sync->{user1};
+$authuser2 ||= $sync->{user2};
 
 myprint( "Host1: will try to use $authmech1 authentication on host1\n") ;
 myprint( "Host2: will try to use $authmech2 authentication on host2\n") ;
@@ -1249,7 +1273,7 @@ $reconnectretry2 = defined  $reconnectretry2  ? $reconnectretry2 : $DEFAULT_NB_R
 # then $uidnext_default is never used. So I have to remove it.
 $uidnext_default = $DEFAULT_UIDNEXT ;
 
-@useheader = qw( Message-Id Received ) unless ( @useheader ) ;
+if ( ! @useheader ) { @useheader = qw( Message-Id Received )  ; }
 
 my %useheader ;
 
@@ -1259,44 +1283,18 @@ for ( @useheader ) { $useheader{ uc  $_  } = undef } ;
 #myprint( Data::Dumper->Dump( [ \%useheader ] )  ) ;
 #exit ;
 
-myprint( "Host1: IMAP server [$host1] port [$port1] user [$user1]\n" ) ;
-myprint( "Host2: IMAP server [$host2] port [$port2] user [$user2]\n" ) ;
+myprint( "Host1: IMAP server [$sync->{host1}] port [$sync->{port1}] user [$sync->{user1}]\n" ) ;
+myprint( "Host2: IMAP server [$sync->{host2}] port [$sync->{port2}] user [$sync->{user2}]\n" ) ;
 
-$password1 || $passfile1 || 'PREAUTH' eq $authmech1 || 'EXTERNAL' eq $authmech1 || do {
-	myprint( << 'FIN_PASSFILE'  ) ;
-
-If you are afraid of giving password on the command line arguments, you can put the
-password of user1 in a file named file1 and use "--passfile1 file1" instead of typing it.
-Then give this file restrictive permissions with the command "chmod 600 file1".
-FIN_PASSFILE
-
-	$password1 = ask_for_password( $authuser1 || $user1, $host1 ) ;
-} ;
-
-$password1 = ( defined  $passfile1  ) ? firstline ( $passfile1 ) : $password1 ;
+get_password1( $sync ) ;
+get_password2( $sync ) ;
 
 
-$password2 || $passfile2 || 'PREAUTH' eq $authmech2 || 'EXTERNAL' eq $authmech2 || do {
-	myprint( << 'FIN_PASSFILE'  ) ;
 
-If you are afraid of giving password on the command line arguments, you can put the
-password of user2 in a file named file2 and use "--passfile2 file2" instead of typing it.
-Then give this file restrictive permissions with the command "chmod 600 file2".
-FIN_PASSFILE
-
-	$password2 = ask_for_password( $authuser2 || $user2, $host2 ) ;
-} ;
-
-$password2 = ( defined  $passfile2  ) ? firstline ( $passfile2 ) : $password2 ;
-
-
-# need clean up => write methods dry() and dry_message()
-$sync->{dry} = $dry ;
-my $dry_message = q{} ;
+$sync->{dry_message} = q{} ;
 if( $sync->{dry} ) {
-        $dry_message = "\t(not really since --dry mode)" ;
+        $sync->{dry_message} = "\t(not really since --dry mode)" ;
 }
-$sync->{dry_message} = $dry_message ;
 
 
 $search1 ||= $search if ( $search ) ;
@@ -1305,95 +1303,97 @@ $search2 ||= $search if ( $search ) ;
 
 
 if ( $disarmreadreceipts ) {
-	push @regexmess, q{s{\A((?:[^\n]+\r\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims} ;
+        push @regexmess, q{s{\A((?:[^\n]+\r\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims} ;
 }
 
 $pipemesscheck = ( defined  $pipemesscheck  ) ? $pipemesscheck : 1 ;
 
 if ( @pipemess and $pipemesscheck ) {
-	myprint( 'Checking each --pipemess command, ' 
-                . join( q{, }, @pipemess ) 
+        myprint( 'Checking each --pipemess command, '
+                . join( q{, }, @pipemess )
                 . ", with an space string. ( Can avoid this check with --nopipemesscheck )\n" ) ;
-	my $string = pipemess( q{ }, @pipemess ) ;
+        my $string = pipemess( q{ }, @pipemess ) ;
         # string undef means something was bad.
         if ( not ( defined  $string  ) ) {
-        	die_clean( "Error: one of --pipemess command is bad, check it\n" ) ;
+                die_clean( "Error: one of --pipemess command is bad, check it\n" ) ;
         }
-	myprint( "Ok with each --pipemess @pipemess\n"  ) ;
+        myprint( "Ok with each --pipemess @pipemess\n"  ) ;
 }
 
 if ( $maxlinelengthcmd ) {
-	myprint( "Checking  --maxlinelengthcmd command,  $maxlinelengthcmd, with an space string.\n"  ) ;
-	my $string = pipemess( q{ }, $maxlinelengthcmd ) ;
+        myprint( "Checking  --maxlinelengthcmd command,  $maxlinelengthcmd, with an space string.\n"  ) ;
+        my $string = pipemess( q{ }, $maxlinelengthcmd ) ;
         # string undef means something was bad.
         if ( not ( defined  $string  ) ) {
-        	die_clean( "Error: --maxlinelengthcmd command is bad, check it\n" ) ;
+                die_clean( "Error: --maxlinelengthcmd command is bad, check it\n" ) ;
         }
-	myprint( "Ok with --maxlinelengthcmd $maxlinelengthcmd\n"  ) ;
+        myprint( "Ok with --maxlinelengthcmd $maxlinelengthcmd\n"  ) ;
 }
 
 if ( @regexmess ) {
-	my $string = regexmess( q{ } ) ;
-	myprint( "Checking each --regexmess command with an space string.\n"  ) ;
+        my $string = regexmess( q{ } ) ;
+        myprint( "Checking each --regexmess command with an space string.\n"  ) ;
         # string undef means one of the eval regex was bad.
         if ( not ( defined  $string  ) ) {
-        	die_clean( 'Error: one of --regexmess option is bad, check it' ) ;
+                die_clean( 'Error: one of --regexmess option is bad, check it' ) ;
         }
-	myprint( "Ok with each --regexmess\n"  ) ;
+        myprint( "Ok with each --regexmess\n"  ) ;
 }
 
 if ( @skipmess ) {
-	myprint( "Checking each --skipmess command with an space string.\n"  ) ;
-	my $match = skipmess( q{ } ) ;
+        myprint( "Checking each --skipmess command with an space string.\n"  ) ;
+        my $match = skipmess( q{ } ) ;
         # match undef means one of the eval regex was bad.
         if ( not ( defined  $match  ) ) {
-        	die_clean( 'Error: one of --skipmess option is bad, check it' ) ;
+                die_clean( 'Error: one of --skipmess option is bad, check it' ) ;
         }
-	myprint( "Ok with each --skipmess\n"  ) ;
+        myprint( "Ok with each --skipmess\n"  ) ;
 }
 
 if ( @regexflag ) {
-	myprint( "Checking each --regexflag command with an space string.\n"  ) ;
-	my $string = flags_regex( q{ } ) ;
-	# string undef means one of the eval regex was bad.
-	if ( not ( defined  $string  ) ) {
-		die_clean( 'Error: one of --regexflag option is bad, check it' ) ;
-	}
-	myprint( "Ok with each --regexflag\n"  ) ;
+        myprint( "Checking each --regexflag command with an space string.\n"  ) ;
+        my $string = flags_regex( q{ } ) ;
+        # string undef means one of the eval regex was bad.
+        if ( not ( defined  $string  ) ) {
+                die_clean( 'Error: one of --regexflag option is bad, check it' ) ;
+        }
+        myprint( "Ok with each --regexflag\n"  ) ;
 }
 
-$sync->{imap1} = my $imap1 = login_imap($host1, $port1, $user1, $domain1, $password1,
-		   $debugimap1, $sync->{h1}->{timeout}, $fastio1, $ssl1, $tls1,
-		   $authmech1, $authuser1, $reconnectretry1,
-		   $proxyauth1, $uid1, $split1, 'Host1', $sync->{h1} ) ;
+$sync->{imap1} = my $imap1 = login_imap( $sync->{host1}, $sync->{port1}, $sync->{user1}, $domain1, $sync->{password1},
+                   $debugimap1, $sync->{h1}->{timeout}, $fastio1, $sync->{ssl1}, $sync->{tls1},
+                   $authmech1, $authuser1, $reconnectretry1,
+                   $proxyauth1, $uid1, $split1, 'Host1', $sync->{h1}, $sync ) ;
 
-$sync->{imap2} = my $imap2 = login_imap($host2, $port2, $user2, $domain2, $password2,
-		 $debugimap2, $sync->{h2}->{timeout}, $fastio2, $ssl2, $tls2,
-		 $authmech2, $authuser2, $reconnectretry2,
-		 $proxyauth2, $uid2, $split2, 'Host2', $sync->{h2} ) ;
+$sync->{imap2} = my $imap2 = login_imap( $sync->{host2}, $sync->{port2}, $sync->{user2}, $domain2, $sync->{password2},
+                 $debugimap2, $sync->{h2}->{timeout}, $fastio2, $sync->{ssl2}, $sync->{tls2},
+                 $authmech2, $authuser2, $reconnectretry2,
+                 $proxyauth2, $uid2, $split2, 'Host2', $sync->{h2}, $sync ) ;
 
 
 $debug and myprint( 'Host1 Buffer I/O: ', $imap1->Buffer(), "\n" ) ;
 $debug and myprint( 'Host2 Buffer I/O: ', $imap2->Buffer(), "\n" ) ;
 
 
-die_clean( 'Not authenticated on host1' ) unless $imap1->IsAuthenticated( ) ;
+if ( ! $imap1->IsAuthenticated( ) ) { die_clean( 'Not authenticated on host1' )  ; }
 myprint( "Host1: state Authenticated\n" ) ;
-die_clean( 'Not authenticated on host2' ) unless   $imap2->IsAuthenticated( ) ;
+if ( ! $imap2->IsAuthenticated( ) ) { die_clean( 'Not authenticated on host2' )  ; }
 myprint( "Host2: state Authenticated\n" ) ;
 
-myprint( 'Host1 capability: ', join(q{ }, @{ $imap1->capability_update() || [] }), "\n" ) ;
-myprint( 'Host2 capability: ', join(q{ }, @{ $imap2->capability_update() || [] }), "\n" ) ;
+myprint( 'Host1 capability once authenticated: ', join(q{ }, @{ $imap1->capability() || [] }), "\n" ) ;
+myprint( 'Host2 capability once authenticated: ', join(q{ }, @{ $imap2->capability() || [] }), "\n" ) ;
 
+# ID on by default since 1.832
+$sync->{id} = defined  $sync->{id}  ? $sync->{id} : 1 ;
 imap_id_stuff( $sync ) ;
 
-#quota( $imap1, 'host1' ) ; # quota on host1 is useless and pollute host2 output.
-quota( $imap2, 'host2', $sync ) ;
+#quota( $imap1, 'h1', $sync ) ; # quota on host1 is useless and pollute host2 output.
+quota( $imap2, 'h2', $sync )  ;
 
 if ( $justlogin ) {
-	$imap1->logout(  ) ;
-	$imap2->logout(  ) ;
-	exit_clean( $sync, $EX_OK ) ;
+        $imap1->logout(  ) ;
+        $imap2->logout(  ) ;
+        exit_clean( $sync, $EX_OK ) ;
 }
 
 
@@ -1410,7 +1410,7 @@ my (
         %h2_folders_from_1_all ,
 ) ;
 
-my $h1_folders_wanted_nb = 0 ; 
+my $h1_folders_wanted_nb = 0 ;
 my $h1_folders_wanted_ct = 0 ; # counter of folders done.
 
 # All folders on host1 and host2
@@ -1421,11 +1421,13 @@ my $h1_folders_wanted_ct = 0 ; # counter of folders done.
 myprint( 'Host1: found ', scalar  @h1_folders_all , " folders.\n"  ) ;
 myprint( 'Host2: found ', scalar  @h2_folders_all , " folders.\n"  ) ;
 
-for ( @h1_folders_all ) { $h1_folders_all{ $_ } = 1 } ;
-for ( @h2_folders_all ) {
-	$h2_folders_all{ $_ } = 1 ;
-	$h2_folders_all_UPPER{ uc  $_  } = 1 ;
-} ;
+foreach my $f ( @h1_folders_all ) { 
+	$h1_folders_all{ $f } = 1 
+}
+foreach my $f ( @h2_folders_all ) {
+        $h2_folders_all{ $f } = 1 ;
+        $h2_folders_all_UPPER{ uc  $f  } = 1 ;
+}
 
 $sync->{h1_folders_all} = \%h1_folders_all ;
 $sync->{h2_folders_all} = \%h2_folders_all ;
@@ -1438,59 +1440,59 @@ for ( $imap2->subscribed(  ) ) { $h2_subscribed_folder{ $_ } = 1 } ;
 
 
 if ( defined  $subfolder2  ) {
-	unshift @regextrans2,
-		q's,^${h2_prefix}(.*),${h2_prefix}${subfolder2}${h2_sep}$1,',
-		q's,^INBOX$,${h2_prefix}${subfolder2}${h2_sep}INBOX,' ;
+        unshift @regextrans2,
+                q(s,^${h2_prefix}(.*),${h2_prefix}${subfolder2}${h2_sep}$1,),
+                q(s,^INBOX$,${h2_prefix}${subfolder2}${h2_sep}INBOX,) ;
 
 }
 
 if ( $fixInboxINBOX and ( my $reg = fix_Inbox_INBOX_mapping( \%h1_folders_all, \%h2_folders_all ) ) ) {
-	push @regextrans2, $reg ;
+        push @regextrans2, $reg ;
 }
 
 if (scalar @folder or $subscribed or scalar @folderrec) {
-	# folders given by option --folder
-	if (scalar @folder) {
-		add_to_requested_folders(@folder);
-	}
+        # folders given by option --folder
+        if (scalar @folder) {
+                add_to_requested_folders(@folder);
+        }
 
-	# option --subscribed
-	if ( $subscribed ) {
-		add_to_requested_folders( keys  %h1_subscribed_folder  ) ;
-	}
+        # option --subscribed
+        if ( $subscribed ) {
+                add_to_requested_folders( keys  %h1_subscribed_folder  ) ;
+        }
 
-	# option --folderrec
-	if (scalar @folderrec) {
-		foreach my $folderrec (@folderrec) {
-			add_to_requested_folders($imap1->folders($folderrec));
-		}
-	}
+        # 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) {
-		myprint( "Including all folders found by default. Use --subscribed or --folder or --folderrec or --include to select specific folders. Use --exclude to unselect specific folders.\n"  ) ;
-		add_to_requested_folders(@h1_folders_all);
-	}
+        # no include, no folder/subscribed/folderrec options => all folders
+        if (not scalar @include) {
+                myprint( "Including all folders found by default. Use --subscribed or --folder or --folderrec or --include to select specific folders. Use --exclude to unselect specific folders.\n"  ) ;
+                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 ) ;
-		myprint( "Including folders matching pattern $include\n" . jux_utf8_list( @included_folders )  . "\n"  ) ;
-	}
+        foreach my $include ( @include ) {
+                my @included_folders = grep { /$include/ } @h1_folders_all ;
+                add_to_requested_folders( @included_folders ) ;
+                myprint( "Including folders matching pattern $include\n" . jux_utf8_list( @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 ) ;
-		myprint( "Excluding folders matching pattern $exclude\n" . jux_utf8_list( @excluded_folders ) . "\n"  ) ;
-	}
+        foreach my $exclude ( @exclude ) {
+                my @requested_folder = sort keys %requested_folder ;
+                my @excluded_folders = grep { /$exclude/ } @requested_folder ;
+                remove_from_requested_folders( @excluded_folders ) ;
+                myprint( "Excluding folders matching pattern $exclude\n" . jux_utf8_list( @excluded_folders ) . "\n"  ) ;
+        }
 }
 
 
@@ -1504,13 +1506,13 @@ if ( scalar  @exclude  ) {
 my @h1_folders_wanted_exist ;
 myprint( "Host1: checking all wanted folders exist.\n"  ) ;
 foreach my $folder ( @h1_folders_wanted ) {
-	( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder exists on host1\n"  ) ;
-	if ( ! exists  $h1_folders_all{ $folder }  ) {
+        ( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder exists on host1\n"  ) ;
+        if ( ! exists  $h1_folders_all{ $folder }  ) {
                 myprint( "Host1: warning! ignoring folder $folder because it is not in host1 whole folders list.\n" ) ;
-		next ;
-	}else{
-		push  @h1_folders_wanted_exist, $folder  ;
-	}
+                next ;
+        }else{
+                push  @h1_folders_wanted_exist, $folder  ;
+        }
 }
 
 @h1_folders_wanted = @h1_folders_wanted_exist ;
@@ -1518,17 +1520,17 @@ foreach my $folder ( @h1_folders_wanted ) {
 
 
 $checkselectable and do {
-	my @h1_folders_wanted_selectable ;
+        my @h1_folders_wanted_selectable ;
         myprint( "Host1: checking all wanted folders are selectable. Use --nocheckselectable to avoid this check.\n"  ) ;
-	foreach my $folder ( @h1_folders_wanted ) {
-        	( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder is selectable on host1\n"  ) ;
-        	if ( ! $imap1->selectable( $folder ) ) {
+        foreach my $folder ( @h1_folders_wanted ) {
+                ( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder is selectable on host1\n"  ) ;
+                if ( ! $imap1->selectable( $folder ) ) {
                                 myprint( "Host1: warning! ignoring folder $folder because it is not selectable\n" ) ;
-        	}else{
-			push  @h1_folders_wanted_selectable, $folder  ;
-		}
-	}
-	@h1_folders_wanted = @h1_folders_wanted_selectable ;
+                }else{
+                        push  @h1_folders_wanted_selectable, $folder  ;
+                }
+        }
+        @h1_folders_wanted = @h1_folders_wanted_selectable ;
         ( $debug or $sync->{debugfolders} ) and myprint( 'Host1: checking folders took ', timenext(  ), " s\n"  ) ;
 } ;
 
@@ -1554,19 +1556,19 @@ automap( $sync ) ;
 
 
 foreach my $h1_fold ( @h1_folders_wanted ) {
-	my $h2_fold ;
-	$h2_fold = imap2_folder_name( $h1_fold ) ;
-	$h2_folders_from_1_wanted{ $h2_fold }++ ;
+        my $h2_fold ;
+        $h2_fold = imap2_folder_name( $h1_fold ) ;
+        $h2_folders_from_1_wanted{ $h2_fold }++ ;
         if ( 1 < $h2_folders_from_1_wanted{ $h2_fold } ) {
-        	$h2_folders_from_1_several{ $h2_fold }++ ;
+                $h2_folders_from_1_several{ $h2_fold }++ ;
         }
 }
 @h2_folders_from_1_wanted = sort keys %h2_folders_from_1_wanted;
 
 foreach my $h1_fold ( @h1_folders_all ) {
-	my $h2_fold ;
-	$h2_fold = imap2_folder_name( $h1_fold ) ;
-	$h2_folders_from_1_all{ $h2_fold }++ ;
+        my $h2_fold ;
+        $h2_fold = imap2_folder_name( $h1_fold ) ;
+        $h2_folders_from_1_all{ $h2_fold }++ ;
 }
 
 
@@ -1583,12 +1585,17 @@ Y is the uft8 output just printed for convenience, to recognize it.
 END_LISTING
 
 print
-  "Host1 folders list:\n",
+  "Host1 folders list (first the raw imap format then the [X] = [Y]):\n",
+  $imap1->list(  ),
+  "\n",
   jux_utf8_list( @h1_folders_all ),
   "\n",
-  "Host2 folders list:\n",
+  "Host2 folders list (first the raw imap format then the [X] = [Y]):\n",
+  $imap2->list(  ),
+  "\n",
   jux_utf8_list( @h2_folders_all ),
-  "\n" ;
+  "\n", 
+  q{} ;
 
 print
   'Host1 subscribed folders list: ',
@@ -1599,31 +1606,31 @@ my @h2_folders_not_in_1;
 @h2_folders_not_in_1 = list_folders_in_2_not_in_1(  ) ;
 
 if ( @h2_folders_not_in_1 ) {
-	myprint( "Folders in host2 not in host1:\n",
-	jux_utf8_list( @h2_folders_not_in_1 ), "\n" ) ;
+        myprint( "Folders in host2 not in host1:\n",
+        jux_utf8_list( @h2_folders_not_in_1 ), "\n" ) ;
 }
 
 
-if ( defined  $sync->{f1f2auto}  ) {
-	myprint( "Folders mapping from --automap feature (use --f1f2 to override any mapping):\n"  ) ;
-	foreach my $h1_fold ( keys %{$sync->{f1f2auto}} ) {
-        	my $h2_fold = $sync->{f1f2auto}{$h1_fold} ;
-		myprintf( "%-40s -> %-40s\n",
-		       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
+if ( keys %{ $sync->{f1f2auto} } ) {
+        myprint( "Folders mapping from --automap feature (use --f1f2 to override any mapping):\n"  ) ;
+        foreach my $h1_fold ( keys %{ $sync->{f1f2auto} } ) {
+                my $h2_fold = $sync->{f1f2auto}{$h1_fold} ;
+                myprintf( "%-40s -> %-40s\n",
+                       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
         }
         myprint( "\n"  ) ;
 }
 
-if ( defined  $sync->{f1f2}  ) {
-	myprint( "Folders mapping from --f1f2 options, it overrides --automap:\n"  ) ;
-	foreach my $h1_fold ( keys %{$sync->{f1f2}} ) {
-        	my $h2_fold = $sync->{f1f2}{$h1_fold} ;
+if ( keys %{ $sync->{f1f2} } ) {
+        myprint( "Folders mapping from --f1f2 options, it overrides --automap:\n"  ) ;
+        foreach my $h1_fold ( keys %{ $sync->{f1f2} } ) {
+                my $h2_fold = $sync->{f1f2}{$h1_fold} ;
                 my $warn = q{} ;
                 if ( not exists  $h1_folders_all{ $h1_fold }  ) {
                         $warn = "BUT $h1_fold does NOT exist on host1!" ;
                 }
-		myprintf( "%-40s -> %-40s %s\n",
-		       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ), $warn ) ;
+                myprintf( "%-40s -> %-40s %s\n",
+                       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ), $warn ) ;
         }
         myprint( "\n"  ) ;
 }
@@ -1653,7 +1660,7 @@ $h1_folders_wanted_nb = scalar  @h1_folders_wanted  ;
 
 myprint( "++++ Looping on each one of $h1_folders_wanted_nb folders to sync\n" ) ;
 
-my $begin_transfer_time = time ;
+$sync->{begin_transfer_time} = time ;
 
 my %uid_candidate_for_deletion ;
 my %uid_candidate_no_deletion ;
@@ -1662,234 +1669,235 @@ my %h2_folders_of_md5 = (  ) ;
 
 FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) {
 
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-	my $h2_fold = imap2_folder_name( $h1_fold ) ;
+        my $h2_fold = imap2_folder_name( $h1_fold ) ;
 
-	$h1_folders_wanted_ct++ ;
-	myprintf( "Folder %7s %-35s -> %-35s\n", "$h1_folders_wanted_ct/$h1_folders_wanted_nb",
-		jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
+        $h1_folders_wanted_ct++ ;
+        myprintf( "Folder %7s %-35s -> %-35s\n", "$h1_folders_wanted_ct/$h1_folders_wanted_nb",
+                jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
         if ( $sync->{debugmemory} ) {
                 myprintf("FL: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
-	# host1 can not be fetched read only, select is needed because of expunge.
-	select_folder( $imap1, $h1_fold, 'Host1' ) or next FOLDER ;
+        # host1 can not be fetched read only, select is needed because of expunge.
+        select_folder( $imap1, $h1_fold, 'Host1' ) or next FOLDER ;
 
         debugsleep( $sync ) ;
 
-	my $h1_fold_nb_messages = count_from_select( $imap1->History ) ;
+        my $h1_fold_nb_messages = count_from_select( $imap1->History ) ;
         myprint( "Host1 folder [$h1_fold] has $h1_fold_nb_messages messages in total (mentioned by SELECT)\n" ) ;
 
         if ( $skipemptyfolders and 0 == $h1_fold_nb_messages ) {
-        	myprint( "Skipping empty host1 folder [$h1_fold]\n"  ) ;
+                myprint( "Skipping empty host1 folder [$h1_fold]\n"  ) ;
                 next FOLDER ;
         }
 
-	if ( ! exists  $h2_folders_all{ $h2_fold }  ) {
-		create_folder( $imap2, $h2_fold, $h1_fold ) or next FOLDER ;
-	}
+        if ( ! exists  $h2_folders_all{ $h2_fold }  ) {
+                create_folder( $imap2, $h2_fold, $h1_fold ) or next FOLDER ;
+        }
 
-	acls_sync( $h1_fold, $h2_fold ) ;
+        acls_sync( $h1_fold, $h2_fold ) ;
 
         # Sometimes the folder on host2 is listed (it exists) but is
         # not selectable but becomes selectable by a create (Gmail)
-	select_folder( $imap2, $h2_fold, 'Host2' )
+        select_folder( $imap2, $h2_fold, 'Host2' )
         or ( create_folder( $imap2, $h2_fold, $h1_fold )
              and select_folder( $imap2, $h2_fold, 'Host2' ) )
         or next FOLDER ;
-	my @select_results = $imap2->Results(  ) ;
+        my @select_results = $imap2->Results(  ) ;
 
-	my $h2_fold_nb_messages = count_from_select( @select_results ) ;
+        my $h2_fold_nb_messages = count_from_select( @select_results ) ;
         myprint( "Host2 folder [$h2_fold] has $h2_fold_nb_messages messages in total (mentioned by SELECT)\n" ) ;
 
-	my $permanentflags2 = permanentflags( @select_results ) ;
-	( $debug or $debugflags ) and myprint( "Host2 folder [$h2_fold] permanentflags: $permanentflags2\n"  ) ;
+        my $permanentflags2 = permanentflags( @select_results ) ;
+        myprint( "Host2 folder [$h2_fold] permanentflags: $permanentflags2\n"  ) ;
 
-	if ( $expunge or $expunge1 ){
-		myprint( "Host1: Expunging $h1_fold $dry_message\n"  ) ;
-		unless( $dry ) { $imap1->expunge(  ) } ;
-	}
+        if ( $expunge1 ){
+                myprint( "Host1: Expunging $h1_fold $sync->{dry_message}\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap1->expunge(  ) } ;
+        }
 
-	if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribeall )
+        if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribeall )
              and not exists  $h2_subscribed_folder{ $h2_fold }  ) {
-		myprint( "Host2: Subscribing to folder $h2_fold\n"  ) ;
-		unless( $dry ) { $imap2->subscribe( $h2_fold ) } ;
-	}
+                myprint( "Host2: Subscribing to folder $h2_fold\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap2->subscribe( $h2_fold ) } ;
+        }
 
-	next FOLDER if ( $justfolders ) ;
+        next FOLDER if ( $justfolders ) ;
 
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
         my $h1_msgs_all_hash_ref = {  } ;
-	my @h1_msgs = select_msgs( $imap1, $h1_msgs_all_hash_ref, $search1, $h1_fold );
-	last FOLDER if $imap1->IsUnconnected(  ) ;
+        my @h1_msgs = select_msgs( $imap1, $h1_msgs_all_hash_ref, $search1, $sync->{abletosearch1}, $h1_fold );
+
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
         my $h1_msgs_nb = scalar  @h1_msgs  ;
         $h1{ $h1_fold }{ 'messages_nb' } = $h1_msgs_nb ;
 
-	myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages\n"  ) ;
-	( $debug or $debuglist ) and myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages, LIST gives: @h1_msgs\n" ) ;
+        myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages\n"  ) ;
+        ( $debug or $debuglist ) and myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages, LIST gives: @h1_msgs\n" ) ;
         $debug and myprint( "Host1 selecting messages of folder [$h1_fold] took ", timenext(), " s\n" ) ;
 
         my $h2_msgs_all_hash_ref = {  } ;
-	my @h2_msgs = select_msgs( $imap2, $h2_msgs_all_hash_ref, $search2, $h2_fold ) ;
-	last FOLDER if $imap2->IsUnconnected(  ) ;
+        my @h2_msgs = select_msgs( $imap2, $h2_msgs_all_hash_ref, $search2, $sync->{abletosearch2}, $h2_fold ) ;
+
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
         my $h2_msgs_nb = scalar  @h2_msgs  ;
         $h2{ $h2_fold }{ 'messages_nb' } = $h2_msgs_nb ;
 
-	myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages\n" ) ;
-	( $debug or $debuglist ) and myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages, LIST gives: @h2_msgs\n" ) ;
+        myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages\n" ) ;
+        ( $debug or $debuglist ) and myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages, LIST gives: @h2_msgs\n" ) ;
         $debug and myprint( "Host2 selecting messages of folder [$h2_fold] took ", timenext(), " s\n" ) ;
 
-	my $cache_base = "$tmpdir/imapsync_cache/" ;
-	my $cache_dir = cache_folder( $cache_base, "$host1/$user1/$host2/$user2", $h1_fold, $h2_fold ) ;
-	my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ) ;
+        my $cache_base = "$tmpdir/imapsync_cache/" ;
+        my $cache_dir = cache_folder( $cache_base, "$sync->{host1}/$sync->{user1}/$sync->{host2}/$sync->{user2}", $h1_fold, $h2_fold ) ;
+        my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ) ;
 
-	my $h1_uidvalidity = $imap1->uidvalidity(  ) || q{} ;
-	my $h2_uidvalidity = $imap2->uidvalidity(  ) || q{} ;
+        my $h1_uidvalidity = $imap1->uidvalidity(  ) || q{} ;
+        my $h2_uidvalidity = $imap2->uidvalidity(  ) || q{} ;
 
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-	if ( $usecache ) {
-		myprint( "cache directory: $cache_dir\n"  ) ;
-		mkpath( "$cache_dir" ) ;
-		( $cache_1_2_ref, $cache_2_1_ref )
+        if ( $usecache ) {
+                myprint( "cache directory: $cache_dir\n"  ) ;
+                mkpath( "$cache_dir" ) ;
+                ( $cache_1_2_ref, $cache_2_1_ref )
                 = get_cache( $cache_dir, \@h1_msgs, \@h2_msgs, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
-		myprint( 'CACHE h1 h2: ', scalar  keys %{ $cache_1_2_ref } , " files\n"  ) ;
-		$debug and myprint( '[',
-		    map ( { "$_->$cache_1_2_ref->{$_} " } keys %{ $cache_1_2_ref } ), " ]\n" ) ;
-	}
-
-	my %h1_hash = () ;
-	my %h2_hash = () ;
-
-	my ( %h1_msgs, %h2_msgs ) ;
-	@h1_msgs{ @h1_msgs } = ();
-	@h2_msgs{ @h2_msgs } = ();
-
-	my @h1_msgs_in_cache = sort { $a <=> $b } keys %{ $cache_1_2_ref } ;
-	my @h2_msgs_in_cache = keys %{ $cache_2_1_ref } ;
-
-	my ( %h1_msgs_not_in_cache, %h2_msgs_not_in_cache ) ;
-	%h1_msgs_not_in_cache = %h1_msgs ;
-	%h2_msgs_not_in_cache = %h2_msgs ;
-	delete @h1_msgs_not_in_cache{ @h1_msgs_in_cache } ;
-	delete @h2_msgs_not_in_cache{ @h2_msgs_in_cache } ;
-
-	my @h1_msgs_not_in_cache = keys %h1_msgs_not_in_cache ;
-	#myprint( "h1_msgs_not_in_cache: [@h1_msgs_not_in_cache]\n"  ) ;
-	my @h2_msgs_not_in_cache = keys %h2_msgs_not_in_cache ;
-
-	my @h2_msgs_delete2_not_in_cache = () ;
-	%h1_msgs_copy_by_uid = (  ) ;
-
-	if ( $useuid ) {
-		# use uid so we have to avoid getting header
-		@h1_msgs_copy_by_uid{ @h1_msgs_not_in_cache } = (  ) ;
-		@h2_msgs_delete2_not_in_cache = @h2_msgs_not_in_cache if $usecache ;
-		@h1_msgs_not_in_cache = (  ) ;
-		@h2_msgs_not_in_cache = (  ) ;
-
-		#myprint( "delete2: @h2_msgs_delete2_not_in_cache\n" ) ;
-	}
-
-	$debug and myprint( "Host1 parsing headers of folder [$h1_fold]\n" ) ;
-
-	my ($h1_heads_ref, $h1_fir_ref) = ({}, {});
-	$h1_heads_ref = $imap1->parse_headers([@h1_msgs_not_in_cache], @useheader) if (@h1_msgs_not_in_cache);
-	$debug and myprint( "Host1 parsing headers of folder [$h1_fold] took ", timenext(), " s\n" ) ;
-
-	@{ $h1_fir_ref }{@h1_msgs} = ( undef ) ;
-
-	$debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold]\n"  ) ;
-        if ( $abletosearch ) {
-		$h1_fir_ref = $imap1->fetch_hash( \@h1_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
-	  	if ( @h1_msgs ) ;
-        }else{
-		my $uidnext = $imap1->uidnext( $h1_fold ) || $uidnext_default ;
-		my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-		$h1_fir_ref = $imap1->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
-		if ( @h1_msgs ) ;
+                myprint( 'CACHE h1 h2: ', scalar  keys %{ $cache_1_2_ref } , " files\n"  ) ;
+                $debug and myprint( '[',
+                    map ( { "$_->$cache_1_2_ref->{$_} " } keys %{ $cache_1_2_ref } ), " ]\n" ) ;
         }
-	$debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n"  ) ;
-	unless ($h1_fir_ref) {
-		my $error = join( q{}, "Host1 folder $h1_fold: Could not fetch_hash ",
-			scalar @h1_msgs, ' msgs: ', $imap1->LastError || q{}, "\n" ) ;
-		errors_incr( $sync, $error ) ;
-		next FOLDER ;
-	}
 
-	my @h1_msgs_duplicate;
-	foreach my $m (@h1_msgs_not_in_cache) {
-		my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, 'Host1', \%h1_hash);
-		if (! defined $rc) {
-			my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
-			myprint( "Host1 $h1_fold/$m size $h1_size ignored (no wanted headers so we ignore this message. To solve this: use --addheader)\n"  ) ;
-			$total_bytes_skipped += $h1_size;
-			$nb_msg_skipped += 1;
-			$h1_nb_msg_noheader +=1;
+        my %h1_hash = () ;
+        my %h2_hash = () ;
+
+        my ( %h1_msgs, %h2_msgs ) ;
+        @h1_msgs{ @h1_msgs } = ();
+        @h2_msgs{ @h2_msgs } = ();
+
+        my @h1_msgs_in_cache = sort { $a <=> $b } keys %{ $cache_1_2_ref } ;
+        my @h2_msgs_in_cache = keys %{ $cache_2_1_ref } ;
+
+        my ( %h1_msgs_not_in_cache, %h2_msgs_not_in_cache ) ;
+        %h1_msgs_not_in_cache = %h1_msgs ;
+        %h2_msgs_not_in_cache = %h2_msgs ;
+        delete @h1_msgs_not_in_cache{ @h1_msgs_in_cache } ;
+        delete @h2_msgs_not_in_cache{ @h2_msgs_in_cache } ;
+
+        my @h1_msgs_not_in_cache = keys %h1_msgs_not_in_cache ;
+        #myprint( "h1_msgs_not_in_cache: [@h1_msgs_not_in_cache]\n"  ) ;
+        my @h2_msgs_not_in_cache = keys %h2_msgs_not_in_cache ;
+
+        my @h2_msgs_delete2_not_in_cache = () ;
+        %h1_msgs_copy_by_uid = (  ) ;
+
+        if ( $useuid ) {
+                # use uid so we have to avoid getting header
+                @h1_msgs_copy_by_uid{ @h1_msgs_not_in_cache } = (  ) ;
+                @h2_msgs_delete2_not_in_cache = @h2_msgs_not_in_cache if $usecache ;
+                @h1_msgs_not_in_cache = (  ) ;
+                @h2_msgs_not_in_cache = (  ) ;
+
+                #myprint( "delete2: @h2_msgs_delete2_not_in_cache\n" ) ;
+        }
+
+        $debug and myprint( "Host1 parsing headers of folder [$h1_fold]\n" ) ;
+
+        my ($h1_heads_ref, $h1_fir_ref) = ({}, {});
+        $h1_heads_ref = $imap1->parse_headers([@h1_msgs_not_in_cache], @useheader) if (@h1_msgs_not_in_cache);
+        $debug and myprint( "Host1 parsing headers of folder [$h1_fold] took ", timenext(), " s\n" ) ;
+
+        @{ $h1_fir_ref }{@h1_msgs} = ( undef ) ;
+
+        $debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold]\n"  ) ;
+        if ( $sync->{abletosearch1} ) {
+                $h1_fir_ref = $imap1->fetch_hash( \@h1_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
+                if ( @h1_msgs ) ;
+        }else{
+                my $uidnext = $imap1->uidnext( $h1_fold ) || $uidnext_default ;
+                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+                $h1_fir_ref = $imap1->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
+                if ( @h1_msgs ) ;
+        }
+        $debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n"  ) ;
+        if ( ! $h1_fir_ref ) {
+                my $error = join( q{}, "Host1 folder $h1_fold: Could not fetch_hash ",
+                        scalar @h1_msgs, ' msgs: ', $imap1->LastError || q{}, "\n" ) ;
+                errors_incr( $sync, $error ) ;
+                next FOLDER ;
+        }
+
+        my @h1_msgs_duplicate;
+        foreach my $m (@h1_msgs_not_in_cache) {
+                my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, 'Host1', \%h1_hash);
+                if ( ! defined $rc ) {
+                        my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
+                        myprint( "Host1 $h1_fold/$m size $h1_size ignored (no wanted headers so we ignore this message. To solve this: use --addheader)\n"  ) ;
+                        $total_bytes_skipped += $h1_size;
+                        $nb_msg_skipped += 1;
+                        $h1_nb_msg_noheader +=1;
                         $h1_nb_msg_processed +=1 ;
-		} elsif(0 == $rc) {
-			# duplicate
-			push @h1_msgs_duplicate, $m;
-			# duplicate, same id same size?
-			my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
-			$nb_msg_skipped += 1;
-			$h1_total_bytes_duplicate += $h1_size;
-			$h1_nb_msg_duplicate += 1;
+                } elsif(0 == $rc) {
+                        # duplicate
+                        push @h1_msgs_duplicate, $m;
+                        # duplicate, same id same size?
+                        my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
+                        $nb_msg_skipped += 1;
+                        $h1_total_bytes_duplicate += $h1_size;
+                        $h1_nb_msg_duplicate += 1;
                         $h1_nb_msg_processed +=1 ;
-		}
-	}
+                }
+        }
         my $h1_msgs_duplicate_nb = scalar  @h1_msgs_duplicate  ;
         $h1{ $h1_fold }{ 'duplicates_nb' } = $h1_msgs_duplicate_nb ;
 
         $debug and myprint( "Host1 selected: $h1_msgs_nb  duplicates: $h1_msgs_duplicate_nb\n"  ) ;
-	$debug and myprint( 'Host1 whole time parsing headers took ', timenext(), " s\n"  ) ;
-
-	$debug and myprint( "Host2 parsing headers of folder [$h2_fold]\n" ) ;
-
-	my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} );
-	$h2_heads_ref =   $imap2->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache);
-	$debug and myprint( "Host2 parsing headers of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
-
-	$debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold]\n"  ) ;
-	@{ $h2_fir_ref }{@h2_msgs} = (  ); # fetch_hash can select by uid with last arg as ref
+        $debug and myprint( 'Host1 whole time parsing headers took ', timenext(), " s\n"  ) ;
+	# Getting headers and metada can be so long that host2 might be disconnected here
+        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
 
-        if ( $abletosearch ) {
-		$h2_fir_ref = $imap2->fetch_hash( \@h2_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref)
-		if (@h2_msgs) ;
+        $debug and myprint( "Host2 parsing headers of folder [$h2_fold]\n" ) ;
+
+        my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} );
+        $h2_heads_ref =   $imap2->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache);
+        $debug and myprint( "Host2 parsing headers of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
+
+        $debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold]\n"  ) ;
+        @{ $h2_fir_ref }{@h2_msgs} = (  ); # fetch_hash can select by uid with last arg as ref
+
+
+        if ( $sync->{abletosearch2} and scalar( @h2_msgs ) ) {
+                $h2_fir_ref = $imap2->fetch_hash( \@h2_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref) ;
         }else{
-		my $uidnext = $imap2->uidnext( $h2_fold ) || $uidnext_default ;
-		my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-		$h2_fir_ref = $imap2->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref )
-		if ( @h2_msgs ) ;
+                my $uidnext = $imap2->uidnext( $h2_fold ) || $uidnext_default ;
+                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+                $h2_fir_ref = $imap2->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref )
+                if ( @h2_msgs ) ;
         }
 
-	$debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
+        $debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
 
-	my @h2_msgs_duplicate;
-	foreach my $m (@h2_msgs_not_in_cache) {
-		my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, 'Host2', \%h2_hash) ;
-		my $h2_size = $h2_fir_ref->{$m}->{'RFC822.SIZE'} || 0 ;
-		if (! defined  $rc  ) {
+        my @h2_msgs_duplicate;
+        foreach my $m (@h2_msgs_not_in_cache) {
+                my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, 'Host2', \%h2_hash) ;
+                my $h2_size = $h2_fir_ref->{$m}->{'RFC822.SIZE'} || 0 ;
+                if (! defined  $rc  ) {
                         myprint( "Host2 $h2_fold/$m size $h2_size ignored (no wanted headers so we ignore this message)\n"  ) ;
-			$h2_nb_msg_noheader += 1 ;
-		} elsif( 0 == $rc ) {
-			# duplicate
-			$h2_nb_msg_duplicate += 1 ;
-			$h2_total_bytes_duplicate += $h2_size ;
-			push  @h2_msgs_duplicate, $m  ;
-		}
-	}
+                        $h2_nb_msg_noheader += 1 ;
+                } elsif( 0 == $rc ) {
+                        # duplicate
+                        $h2_nb_msg_duplicate += 1 ;
+                        $h2_total_bytes_duplicate += $h2_size ;
+                        push  @h2_msgs_duplicate, $m  ;
+                }
+        }
 
         # %h2_folders_of_md5
         foreach my $md5 (  keys  %h2_hash  ) {
-        	$h2_folders_of_md5{ $md5 }->{ $h2_fold } ++ ;
+                $h2_folders_of_md5{ $md5 }->{ $h2_fold } ++ ;
         }
 
 
@@ -1897,271 +1905,272 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) {
         $h2{ $h2_fold }{ 'duplicates_nb' } = $h2_msgs_duplicate_nb ;
 
         myprint( "Host2 folder $h2_fold selected: $h2_msgs_nb messages,  duplicates: $h2_msgs_duplicate_nb\n" )
-        	if ( $debug or $delete2duplicates or $h2_msgs_duplicate_nb ) ;
-	$debug and myprint( 'Host2 whole time parsing headers took ', timenext(  ), " s\n"  ) ;
+                if ( $debug or $delete2duplicates or $h2_msgs_duplicate_nb ) ;
+        $debug and myprint( 'Host2 whole time parsing headers took ', timenext(  ), " s\n"  ) ;
 
-	$debug and myprint( "++++ Verifying [$h1_fold] -> [$h2_fold]\n" ) ;
-	# messages in host1 that are not in host2
+        $debug and myprint( "++++ 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;
+        my @h1_hash_keys_sorted_by_uid
+          = sort {$h1_hash{$a}{'m'} <=> $h1_hash{$b}{'m'}} keys %h1_hash;
 
-	#myprint( map { $h1_hash{$_}{'m'} . q{ }} @h1_hash_keys_sorted_by_uid ) ;
+        #myprint( map { $h1_hash{$_}{'m'} . q{ }} @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;
+        my @h2_hash_keys_sorted_by_uid
+          = sort {$h2_hash{$a}{'m'} <=> $h2_hash{$b}{'m'}} keys %h2_hash;
 
 
-	if( $delete2duplicates and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
-		my @h2_expunge ;
+        if( $delete2duplicates and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
+                my @h2_expunge ;
 
-		foreach my $h2_msg ( @h2_msgs_duplicate ) {
-			myprint( "msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $dry_message\n"  ) ;
-			push  @h2_expunge, $h2_msg  if $uidexpunge2 ;
-			unless ( $dry ) {
-				$imap2->delete_message( $h2_msg ) ;
-				$h2_nb_msg_deleted += 1 ;
-			}
-		}
-		my $cnt = scalar @h2_expunge ;
-		if( @h2_expunge and not $expunge2 ) {
-			myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $dry_message\n"  ) ;
-			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
-		}
-        	if ( $expunge2 ){
-                	myprint( "Host2: Expunging folder $h2_fold $dry_message\n"  ) ;
-                	$imap2->expunge(  ) if ! $dry ;
-        	}
-	}
-
-	if( $delete2 and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
-        	# No host1 folders f1a f1b ... going all to same f2 (via --regextrans2)
-		my @h2_expunge;
-		foreach my $m_id (@h2_hash_keys_sorted_by_uid) {
-			#myprint( "$m_id " ) ;
-			unless (exists $h1_hash{$m_id}) {
-				my $h2_msg  = $h2_hash{$m_id}{'m'};
-				my $h2_flags  = $h2_hash{$m_id}{'F'} || q{};
-				my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0;
-				myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted on host2 [$m_id] $dry_message\n" )
-				  if ! $isdel;
-				push @h2_expunge, $h2_msg if $uidexpunge2;
-				unless ($dry or $isdel) {
-					$imap2->delete_message($h2_msg);
-					$h2_nb_msg_deleted += 1;
-				}
-			}
-		}
-		foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
-			myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $dry_message\n" ) ;
-                        push @h2_expunge, $h2_msg if $uidexpunge2;
-			unless ($dry) {
-				$imap2->delete_message($h2_msg);
-				$h2_nb_msg_deleted += 1;
-			}
-		}
-		my $cnt = scalar @h2_expunge ;
-
-		if( @h2_expunge and not $expunge2 ) {
-			myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $dry_message\n"  ) ;
-			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
-		}
-        	if ( $expunge2 ) {
-                	myprint( "Host2: Expunging folder $h2_fold $dry_message\n"  ) ;
-                	$imap2->expunge(  ) if ! $dry ;
-        	}
-	}
-
-	if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  ) {
-        	myprint( "Host2 folder $h2_fold $h2_folders_from_1_several{ $h2_fold } folders left to sync there\n"  ) ;
-		my @h2_expunge;
-		foreach my $m_id ( @h2_hash_keys_sorted_by_uid ) {
-                	my $h2_msg  = $h2_hash{ $m_id }{ 'm' } ;
-			unless ( exists  $h1_hash{ $m_id }  ) {
-				my $h2_flags  = $h2_hash{ $m_id }{ 'F' } || q{} ;
-				my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0 ;
-				unless ( $isdel ) {
-                                	$debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [$m_id]\n"  ) ;
-					$uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
-				}
-			}else{
-                        	$debug and myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [$m_id]\n"  ) ;
-                        	$uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                foreach my $h2_msg ( @h2_msgs_duplicate ) {
+                        myprint( "msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $sync->{dry_message}\n"  ) ;
+                        push  @h2_expunge, $h2_msg  if $uidexpunge2 ;
+                        if ( ! $sync->{dry} ) {
+                                $imap2->delete_message( $h2_msg ) ;
+                                $h2_nb_msg_deleted += 1 ;
                         }
-		}
-		foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
-			myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [not in cache]\n" ) ;
-                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
-		}
+                }
+                my $cnt = scalar @h2_expunge ;
+                if( @h2_expunge and not $expunge2 ) {
+                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
+                }
+                if ( $expunge2 ){
+                        myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->expunge(  ) if ! $sync->{dry} ;
+                }
+        }
 
-		foreach my $h2_msg ( @h2_msgs_in_cache ) {
-			myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [in cache]\n" ) ;
+        if( $delete2 and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
+                # No host1 folders f1a f1b ... going all to same f2 (via --regextrans2)
+                my @h2_expunge;
+                foreach my $m_id (@h2_hash_keys_sorted_by_uid) {
+                        #myprint( "$m_id " ) ;
+                        if ( ! exists $h1_hash{$m_id} ) {
+                                my $h2_msg  = $h2_hash{$m_id}{'m'};
+                                my $h2_flags  = $h2_hash{$m_id}{'F'} || q{};
+                                my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0;
+                                myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted on host2 [$m_id] $sync->{dry_message}\n" )
+                                  if ! $isdel;
+                                push @h2_expunge, $h2_msg if $uidexpunge2;
+                                if ( ! ( $sync->{dry} or $isdel ) ) {
+                                        $imap2->delete_message($h2_msg);
+                                        $h2_nb_msg_deleted += 1;
+                                }
+                        }
+                }
+                foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $sync->{dry_message}\n" ) ;
+                        push @h2_expunge, $h2_msg if $uidexpunge2;
+                        if ( ! $sync->{dry} ) {
+                                $imap2->delete_message($h2_msg);
+                                $h2_nb_msg_deleted += 1;
+                        }
+                }
+                my $cnt = scalar @h2_expunge ;
+
+                if( @h2_expunge and not $expunge2 ) {
+                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
+                }
+                if ( $expunge2 ) {
+                        myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->expunge(  ) if ! $sync->{dry} ;
+                }
+        }
+
+        if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  ) {
+                myprint( "Host2 folder $h2_fold $h2_folders_from_1_several{ $h2_fold } folders left to sync there\n"  ) ;
+                my @h2_expunge;
+                foreach my $m_id ( @h2_hash_keys_sorted_by_uid ) {
+                        my $h2_msg  = $h2_hash{ $m_id }{ 'm' } ;
+                        if ( ! exists  $h1_hash{ $m_id }  ) {
+                                my $h2_flags  = $h2_hash{ $m_id }{ 'F' } || q{} ;
+                                my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0 ;
+                                if ( ! $isdel ) {
+                                        $debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [$m_id]\n"  ) ;
+                                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
+                                }
+                        }else{
+                                $debug and myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [$m_id]\n"  ) ;
+                                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                        }
+                }
+                foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [not in cache]\n" ) ;
+                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
+                }
+
+                foreach my $h2_msg ( @h2_msgs_in_cache ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [in cache]\n" ) ;
                         $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
-		}
+                }
 
 
                 if ( 0 == $h2_folders_from_1_several{ $h2_fold } ) {
-                	# last host1 folder going to $h2_fold
+                        # last host1 folder going to $h2_fold
                         myprint( "Last host1 folder going to $h2_fold\n"  ) ;
                         foreach my $h2_msg ( keys %{ $uid_candidate_for_deletion{ $h2_fold } } ) {
-                        	$debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion\n"  ) ;
+                                $debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion\n"  ) ;
                                 if ( exists  $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }  ) {
-                                	$debug and myprint( "Host2: msg $h2_fold/$h2_msg canceled deletion\n"  ) ;
+                                        $debug and myprint( "Host2: msg $h2_fold/$h2_msg canceled deletion\n"  ) ;
                                 }else{
-                                	myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted $dry_message\n" ) ;
+                                        myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted $sync->{dry_message}\n" ) ;
                                         push  @h2_expunge, $h2_msg  if $uidexpunge2 ;
-                                        unless ( $dry ) {
-                                        	$imap2->delete_message( $h2_msg ) ;
-                                        	$h2_nb_msg_deleted += 1 ;
+                                        if ( ! $sync->{dry} ) {
+                                                $imap2->delete_message( $h2_msg ) ;
+                                                $h2_nb_msg_deleted += 1 ;
                                         }
                                 }
                         }
                 }
 
-		my $cnt = scalar @h2_expunge ;
-		if( @h2_expunge and not $expunge2 ) {
-			myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $dry_message\n"  ) ;
-			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
-		}
-        	if ( $expunge2 ) {
-                	myprint( "Host2: Expunging host2 folder $h2_fold $dry_message\n"  ) ;
-                	$imap2->expunge(  ) if ! $dry ;
-        	}
+                my $cnt = scalar @h2_expunge ;
+                if( @h2_expunge and not $expunge2 ) {
+                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
+                }
+                if ( $expunge2 ) {
+                        myprint( "Host2: Expunging host2 folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->expunge(  ) if ! $sync->{dry} ;
+                }
 
                 $h2_folders_from_1_several{ $h2_fold }-- ;
-	}
+        }
 
-
-	my $h2_uidnext = $imap2->uidnext( $h2_fold ) ;
+        my $h2_uidnext = $imap2->uidnext( $h2_fold ) ;
         $debug and myprint( "Host2 uidnext: $h2_uidnext\n"  ) ;
-	$h2_uidguess = $h2_uidnext ;
-	MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) {
-        	last FOLDER if $imap1->IsUnconnected(  ) ;
-                last FOLDER if $imap2->IsUnconnected(  ) ;
+        $h2_uidguess = $h2_uidnext ;
 
-		#myprint( "h1_nb_msg_processed: $h1_nb_msg_processed\n"  ) ;
-		my $h1_size  = $h1_hash{$m_id}{'s'};
-		my $h1_msg   = $h1_hash{$m_id}{'m'};
-		my $h1_idate = $h1_hash{$m_id}{'D'};
+	# Getting host2 headers, metada and delete2 stuff can be so long that host1 might be disconnected here
+        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-		if ( ( not exists  $h2_hash{ $m_id }  )
-                	and ( not ( exists $h2_folders_of_md5{ $m_id } )
+        MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) {
+		if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
+
+                #myprint( "h1_nb_msg_processed: $h1_nb_msg_processed\n"  ) ;
+                my $h1_size  = $h1_hash{$m_id}{'s'};
+                my $h1_msg   = $h1_hash{$m_id}{'m'};
+                my $h1_idate = $h1_hash{$m_id}{'D'};
+
+                if ( ( not exists  $h2_hash{ $m_id }  )
+                        and ( not ( exists $h2_folders_of_md5{ $m_id } )
                               or not $skipcrossduplicates ) ) {
-			# copy
-			my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
+                        # copy
+                        my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
                         $h2_folders_of_md5{ $m_id }->{ $h2_fold } ++ ;
                         if( $delete2 and ( exists $h2_folders_from_1_several{ $h2_fold } ) and $h2_msg ) {
-                        	myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
-	                        $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                                myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
+                                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
                         }
                         last FOLDER if total_bytes_max_reached(  ) ;
-			next MESS;
-		}
-		else{
-		        # already on host2
+                        next MESS;
+                }
+                else{
+                        # already on host2
                         if ( exists  $h2_hash{ $m_id }  ) {
-				my $h2_msg   = $h2_hash{$m_id}{'m'} ;
-				$debug and myprint( "Host1 found msg $h1_fold/$h1_msg equals Host2 $h2_fold/$h2_msg\n"  ) ;
+                                my $h2_msg   = $h2_hash{$m_id}{'m'} ;
+                                $debug and myprint( "Host1 found msg $h1_fold/$h1_msg equals Host2 $h2_fold/$h2_msg\n"  ) ;
                                 if ( $usecache ) {
-                                	$debugcache and myprint( "touch $cache_dir/${h1_msg}_$h2_msg\n"  ) ;
-                                	touch( "$cache_dir/${h1_msg}_$h2_msg" )
+                                        $debugcache and myprint( "touch $cache_dir/${h1_msg}_$h2_msg\n"  ) ;
+                                        touch( "$cache_dir/${h1_msg}_$h2_msg" )
                                         or croak( "Couldn't touch $cache_dir/${h1_msg}_$h2_msg" ) ;
                                 }
                         }elsif( exists  $h2_folders_of_md5{ $m_id }  ) {
-                        	my @folders_dup = keys  %{ $h2_folders_of_md5{ $m_id } }  ;
-                        	( $debug or $debugcrossduplicates ) and myprint( "Host1 found msg $h1_fold/$h1_msg is also in Host2 folders @folders_dup\n"  ) ;
+                                my @folders_dup = keys  %{ $h2_folders_of_md5{ $m_id } }  ;
+                                ( $debug or $debugcrossduplicates ) and myprint( "Host1 found msg $h1_fold/$h1_msg is also in Host2 folders @folders_dup\n"  ) ;
                         }
-			$total_bytes_skipped += $h1_size ;
-			$nb_msg_skipped += 1 ;
+                        $total_bytes_skipped += $h1_size ;
+                        $nb_msg_skipped += 1 ;
                         $h1_nb_msg_processed +=1 ;
                 }
 
                 if ( exists  $h2_hash{ $m_id }  ) {
-			#$debug and myprint( "MESSAGE $m_id\n" ) ;
-			my $h2_msg  = $h2_hash{$m_id}{'m'};
+                        #$debug and myprint( "MESSAGE $m_id\n" ) ;
+                        my $h2_msg  = $h2_hash{$m_id}{'m'};
 
-                	sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
-	    		# Good
-			my $h2_size = $h2_hash{$m_id}{'s'};
-			$debug and myprint(
-			"Host1 size  msg $h1_fold/$h1_msg = $h1_size <> $h2_size = Host2 $h2_fold/$h2_msg\n" ) ;
-		}
-                last FOLDER if $imap2->IsUnconnected(  ) ;
-
-		if ( $delete ) {
-			delete_message_on_host1( $h1_msg, $h1_fold ) ;
-		}
-	}
-	# END MESS: loop
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
-	MESS_IN_CACHE: foreach my $h1_msg ( @h1_msgs_in_cache ) {
-		my $h2_msg = $cache_1_2_ref->{ $h1_msg } ;
-		$debugcache and myprint( "cache messages update flags $h1_msg->$h2_msg\n" ) ;
-		sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
-		my $h1_size = $h1_fir_ref->{ $h1_msg }->{ 'RFC822.SIZE' } || 0 ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-                $h1_nb_msg_processed +=1 ;
-                last FOLDER if $imap2->IsUnconnected(  ) ;
-	}
-
-	#myprint( "Messages by uid: ", map { "$_ " } keys %h1_msgs_copy_by_uid, "\n"  ) ;
-	MESS_BY_UID: foreach my $h1_msg ( sort { $a <=> $b } keys %h1_msgs_copy_by_uid ) {
-		#
-		$debug and myprint( "Copy by uid $h1_fold/$h1_msg\n"  ) ;
-                last FOLDER if $imap1->IsUnconnected(  ) ;
-                last FOLDER if $imap2->IsUnconnected(  ) ;
-		my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
-                if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  and $h2_msg ) {
-                	myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
-	                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                        sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
+                        # Good
+                        my $h2_size = $h2_hash{$m_id}{'s'};
+                        $debug and myprint(
+                        "Host1 size  msg $h1_fold/$h1_msg = $h1_size <> $h2_size = Host2 $h2_fold/$h2_msg\n" ) ;
                 }
-		last FOLDER if total_bytes_max_reached(  ) ;
-	}
 
-	if ( $expunge or $expunge1 ){
-		myprint( "Host1: Expunging folder $h1_fold $dry_message\n"  ) ;
-		unless( $dry ) { $imap1->expunge(  ) } ;
-	}
-	if ( $expunge2 ){
-		myprint( "Host2: Expunging folder $h2_fold $dry_message\n"  ) ;
-		unless( $dry ) { $imap2->expunge(  ) } ;
-	}
-	$debug and myprint( 'Time: ', timenext(  ), " s\n"  ) ;
-}
+		if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
 
-sub total_bytes_max_reached {
+                if ( $delete1 ) {
+                        delete_message_on_host1( $h1_msg, $h1_fold ) ;
+                }
+        }
+        # END MESS: loop
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
+        MESS_IN_CACHE: foreach my $h1_msg ( @h1_msgs_in_cache ) {
+                my $h2_msg = $cache_1_2_ref->{ $h1_msg } ;
+                $debugcache and myprint( "cache messages update flags $h1_msg->$h2_msg\n" ) ;
+                sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
+                my $h1_size = $h1_fir_ref->{ $h1_msg }->{ 'RFC822.SIZE' } || 0 ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                $h1_nb_msg_processed +=1 ;
+                if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-	return( 0 ) if not $exitwhenover ;
-	if ( $total_bytes_transferred >= $exitwhenover ) {
-        	myprint( "Maximum bytes transferred reached, $total_bytes_transferred >= $exitwhenover, ending sync\n"  ) ;
-        	return( 1 ) ;
         }
 
+        #myprint( "Messages by uid: ", map { "$_ " } keys %h1_msgs_copy_by_uid, "\n"  ) ;
+        MESS_BY_UID: foreach my $h1_msg ( sort { $a <=> $b } keys %h1_msgs_copy_by_uid ) {
+                #
+                $debug and myprint( "Copy by uid $h1_fold/$h1_msg\n"  ) ;
+                if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
+
+                my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
+                if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  and $h2_msg ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
+                        $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                }
+                last FOLDER if total_bytes_max_reached(  ) ;
+        }
+
+        if ( $expunge1 ){
+                myprint( "Host1: Expunging folder $h1_fold $sync->{dry_message}\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap1->expunge(  ) } ;
+        }
+        if ( $expunge2 ){
+                myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap2->expunge(  ) } ;
+        }
+        $debug and myprint( 'Time: ', timenext(  ), " s\n"  ) ;
 }
 
+
 myprint( "++++ End looping on each folder\n"  ) ;
+
+if ( $delete1 and $sync->{'delete1emptyfolders'} ) {
+	delete1emptyfolders( $sync ) ;
+}
+
 ( $debug or $sync->{debugfolders} ) and myprint( 'Time: ', timenext(  ), " s\n"  ) ;
 
 
 if ( $foldersizesatend ) {
-	myprint( << 'END_SIZE'  ) ;
+        myprint( << 'END_SIZE'  ) ;
 
 Folders sizes after the synchronization.
 You can remove this foldersizes listing by using  "--nofoldersizesatend"
 END_SIZE
 
-	foldersizesatend(  ) ;
+        foldersizesatend(  ) ;
 }
 
-$imap1->logout(  ) unless lost_connection( $imap1, "for host1 [$host1]" ) ;
-$imap2->logout(  ) unless lost_connection( $imap2, "for host2 [$host2]" ) ;
+if ( ! lost_connection( $imap1, "for host1 [$sync->{host1}]" ) ) { $imap1->logout(  )  ; }
+if ( ! lost_connection( $imap2, "for host2 [$sync->{host2}]" ) ) { $imap2->logout(  )  ; }
 
 stats( $sync ) ;
 myprint( errorsdump( $sync->{nb_errors}, errors_log( $sync ) ) ) if ( $sync->{errorsdump} ) ;
-tests_live_result( $sync->{nb_errors} ) if ( $testslive ) ;
+tests_live_result( $sync->{nb_errors} ) if ( $sync->{testslive} or $sync->{testslive6} ) ;
+
+
 exit_clean( $sync, $EXIT_WITH_ERRORS ) if ( $sync->{nb_errors} ) ;
 exit_clean( $sync, $EX_OK ) ;
 
@@ -2169,28 +2178,403 @@ exit_clean( $sync, $EX_OK ) ;
 
 
 # subroutines
-sub  myprint  { return print  @ARG ; } 
-sub  myprintf { return printf @ARG ; } 
+sub myprint  { return print  @ARG ; }
+sub myprintf { return printf @ARG ; }
 
 sub mysprintf {
         my( $format, @list ) = @ARG ;
-        return sprintf $format, @list ; 
+        return sprintf $format, @list ;
 }
 
-sub unsetunsafe {
-        # Remove all content in unsafe evalued options
-        @regextrans2 = (  ) ;
-        @regexflag = (  ) ;
-        @regexmess = (  ) ;
-        @skipmess = (  ) ;
-        @pipemess = (  ) ;
-        $delete2foldersonly = undef ;
-        $delete2foldersbutnot = undef ;
-        return ;
+sub output_start {
+	my $mysync = shift @ARG ;
+
+	if ( not $mysync ) { return ; }
+
+	my @output = @ARG ;
+	$mysync->{ output } = join( q{}, @output ) . ( $mysync->{ output } || q{} ) ;
+	return $mysync->{ output } ;
 }
 
+sub tests_output_start {
+	note( 'Entering tests_output_start()' ) ;
+
+	my $mysync = { } ;
+
+	is( undef, output_start(  ), 'output_start: no args => undef' ) ;
+	is( q{}, output_start( $mysync ), 'output_start: one arg => ""' ) ;
+	is( 'rrrr', output_start( $mysync, 'rrrr' ), 'output_start: rrrr => rrrr' ) ;
+	is( 'aaaarrrr', output_start( $mysync, 'aaaa' ), 'output_start: aaaa => aaaarrrr' ) ;
+	is( "\naaaarrrr", output_start( $mysync, "\n" ), 'output_start: \n => \naaaarrrr' ) ;
+	is( "ABC\naaaarrrr", output_start( $mysync, 'A', 'B', 'C' ), 'output_start: A B C => ABC\naaaarrrr' ) ;
+
+	note( 'Leaving  tests_output_start()' ) ;
+	return ;
+}
+
+sub tests_output {
+	note( 'Entering tests_output()' ) ;
+
+	my $mysync = { } ;
+
+	is( undef, output(  ), 'output: no args => undef' ) ;
+	is( q{}, output( $mysync ), 'output: one arg => ""' ) ;
+	is( 'rrrr', output( $mysync, 'rrrr' ), 'output: rrrr => rrrr' ) ;
+	is( 'rrrraaaa', output( $mysync, 'aaaa' ), 'output: aaaa => rrrraaaa' ) ;
+	is( "rrrraaaa\n", output( $mysync, "\n" ), 'output: \n => rrrraaaa\n' ) ;
+	is( "rrrraaaa\nABC", output( $mysync, 'A', 'B', 'C' ), 'output: A B C => rrrraaaaABC\n' ) ;
+
+	note( 'Leaving  tests_output()' ) ;
+	return ;
+}
+
+sub output {
+	my $mysync = shift @ARG ;
+
+	if ( not $mysync ) { return ; }
+
+	my @output = @ARG ;
+	$mysync->{ output } .= join( q{}, @output ) ;
+	return $mysync->{ output } ;
+}
+
+
+
+sub tests_output_reset_with {
+	note( 'Entering tests_output_reset_with()' ) ;
+
+	my $mysync = { } ;
+
+	is( undef,  output_reset_with(  ), 'output_reset_with: no args => undef' ) ;
+	is( q{},    output_reset_with( $mysync ), 'output_reset_with: one arg => ""' ) ;
+	is( 'rrrr', output_reset_with( $mysync, 'rrrr' ), 'output_reset_with: rrrr => rrrr' ) ;
+	is( 'aaaa', output_reset_with( $mysync, 'aaaa' ), 'output_reset_with: aaaa => aaaa' ) ;
+	is( "\n",   output_reset_with( $mysync, "\n" ), 'output_reset_with: \n => \n' ) ;
+
+	note( 'Leaving  tests_output_reset_with()' ) ;
+	return ;
+}
+
+sub output_reset_with {
+	my $mysync = shift @ARG ;
+
+	if ( not $mysync ) { return ; }
+
+	my @output = @ARG ;
+	$mysync->{ output } = join( q{}, @output ) ;
+	return $mysync->{ output } ;
+}
+
+
+
+sub abort  {
+	my $mysync = shift @ARG ;
+	if ( ! -r $sync->{pidfile} ) {
+		myprint( "Can not read pidfile $sync->{pidfile}. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	my $pidtokill = firstline( $sync->{pidfile} ) ;
+	if ( ! $pidtokill ) {
+		myprint( "No process to abort. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	# First ask for suicide
+	if ( kill 'ZERO', $pidtokill ) {
+		myprint( "Sending signal QUIT to PID $pidtokill \n" ) ;
+		kill 'QUIT', $pidtokill ;
+		sleep 1 ;
+	}else{
+		myprint( "Can not send signal to PID $pidtokill. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	# Then murder
+	if ( kill 'ZERO', $pidtokill ) {
+		myprint( "Sending signal KILL to PID $pidtokill \n" ) ;
+		kill 'KILL', $pidtokill ;
+		sleep 1 ;
+	}else{
+		myprint( "Process PID $pidtokill ended. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	# Well ...
+	if ( kill 'ZERO', $pidtokill ) {
+		myprint( "Process PID $pidtokill still there. Can not do much. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+
+	return ;
+}
+
+
+
+sub docker_context {
+	my $mysync = shift ;
+	-e '/.dockerenv'  || return ;
+	myprint( "Docker context detected with /.dockerenv\n" ) ;
+	# No pidfile
+	$mysync->{pidfile} = q{} ;
+	# No log
+	$mysync->{log} = 0 ;
+	# In case
+	myprint( "Changing current directory to /var/tmp/\n" ) ;
+	chdir '/var/tmp/' ;
+	
+	return ;
+}
+
+sub cgibegin {
+	if ( ! under_cgi_context(  ) ) { return ; }
+	my $mysync = shift ;
+	require CGI ;
+	CGI->import( qw( -no_debug ) ) ;
+	require CGI::Carp ;
+	CGI::Carp->import( qw( fatalsToBrowser ) ) ;
+	$mysync->{cgi} = CGI->new( ) ;
+	return ;
+}
+
+sub tests_under_cgi_context {
+	note( 'Entering tests_under_cgi_context()' ) ;
+	# $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
+	do {
+		# Not in cgi context
+		delete local $ENV{SERVER_SOFTWARE} ;
+		is( undef, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE unset => not in cgi context' ) ;
+	} ;
+	do {
+		# In cgi context
+		local $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
+		is( 1, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE set => in cgi context' ) ;
+	} ;
+	do {
+		# Not in cgi context
+		delete local $ENV{SERVER_SOFTWARE} ;
+		is( undef, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE unset => not in cgi context' ) ;
+	} ;
+	do {
+		# In cgi context
+		local $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
+		is( 1, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE set => in cgi context' ) ;
+	} ;
+	note( 'Leaving  tests_under_cgi_context()' ) ;
+	return ;
+}
+
+
+sub under_cgi_context {
+
+	# Under cgi context
+	if ( $ENV{SERVER_SOFTWARE} ) {
+		return 1 ;
+	}
+	# Not in cgi context
+	return ;
+}
+
+sub cgibuildheader {
+	if ( ! under_cgi_context(  ) ) { return ; }
+	my $mysync = shift ;
+
+	my $imapsync_runs = $mysync->{cgi}->cookie( 'imapsync_runs' ) || 0 ;
+	my $cookie = $mysync->{cgi}->cookie(
+			-name => 'imapsync_runs',
+			-value => 1 + $imapsync_runs,
+			-expires => '+20y',
+			-path    => '/cgi-bin/imapsync',
+		) ;
+	my $httpheader ;
+	if ( $mysync->{ abort } ) {
+		$httpheader = $mysync->{cgi}->header(
+			-type   => 'text/plain',
+			-status => '200 OK to stop playing IMAP mailboxes' . ". Load is $mysync->{ loadavg }",
+		) ;
+	}elsif( $mysync->{ loaddelay } ) {
+# https://tools.ietf.org/html/rfc2616#section-10.5.4
+# 503 Service Unavailable
+# The server is currently unable to handle the request due to a temporary overloading or maintenance of the server.
+		$httpheader = $mysync->{cgi}->header(
+			-type   => 'text/plain',
+			-status => '503 Service Unavailable' . ". Be back in $mysync->{ loaddelay } min. Load is $mysync->{ loadavg }",
+		) ;
+	}else{
+		$httpheader = $mysync->{cgi}->header(
+		-type   => 'text/plain',
+		-status => '200 OK to play IMAP mailboxes' . ". Load is $mysync->{ loadavg }",
+		-cookie => $cookie,
+		) ;
+	}
+	output_start( $mysync, $httpheader ) ;
+
+	return ;
+}
+
+sub cgiload {
+	if ( ! under_cgi_context(  ) ) { return ; }
+	my $mysync = shift ;
+	if ( $mysync->{ abort } ) { return ; } # keep going to abort
+	if ( $mysync->{ loaddelay } ) {
+		myprint( "Server is on heavy load. Be back in $mysync->{ loaddelay } min. Load is $mysync->{ loadavg }\n") ;
+		exit_clean( $mysync, $EX_UNAVAILABLE ) ;
+	}
+	return ;
+}
+
+sub tests_set_umask {
+	note( 'Entering tests_set_umask()' ) ;
+	my $save_umask = umask ;
+
+	my $mysync = {} ;
+	if ( 'MSWin32' eq $OSNAME ) {
+		is( undef, set_umask( $mysync ), "set_umask: set failure to $UMASK_PARANO on MSWin32" ) ;
+	}else{
+		is( 1, set_umask( $mysync ), "set_umask: set to $UMASK_PARANO" ) ;
+	}
+
+	umask $save_umask ;
+	note( 'Leaving  tests_set_umask()' ) ;
+	return ;
+}
+
+sub set_umask {
+	my $mysync = shift ;
+	my $previous_umask = umask_str(  ) ;
+	my $new_umask = umask_str( $UMASK_PARANO ) ;
+	output( $mysync, "Umask set with $new_umask (was $previous_umask)\n" ) ;
+	if ( $new_umask eq $UMASK_PARANO ) {
+		return 1 ;
+	}
+	return ;
+}
+
+sub tests_umask_str {
+	note( 'Entering tests_umask_str()' ) ;
+	my $save_umask = umask ;
+
+	is( umask_str(  ), umask_str(  ),  'umask_str: no parameters => idopotent' ) ;
+	is( my $save_umask_str = umask_str(  ), umask_str(  ),  'umask_str: no parameters => idopotent + save' ) ;
+	is( '0000', umask_str(    q{ } ),  'umask_str:  q{ } => 0000' ) ;
+	is( '0000', umask_str(     q{} ),  'umask_str:   q{} => 0000' ) ;
+	is( '0000', umask_str(  '0000' ),  'umask_str:  0000 => 0000' ) ;
+	is( '0000', umask_str(     '0' ),  'umask_str:     0 => 0000' ) ;
+	is( '0200', umask_str(  '0200' ),  'umask_str:  0200 => 0200' ) ;
+	is( '0400', umask_str(  '0400' ),  'umask_str:  0400 => 0400' ) ;
+	is( '0600', umask_str(  '0600' ),  'umask_str:  0600 => 0600' ) ;
+
+	SKIP: {
+	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests success only for Unix', 6 ) ; }
+	is( '0100', umask_str(  '0100' ),  'umask_str:  0100 => 0100' ) ;
+	is( '0001', umask_str(  '0001' ),  'umask_str:  0001 => 0001' ) ;
+	is( '0777', umask_str(  '0777' ),  'umask_str:  0777 => 0777' ) ;
+	is( '0777', umask_str( '00777' ),  'umask_str: 00777 => 0777' ) ;
+	is( '0777', umask_str( ' 777 ' ),  'umask_str:  777  => 0777' ) ;
+	is( "$UMASK_PARANO", umask_str( $UMASK_PARANO ),   "umask_str: UMASK_PARANO $UMASK_PARANO => $UMASK_PARANO" ) ;
+	}
+
+	is( $save_umask_str, umask_str( $save_umask_str ),  'umask_str: restore with str' ) ;
+	is( $save_umask, umask, 'umask_str: umask is restored, controlled by direct umask' ) ;
+	is( $save_umask, umask $save_umask, 'umask_str: umask is restored by direct umask' ) ;
+	is( $save_umask, umask, 'umask_str: umask initial controlled by direct umask' ) ;
+
+	note( 'Leaving  tests_umask_str()' ) ;
+	return ;
+}
+
+sub umask_str {
+	my $value = shift ;
+
+	if ( defined $value ) {
+		umask oct( $value ) ;
+	}
+	my $current = umask ;
+
+	return( sprintf( '%#04o', $current ) ) ;
+}
+
+sub tests_umask {
+	note( 'Entering tests_umask()' ) ;
+	my $save_umask ;
+	is( umask, umask, 'umask: umask is umask' ) ;
+	is( $save_umask = umask, umask, "umask: umask is umask again + save it: $save_umask" ) ;
+	is( $save_umask, umask oct(0000), 'umask: umask 0000' ) ;
+	is( oct(0000), umask, 'umask: umask is now 0000' ) ;
+	is( oct(0000), umask oct(777), 'umask: umask 0777 call, previous 0000' ) ;
+
+	SKIP: {
+	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests success only for Unix', 2 ) ; }
+	is( oct(777), umask, 'umask: umask is now  0777' ) ;
+	is( oct(777), umask $save_umask, "umask: umask $save_umask restore inital value, previous 0777" ) ;
+	}
+
+	ok( defined umask $save_umask, "umask: umask $save_umask restore inital value, previous defined" ) ;
+	is( $save_umask, umask, 'umask: umask is umask restored' ) ;
+	note( 'Leaving  tests_umask()' ) ;
+
+	return ;
+}
+
+sub cgisetcontext {
+	if ( ! under_cgi_context(  ) ) { return ; }
+
+	my $mysync = shift @ARG ;
+	output( $mysync, "Under cgi context\n" ) ;
+	set_umask( $mysync ) ;
+
+        # Remove all content in unsafe evaled options
+        @regextrans2 = (  ) ;
+        @regexflag   = (  ) ;
+        @regexmess   = (  ) ;
+        @skipmess    = (  ) ;
+        @pipemess    = (  ) ;
+        $delete2foldersonly   = undef ;
+        $delete2foldersbutnot = undef ;
+	$maxlinelengthcmd     = undef ;
+
+	# Set safe default values (I hope...)
+
+	$mysync->{pidfile} =  'imapsync.pid' ;
+	$mysync->{pidfilelocking} = 1 ;
+	$mysync->{errorsmax} = $ERRORS_MAX_CGI ;
+	$modulesversion = 0 ;
+	$releasecheck = 1 ;
+	$usecache = 0 ;
+	$mysync->{showpasswords} = 0 ;
+	$debugimap1 = $debugimap2 = $debugimap = 0 ;
+	$reconnectretry1 = $reconnectretry2 = $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
+	$pipemesscheck = 0 ;
+
+	$mysync->{hashfile} = $CGI_HASHFILE ;
+	my $hashsynclocal = hashsynclocal( $mysync ) || die "Can not get hashsynclocal. Exiting\n" ;
+	$cgidir = $CGI_TMPDIR_TOP . '/' . $hashsynclocal ;
+
+        -d $cgidir or mkpath $cgidir or die "Can not create $cgidir: $OS_ERROR\n" ;
+        chdir  $cgidir or die "Can not cd to $cgidir: $OS_ERROR\n" ;
+	$tmpdir = $cgidir ;
+	cgioutputenvcontext( $mysync ) ;
+        $debug and output( $mysync, 'Current directory is ' . getcwd(  ) . "\n" ) ;
+        $debug and output( $mysync, 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
+        $debug and output( $mysync, 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;
+
+	return ;
+}
+
+sub cgioutputenvcontext {
+	my $mysync = shift @ARG ;
+
+	for my $envvar ( qw( REMOTE_ADDR REMOTE_HOST HTTP_REFERER HTTP_USER_AGENT HTTP_COOKIE ) ) {
+
+		my $envval = $ENV{ $envvar } || q{} ;
+		if ( $envval ) { output( $mysync, "$envvar is $envval\n" ) } ;
+	}
+
+	return ;
+}
+
+
+
+
+
 sub debugsleep {
-        my $mysync = shift ;
+        my $mysync = shift @ARG ;
         if ( defined $mysync->{debugsleep} ) {
                 myprint( "Info: sleeping $mysync->{debugsleep}s\n" ) ;
                 sleep $mysync->{debugsleep} ;
@@ -2199,15 +2583,15 @@ sub debugsleep {
 }
 
 sub foldersizes_on_h1h2 {
-	myprint( << 'END_SIZE'  ) ;
+        myprint( << 'END_SIZE'  ) ;
 
 Folders sizes before the synchronization.
 You can remove foldersizes listings by using "--nofoldersizes" and  "--nofoldersizesatend"
 but then you will also loose the ETA (Estimation Time of Arrival) given after each message copy.
 END_SIZE
 
-	( $h1_nb_msg_start, $h1_bytes_start ) = foldersizes( 'Host1', $imap1, $search1, @h1_folders_wanted        ) ;
-	( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( 'Host2', $imap2, $search2, @h2_folders_from_1_wanted ) ;
+        ( $h1_nb_msg_start, $h1_bytes_start ) = foldersizes( 'Host1', $imap1, $search1, $sync->{abletosearch1}, @h1_folders_wanted        ) ;
+        ( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( 'Host2', $imap2, $search2, $sync->{abletosearch2}, @h2_folders_from_1_wanted ) ;
 
         if ( not all_defined( $h1_nb_msg_start, $h1_bytes_start, $h2_nb_msg_start, $h2_bytes_start ) ) {
                 my $error = "Failure getting foldersizes, ETA and final diff will not be displayed\n" ;
@@ -2216,16 +2600,29 @@ END_SIZE
                 $foldersizesatend = 0 ;
                 return ;
         }
-        
-        my $h2_bytes_limit = $sync->{host2}->{quota_limit_bytes} || 0 ;
+
+        my $h2_bytes_limit = $sync->{h2}->{quota_limit_bytes} || 0 ;
         if ( $h2_bytes_limit and ( $h2_bytes_limit < $h1_bytes_start ) ) {
-        	my $quota_percent = mysprintf( '%.0f', $h1_bytes_start/$h2_bytes_limit ) ;
+                my $quota_percent = mysprintf( '%.0f', $NUMBER_100 * $h1_bytes_start / $h2_bytes_limit ) ;
                 my $error = "Host2: Quota limit will be exceeded! Over $quota_percent % ( $h1_bytes_start bytes / $h2_bytes_limit bytes )\n" ;
                 errors_incr( $sync, $error ) ;
         }
         return ;
 }
 
+
+sub total_bytes_max_reached {
+
+        return( 0 ) if not $exitwhenover ;
+        if ( $sync->{total_bytes_transferred} >= $exitwhenover ) {
+                myprint( "Maximum bytes transferred reached, $sync->{total_bytes_transferred} >= $exitwhenover, ending sync\n"  ) ;
+                return( 1 ) ;
+        }
+
+}
+
+
+
 sub all_defined {
         if ( not @ARG ) {
                 return 0 ;
@@ -2239,6 +2636,8 @@ sub all_defined {
 }
 
 sub tests_all_defined {
+	note( 'Entering tests_all_defined()' ) ;
+
         is( 0, all_defined(  ),             'all_defined: no param  => 0' ) ;
         is( 0, all_defined( () ),           'all_defined: void list => 0' ) ;
         is( 0, all_defined( undef ),        'all_defined: undef     => 0' ) ;
@@ -2247,171 +2646,346 @@ sub tests_all_defined {
         is( 0, all_defined( undef, 1 ),     'all_defined: undef 1   => 0' ) ;
         is( 1, all_defined( 1, 1 ),         'all_defined: 1 1   => 1' ) ;
         is( 1, all_defined( (1, 1) ),       'all_defined: (1 1) => 1' ) ;
+
+	note( 'Leaving  tests_all_defined()' ) ;
         return ;
 }
 
 
-sub imap_id_stuff {
-	my $sync = shift ;
+sub tests_hashsynclocal {
+	note( 'Entering tests_hashsynclocal()' ) ;
 
-	if ( not $sync->{id} ) { return ; } ;
+	my $mysync = {
+		host1 => '',
+		user1 => '',
+		password1 => '',
+		host2 => '',
+		user2 => '',
+		password2 => '',
+	} ;
 
-	$sync->{h1_imap_id} = imap_id( $sync->{imap1}, 'Host1' ) ;
-	#myprint( 'Host1: ' . $sync->{h1_imap_id}  ) ;
-	$sync->{h2_imap_id} = imap_id( $sync->{imap2}, 'Host2' ) ;
-	#myprint( 'Host2: ' . $sync->{h2_imap_id}  ) ;
+	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: no hashfile name' ) ;
 
+	$mysync->{ hashfile } = '' ;
+	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: empty hashfile name' ) ;
+
+	$mysync->{ hashfile } = './noexist/rrr' ;
+	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: no exists hashfile dir' ) ;
+
+	SKIP: {
+		if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests only for Unix', 1 ) ; }
+		$mysync->{ hashfile } = '/rrr' ;
+		is( undef, hashsynclocal( $mysync ), 'hashsynclocal: permission denied' ) ;
+	}
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'hashsynclocal: mkpath W/tmp/tests/' ) ;
+	$mysync->{ hashfile } = 'W/tmp/tests/imapsync_hash' ;
+
+	ok( ! -e 'W/tmp/tests/imapsync_hash' || unlink 'W/tmp/tests/imapsync_hash', 'hashsynclocal: unlink W/tmp/tests/imapsync_hash' ) ;
+	ok( ! -e 'W/tmp/tests/imapsync_hash', 'hashsynclocal: verify there is no W/tmp/tests/imapsync_hash' ) ;
+	is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync, 'mukksyhpmbixkxkpjlqivmlqsulpictj' ), 'hashsynclocal: creating/reading W/tmp/tests/imapsync_hash' ) ;
+	# A second time now
+	is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync ), 'hashsynclocal: reading W/tmp/tests/imapsync_hash second time => same' ) ;
+
+	note( 'Leaving  tests_hashsynclocal()' ) ;
 	return ;
 }
 
+sub hashsynclocal {
+	my $mysync = shift ;
+	my $hashkey = shift ; # Optional, only there for tests
+	my $hashfile = $mysync->{ hashfile } ;
+	$hashfile = createhashfileifneeded( $hashfile, $hashkey ) ;
+	if ( ! $hashfile ) {
+		return ;
+	}
+	$hashkey = firstline( $hashfile ) ;
+	if ( ! $hashkey ) {
+		myprint( "No hashkey!\n" ) ;
+		return ;
+	}
+	my $hashsynclocal = hashsync( $mysync, $hashkey ) ;
+	return( $hashsynclocal ) ;
+
+}
+
+sub tests_hashsync {
+	note( 'Entering tests_hashsync()' ) ;
+
+
+	is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hashsync( {}, q{} ), 'hashsync: empty args' ) ;
+	my $mysync ;
+	$mysync->{ host1 } = 'zzz' ;
+	is( 'e86a28a3611c1e7bbaf8057cd00ae122781a11fe', hashsync( $mysync, q{} ), 'hashsync: host1 zzz => ' ) ;
+	is( 'e86a28a3611c1e7bbaf8057cd00ae122781a11fe', hashsync( $mysync, q{} ), 'hashsync: host1 zzz => ' ) ;
+	$mysync->{ host2 } = 'zzz' ;
+	is( '15959573e4a86763253a7aedb1a2b0c60d133dc2', hashsync( $mysync, q{} ), 'hashsync: + host2 zzz => ' ) ;
+	is( 'b8d4ab541b209c75928528020ca28ee43488bd8f', hashsync( $mysync, 'A' ), 'hashsync: + hashkey A => ' ) ;
+
+	note( 'Leaving  tests_hashsync()' ) ;
+	return ;
+}
+
+sub hashsync {
+	my $mysync  = shift ;
+	my $hashkey = shift ;
+
+	my $mystring = join( q{},
+		$mysync->{ host1 }     || q{},
+		$mysync->{ user1 }     || q{},
+		$mysync->{ password1 } || q{},
+		$mysync->{ host2 }     || q{},
+		$mysync->{ user2 }     || q{},
+		$mysync->{ password2 } || q{},
+	) ;
+	my $hashsync = hmac_sha1_hex( $mystring, $hashkey ) ;
+	#myprint( "$hashsync\n" ) ;
+	return( $hashsync ) ;
+}
+
+
+sub tests_createhashfileifneeded {
+	note( 'Entering tests_createhashfileifneeded()' ) ;
+
+	is( undef, createhashfileifneeded(  ), 'createhashfileifneeded: no parameters => undef' ) ;
+
+	note( 'Leaving  tests_createhashfileifneeded()' ) ;
+	return ;
+}
+
+sub createhashfileifneeded {
+	my $hashfile = shift ;
+	my $hashkey  = shift || rand32(  ) ;
+
+	# no name
+	if ( ! $hashfile ) {
+		return ;
+	}
+	# already there
+	if ( -e -r $hashfile ) {
+		return $hashfile ;
+	}
+	# not creatable
+	if ( ! -w dirname( $hashfile ) ) {
+		return ;
+	}
+	# creatable
+	open my $FILE_HANDLE, '>', $hashfile
+                or do {
+                        myprint( "Could not open $hashfile for writing. Check permissions or disk space."  ) ;
+                return ;
+        } ;
+        myprint( "Writing random hashkey in $hashfile, once for all times\n"  ) ;
+        print $FILE_HANDLE $hashkey ;
+        close $FILE_HANDLE ;
+	# Should be there now
+	if ( -e -r $hashfile ) {
+		return $hashfile ;
+	}
+	# unknown failure
+	return ;
+}
+
+sub tests_rand32 {
+	note( 'Entering tests_rand32()' ) ;
+
+	my $string = rand32(  ) ;
+	print "$string\n" ;
+	is( 32, length( $string ),    'rand32: 32 characters long' ) ;
+	is( 32, length( rand32(  ) ), 'rand32: 32 characters long, another one' ) ;
+
+	note( 'Leaving  tests_rand32()' ) ;
+	return ;
+}
+
+sub rand32 {
+	my @chars = ( "a".."z" ) ;
+	my $string;
+	$string .= $chars[rand @chars] for 1..32 ;
+	return $string ;
+}
+
+sub imap_id_stuff {
+        my $mysync = shift ;
+
+        if ( not $mysync->{id} ) { return ; } ;
+
+        $mysync->{h1_imap_id} = imap_id( $mysync, $mysync->{imap1}, 'Host1' ) ;
+        #myprint( 'Host1: ' . $mysync->{h1_imap_id}  ) ;
+        $mysync->{h2_imap_id} = imap_id( $mysync, $mysync->{imap2}, 'Host2' ) ;
+        #myprint( 'Host2: ' . $mysync->{h2_imap_id}  ) ;
+
+        return ;
+}
+
 sub imap_id {
-	my ( $imap, $Side ) = @_ ;
+        my ( $mysync, $imap, $Side ) = @_ ;
 
-	$Side ||= q{} ;
-	my $imap_id_response = q{} ;
+        $Side ||= q{} ;
+        my $imap_id_response = q{} ;
 
-	if ( not $imap->has_capability( 'ID' ) ) {
-		 $imap_id_response = 'No ID capability' ;
+        if ( not $imap->has_capability( 'ID' ) ) {
+                 $imap_id_response = 'No ID capability' ;
                  myprint( "$Side: No ID capability\n"  ) ;
-	}else{
-		my $id_inp = imapsync_id( { side => lc $Side } ) ;
-		myprint( "\n$Side: found ID capability. Sending/receiving ID, presented in raw IMAP for now.\n"
+        }else{
+                my $id_inp = imapsync_id( $mysync, { side => lc $Side } ) ;
+                myprint( "\n$Side: found ID capability. Sending/receiving ID, presented in raw IMAP for now.\n"
                 . "In order to avoid sending/receiving ID, use option --noid\n" ) ;
-		my $debug_before = $imap->Debug(  ) ;
-		$imap->Debug( 1 ) ;
-		my $id_out = $imap->tag_and_run( 'ID ' . $id_inp ) ;
-		#my $id_out = $imap->tag_and_run( 'ID NIL' ) ;
+                my $debug_before = $imap->Debug(  ) ;
+                $imap->Debug( 1 ) ;
+                my $id_out = $imap->tag_and_run( 'ID ' . $id_inp ) ;
+                #my $id_out = $imap->tag_and_run( 'ID NIL' ) ;
                 myprint( "\n"  ) ;
-		$imap->Debug( $debug_before ) ;
-		#$imap_id_response = Data::Dumper->Dump( [ $id_out ], [ 'IMAP_ID' ] ) ;
-	}
-	return( $imap_id_response ) ;
+                $imap->Debug( $debug_before ) ;
+                #$imap_id_response = Data::Dumper->Dump( [ $id_out ], [ 'IMAP_ID' ] ) ;
+        }
+        return( $imap_id_response ) ;
 }
 
 sub imapsync_id {
-	my $overhashref = shift ;
-	# See http://tools.ietf.org/html/rfc2971.html
+        my $mysync = shift ;
+        my $overhashref = shift ;
+        # See http://tools.ietf.org/html/rfc2971.html
 
-	my $imapsync_id = { } ;
+        my $imapsync_id = { } ;
 
-	my $imapsync_id_lamiral = {
-		name          => 'imapsync',
-		version       => imapsync_version(  ),
-		os            => $OSNAME,
-		vendor        => 'Gilles LAMIRAL',
-		'support-url' => 'http://imapsync.lamiral.info/',
-		# Example of date-time:  19-Sep-2015 08:56:07
-		date          => date_from_rcs( q{$Date: 2016/08/19 10:30:36 $ } ),
-	} ;
+        my $imapsync_id_lamiral = {
+                name          => 'imapsync',
+                version       => imapsync_version( $mysync ),
+                os            => $OSNAME,
+                vendor        => 'Gilles LAMIRAL',
+                'support-url' => 'http://imapsync.lamiral.info/',
+                # Example of date-time:  19-Sep-2015 08:56:07
+                date          => date_from_rcs( q{$Date: 2017/09/05 16:14:53 $ } ),
+        } ;
 
-	my $imapsync_id_github  = {
-		name          => 'imapsync',
-		version       => imapsync_version(  ),
-		os            => $OSNAME,
-		vendor        => 'github',
-		'support-url' => 'https://github.com/imapsync/imapsync',
-		date          => date_from_rcs( q{$Date: 2016/08/19 10:30:36 $ } ),
-	} ;
+        my $imapsync_id_github  = {
+                name          => 'imapsync',
+                version       => imapsync_version( $mysync ),
+                os            => $OSNAME,
+                vendor        => 'github',
+                'support-url' => 'https://github.com/imapsync/imapsync',
+                date          => date_from_rcs( q{$Date: 2017/09/05 16:14:53 $ } ),
+        } ;
 
-	$imapsync_id = $imapsync_id_lamiral ;
-	#$imapsync_id = $imapsync_id_github ;
-	my %mix = ( %{ $imapsync_id }, %{ $overhashref } ) ;
-	my $imapsync_id_str = format_for_imap_arg( \%mix ) ;
-	#myprint( "$imapsync_id_str\n"  ) ;
-	return( $imapsync_id_str ) ;
+        $imapsync_id = $imapsync_id_lamiral ;
+        #$imapsync_id = $imapsync_id_github ;
+        my %mix = ( %{ $imapsync_id }, %{ $overhashref } ) ;
+        my $imapsync_id_str = format_for_imap_arg( \%mix ) ;
+        #myprint( "$imapsync_id_str\n"  ) ;
+        return( $imapsync_id_str ) ;
 }
 
 sub tests_imapsync_id {
-	ok( '("name" "imapsync" "version" "111" "os" "beurk" "vendor" "Gilles LAMIRAL" "support-url" "http://imapsync.lamiral.info/" "date" "22-12-1968" "side" "host1")'
-	eq imapsync_id( {
-		version => 111,
-		os => 'beurk',
-		date => '22-12-1968',
-		side => 'host1' } ),
-	'tests_imapsync_id override' ) ;
+	note( 'Entering tests_imapsync_id()' ) ;
 
-	return ;
+        my $mysync ;
+        ok( '("name" "imapsync" "version" "111" "os" "beurk" "vendor" "Gilles LAMIRAL" "support-url" "http://imapsync.lamiral.info/" "date" "22-12-1968" "side" "host1")'
+                eq imapsync_id( $mysync,
+                        {
+                        version => 111,
+                        os => 'beurk',
+                        date => '22-12-1968',
+                        side => 'host1' 
+                        }
+                ),
+                'tests_imapsync_id override' 
+        ) ;
+
+	note( 'Leaving  tests_imapsync_id()' ) ;
+        return ;
 }
 
 sub format_for_imap_arg {
-	my $ref = shift ;
+        my $ref = shift ;
 
-	my $string = q{} ;
-	my %terms = %{ $ref } ;
-	my @terms = (  ) ;
-	if ( not ( %terms ) ) { return( 'NIL' ) } ;
-	# sort like in RFC then add extra key/values
-	foreach my $key ( qw( name version os os-version vendor support-url address date command arguments environment) ) {
-		if ( $terms{ $key } ) {
-			push  @terms, $key, $terms{ $key }  ;
-			delete $terms{ $key } ;
-		}
-	}
-	push  @terms, %terms  ;
-	$string = '(' . ( join q{ }, map { '"' . $_ . '"' } @terms )  . ')' ;
-	return( $string ) ;
+        my $string = q{} ;
+        my %terms = %{ $ref } ;
+        my @terms = (  ) ;
+        if ( not ( %terms ) ) { return( 'NIL' ) } ;
+        # sort like in RFC then add extra key/values
+        foreach my $key ( qw( name version os os-version vendor support-url address date command arguments environment) ) {
+                if ( $terms{ $key } ) {
+                        push  @terms, $key, $terms{ $key }  ;
+                        delete $terms{ $key } ;
+                }
+        }
+        push  @terms, %terms  ;
+        $string = '(' . ( join q{ }, map { '"' . $_ . '"' } @terms )  . ')' ;
+        return( $string ) ;
 }
 
 
 
 sub tests_format_for_imap_arg {
-	ok( 'NIL' eq format_for_imap_arg( { } ), 'format_for_imap_arg empty hash ref' ) ;
-	ok( '("name" "toto")' eq format_for_imap_arg( { name => 'toto' } ), 'format_for_imap_arg { name => toto }' ) ;
-	ok( '("name" "toto" "key" "val")' eq format_for_imap_arg( { name => 'toto', key => 'val' } ), 'format_for_imap_arg 2 x key val' ) ;
-	return ;
+	note( 'Entering tests_format_for_imap_arg()' ) ;
+
+        ok( 'NIL' eq format_for_imap_arg( { } ), 'format_for_imap_arg empty hash ref' ) ;
+        ok( '("name" "toto")' eq format_for_imap_arg( { name => 'toto' } ), 'format_for_imap_arg { name => toto }' ) ;
+        ok( '("name" "toto" "key" "val")' eq format_for_imap_arg( { name => 'toto', key => 'val' } ), 'format_for_imap_arg 2 x key val' ) ;
+
+	note( 'Leaving  tests_format_for_imap_arg()' ) ;
+        return ;
 }
 
 sub quota {
-	my ( $imap, $side, $sync ) = @_ ;
+        my ( $imap, $side, $mysync ) = @_ ;
 
-        my $Side = ucfirst $side ;
-	my $debug_before = $imap->Debug(  ) ;
-	$imap->Debug( 1 ) ;
-	if ( not $imap->has_capability( 'QUOTA' ) ) {
-        	$imap->Debug( $debug_before ) ;
-        	return ;
+	my %side = (
+		h1 => 'Host1',
+		h2 => 'Host2',
+	) ;
+        my $Side = $side{ $side } ;
+        my $debug_before = $imap->Debug(  ) ;
+        $imap->Debug( 1 ) ;
+        if ( not $imap->has_capability( 'QUOTA' ) ) {
+                $imap->Debug( $debug_before ) ;
+                return ;
         } ;
-	myprint( "\n$Side: found quota, presented in raw IMAP\n"  ) ;
-	my $getquotaroot = $imap->getquotaroot( 'INBOX' ) ;
+        myprint( "\n$Side: found quota, presented in raw IMAP\n"  ) ;
+        my $getquotaroot = $imap->getquotaroot( 'INBOX' ) ;
         # Gmail INBOX quotaroot is "" but with it Mail::IMAPClient does a literal GETQUOTA {2} \n ""
         #$imap->quota( 'ROOT' ) ;
         #$imap->quota( '""' ) ;
-	myprint( "\n"  ) ;
-	$imap->Debug( $debug_before ) ;
+        myprint( "\n"  ) ;
+        $imap->Debug( $debug_before ) ;
         my $quota_limit_bytes   = quota_extract_storage_limit_in_bytes( $getquotaroot ) ;
         my $quota_current_bytes = quota_extract_storage_current_in_bytes( $getquotaroot ) ;
-        $sync->{$side}->{quota_limit_bytes}   = $quota_limit_bytes ;
-        $sync->{$side}->{quota_current_bytes} = $quota_current_bytes ;
+        $mysync->{$side}->{quota_limit_bytes}   = $quota_limit_bytes ;
+        $mysync->{$side}->{quota_current_bytes} = $quota_current_bytes ;
         my $quota_percent ;
         if ( $quota_limit_bytes > 0 ) {
-        	$quota_percent = mysprintf( '%.2f', $NUMBER_100 * $quota_current_bytes / $quota_limit_bytes ) ;
+                $quota_percent = mysprintf( '%.2f', $NUMBER_100 * $quota_current_bytes / $quota_limit_bytes ) ;
         }else{
-        	$quota_percent = 0 ;
+                $quota_percent = 0 ;
         }
         myprint( "$Side: Quota current storage is $quota_current_bytes bytes. Limit is $quota_limit_bytes bytes. So $quota_percent % full\n"  ) ;
         if ( $QUOTA_PERCENT_LIMIT < $quota_percent ) {
-        	my $error = "$Side: $quota_percent % full: it is time to find a bigger place! ( $quota_current_bytes bytes / $quota_limit_bytes bytes )\n" ;
-                errors_incr( $sync, $error ) ;
+                my $error = "$Side: $quota_percent % full: it is time to find a bigger place! ( $quota_current_bytes bytes / $quota_limit_bytes bytes )\n" ;
+                errors_incr( $mysync, $error ) ;
         }
-	return ;
+        return ;
 }
 
 sub tests_quota_extract_storage_limit_in_bytes {
-	my $imap_output = [
-	'* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
+	note( 'Entering tests_quota_extract_storage_limit_in_bytes()' ) ;
+
+        my $imap_output = [
+        '* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
         '* QUOTA "Storage quota" (STORAGE 1 104857600)',
         '* QUOTA "Messages quota" (MESSAGE 2 100000)',
         '5 OK Getquotaroot completed.'
-	] ;
-        ok( $NUMBER_104857600 * $KIBI == quota_extract_storage_limit_in_bytes( $imap_output ), 'quota_extract_storage_limit_in_bytes ') ;
+        ] ;
+        ok( $NUMBER_104_857_600 * $KIBI == quota_extract_storage_limit_in_bytes( $imap_output ), 'quota_extract_storage_limit_in_bytes ') ;
+
+	note( 'Leaving  tests_quota_extract_storage_limit_in_bytes()' ) ;
         return ;
 }
 
 sub quota_extract_storage_limit_in_bytes {
-	my $imap_output = shift ;
+        my $imap_output = shift ;
 
         my $limit_kb ;
-        $limit_kb = ( map { /.*\(\s*STORAGE\s+\d+\s+(\d+)\s*\)/ ? $1 : () } @{ $imap_output } )[0] ;
+        $limit_kb = ( map { /.*\(\s*STORAGE\s+\d+\s+(\d+)\s*\)/x ? $1 : () } @{ $imap_output } )[0] ;
         $limit_kb ||= 0 ;
         $debug and myprint( "storage_limit_kb = $limit_kb\n"  ) ;
         return( $KIBI * $limit_kb ) ;
@@ -2419,21 +2993,26 @@ sub quota_extract_storage_limit_in_bytes {
 
 
 sub tests_quota_extract_storage_current_in_bytes {
-	my $imap_output = [
-	'* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
+	note( 'Entering tests_quota_extract_storage_current_in_bytes()' ) ;
+
+
+        my $imap_output = [
+        '* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
         '* QUOTA "Storage quota" (STORAGE 1 104857600)',
         '* QUOTA "Messages quota" (MESSAGE 2 100000)',
         '5 OK Getquotaroot completed.'
-	] ;
+        ] ;
         ok( 1*$KIBI == quota_extract_storage_current_in_bytes( $imap_output ), 'quota_extract_storage_current_in_bytes: 1 => 1024 ') ;
+
+	note( 'Leaving  tests_quota_extract_storage_current_in_bytes()' ) ;
         return ;
 }
 
 sub quota_extract_storage_current_in_bytes {
-	my $imap_output = shift ;
+        my $imap_output = shift ;
 
         my $current_kb ;
-        $current_kb = ( map { /.*\(\s*STORAGE\s+(\d+)\s+\d+\s*\)/ ? $1 : () } @{ $imap_output } )[0] ;
+        $current_kb = ( map { /.*\(\s*STORAGE\s+(\d+)\s+\d+\s*\)/x ? $1 : () } @{ $imap_output } )[0] ;
         $current_kb ||= 0 ;
         $debug and myprint( "storage_current_kb = $current_kb\n"  ) ;
         return( $KIBI * $current_kb ) ;
@@ -2442,52 +3021,52 @@ sub quota_extract_storage_current_in_bytes {
 
 
 sub automap {
-	my ( $sync ) = @_ ;
+        my ( $mysync ) = @_ ;
 
-	if ( $sync->{automap} ) {
-		myprint( "Turned on automapping folders ( use --noautomap to turn off automapping )\n"  ) ;
-	}else{
-		myprint( "Turned off automapping folders ( use --automap to turn on automapping )\n"  ) ;
-		return ;
-	}
+        if ( $mysync->{automap} ) {
+                myprint( "Turned on automapping folders ( use --noautomap to turn off automapping )\n"  ) ;
+        }else{
+                myprint( "Turned off automapping folders ( use --automap to turn on automapping )\n"  ) ;
+                return ;
+        }
 
-        $sync->{h1_special} = special_from_folders_hash( $sync->{imap1}, 'Host1' ) ;
-        $sync->{h2_special} = special_from_folders_hash( $sync->{imap2}, 'Host2' ) ;
+        $mysync->{h1_special} = special_from_folders_hash( $mysync->{imap1}, 'Host1' ) ;
+        $mysync->{h2_special} = special_from_folders_hash( $mysync->{imap2}, 'Host2' ) ;
 
-	build_possible_special( $sync ) ;
-        build_guess_special(  $sync ) ;
-	build_automap( $sync ) ;
+        build_possible_special( $mysync ) ;
+        build_guess_special(  $mysync ) ;
+        build_automap( $mysync ) ;
 
-	return ;
+        return ;
 }
 
 
 
 
 sub build_guess_special {
-	my ( $sync ) = shift ;
+        my ( $mysync ) = shift ;
 
-        foreach my $h1_fold ( sort keys  %{ $sync->{h1_folders_all} }  ) {
-        	my $special = guess_special( $h1_fold, $sync->{possible_special}, $sync->{h1_prefix} ) ;
-        	if ( $special ) {
-                	$sync->{h1_special_guessed}{$h1_fold} = $special ;
-                        my $already_guessed = $sync->{h1_special_guessed}{$special} ;
+        foreach my $h1_fold ( sort keys  %{ $mysync->{h1_folders_all} }  ) {
+                my $special = guess_special( $h1_fold, $mysync->{possible_special}, $mysync->{h1_prefix} ) ;
+                if ( $special ) {
+                        $mysync->{h1_special_guessed}{$h1_fold} = $special ;
+                        my $already_guessed = $mysync->{h1_special_guessed}{$special} ;
                         if ( $already_guessed ) {
-                        	myprint( "Host1: $h1_fold not $special because set to $already_guessed\n"  ) ;
+                                myprint( "Host1: $h1_fold not $special because set to $already_guessed\n"  ) ;
                         }else{
-	                        $sync->{h1_special_guessed}{$special} = $h1_fold ;
+                                $mysync->{h1_special_guessed}{$special} = $h1_fold ;
                         }
                 }
         }
-        foreach my $h2_fold ( sort keys  %{ $sync->{h2_folders_all} }  ) {
-        	my $special = guess_special( $h2_fold, $sync->{possible_special}, $sync->{h2_prefix} ) ;
-        	if ( $special ) {
-                	$sync->{h2_special_guessed}{$h2_fold} = $special ;
-                        my $already_guessed = $sync->{h2_special_guessed}{$special} ;
+        foreach my $h2_fold ( sort keys  %{ $mysync->{h2_folders_all} }  ) {
+                my $special = guess_special( $h2_fold, $mysync->{possible_special}, $mysync->{h2_prefix} ) ;
+                if ( $special ) {
+                        $mysync->{h2_special_guessed}{$h2_fold} = $special ;
+                        my $already_guessed = $mysync->{h2_special_guessed}{$special} ;
                         if ( $already_guessed ) {
-                        	myprint( "Host2: $h2_fold not $special because set to $already_guessed\n"  ) ;
+                                myprint( "Host2: $h2_fold not $special because set to $already_guessed\n"  ) ;
                         }else{
-	                        $sync->{h2_special_guessed}{$special} = $h2_fold ;
+                                $mysync->{h2_special_guessed}{$special} = $h2_fold ;
                         }
                 }
         }
@@ -2495,153 +3074,179 @@ sub build_guess_special {
 }
 
 sub guess_special {
-	my( $folder, $possible_special_ref, $prefix ) = @_ ;
+        my( $folder, $possible_special_ref, $prefix ) = @_ ;
 
         my $folder_no_prefix = $folder ;
-        $folder_no_prefix =~ s/${prefix}// ;
+        $folder_no_prefix =~ s/\Q${prefix}\E//xms ;
         #$debug and myprint( "folder_no_prefix: $folder_no_prefix\n"  ) ;
 
         my $guess_special = $possible_special_ref->{ $folder }
-        	|| $possible_special_ref->{ $folder_no_prefix }
-        	|| q{} ;
+                || $possible_special_ref->{ $folder_no_prefix }
+                || q{} ;
 
         return( $guess_special ) ;
 }
 
 sub tests_guess_special {
-	my $possible_special_ref = build_possible_special( my $sync ) ;
+	note( 'Entering tests_guess_special()' ) ;
+
+        my $possible_special_ref = build_possible_special( my $mysync ) ;
         ok( '\Sent' eq guess_special( 'Sent', $possible_special_ref, q{} ) ,'guess_special: Sent => \Sent' ) ;
         ok( q{} eq guess_special( 'Blabla', $possible_special_ref, q{} ) ,'guess_special: Blabla => q{}' ) ;
         ok( '\Sent' eq guess_special( 'INBOX.Sent', $possible_special_ref, 'INBOX.' ) ,'guess_special: INBOX.Sent => \Sent' ) ;
-	return ;
+        ok( '\Sent' eq guess_special( 'IN BOX.Sent', $possible_special_ref, 'IN BOX.' ) ,'guess_special: IN BOX.Sent => \Sent' ) ;
+
+	note( 'Leaving  tests_guess_special()' ) ;
+        return ;
 }
 
 sub build_automap {
-	my ( $sync ) = @_ ;
+        my $mysync = shift ;
+	$debug and myprint( "Entering build_automap\n" ) ;
+        foreach my $h1_fold ( @{ $mysync->{h1_folders_wanted} } ) {
+                my $h2_fold ;
+                my $h1_special = $mysync->{h1_special}{$h1_fold} ;
+                my $h1_special_guessed = $mysync->{h1_special_guessed}{$h1_fold} ;
 
-	foreach my $h1_fold ( @{ $sync->{h1_folders_wanted} } ) {
-		my $h2_fold ;
-		my $h1_special = $sync->{h1_special}{$h1_fold} ;
-                my $h1_special_guessed = $sync->{h1_special_guessed}{$h1_fold} ;
-
-		# Case 1: special on both sides.
-		if ( $h1_special
-                     and exists  $sync->{h2_special}{$h1_special}  ) {
-			$h2_fold = $sync->{h2_special}{$h1_special} ;
-			$sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
-		}
-		# Case 2: special on host1, not on host2
-		if ( $h1_special
-                     and ( not exists  $sync->{h2_special}{$h1_special}  )
-                     and ( exists  $sync->{h2_special_guessed}{$h1_special}  )
+                # Case 1: special on both sides.
+                if ( $h1_special
+                     and exists  $mysync->{h2_special}{$h1_special}  ) {
+                        $h2_fold = $mysync->{h2_special}{$h1_special} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
+                }
+                # Case 2: special on host1, not on host2
+                if ( $h1_special
+                     and ( not exists  $mysync->{h2_special}{$h1_special}  )
+                     and ( exists  $mysync->{h2_special_guessed}{$h1_special}  )
                    ) {
-			# special_guessed on host2
-                        $h2_fold = $sync->{h2_special_guessed}{$h1_special} ;
-                        $sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
-		}
-		# Case 3: no special on host1, special on host2
+                        # special_guessed on host2
+                        $h2_fold = $mysync->{h2_special_guessed}{$h1_special} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
+                }
+                # Case 3: no special on host1, special on host2
                 if ( ( not $h1_special )
                      and ( $h1_special_guessed )
-                     and ( exists  $sync->{h2_special}{$h1_special_guessed}  )
+                     and ( exists  $mysync->{h2_special}{$h1_special_guessed}  )
                 ) {
-                	$h2_fold = $sync->{h2_special}{$h1_special_guessed} ;
-                        $sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
+                        $h2_fold = $mysync->{h2_special}{$h1_special_guessed} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
                 }
                 # Case 4: no special on both sides.
                 if ( ( not $h1_special )
                      and ( $h1_special_guessed )
-                     and ( not exists  $sync->{h2_special}{$h1_special_guessed}  )
-                     and ( exists  $sync->{h2_special_guessed}{$h1_special_guessed}  )
+                     and ( not exists  $mysync->{h2_special}{$h1_special_guessed}  )
+                     and ( exists  $mysync->{h2_special_guessed}{$h1_special_guessed}  )
                 ) {
-                	$h2_fold = $sync->{h2_special_guessed}{$h1_special_guessed} ;
-                        $sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
+                        $h2_fold = $mysync->{h2_special_guessed}{$h1_special_guessed} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
                 }
-	}
-	return( $sync->{f1f2auto} ) ;
+        }
+        return( $mysync->{f1f2auto} ) ;
 }
 
 # I willll probably add what there is at:
 # http://stackoverflow.com/questions/2185391/localized-gmail-imap-folders/2185548#2185548
 sub build_possible_special {
-	my $sync = shift ;
-	my $possible_special = { } ;
-	# All|Archive|Drafts|Flagged|Junk|Sent|Trash
+        my $mysync = shift ;
+        my $possible_special = { } ;
+        # All|Archive|Drafts|Flagged|Junk|Sent|Trash
 
-	$possible_special->{'\All'}     = [ 'All', 'All Messages', '&BBIEQQQ1-' ] ;
-	$possible_special->{'\Archive'} = [ 'Archive', 'Archives', '&BBAEQARFBDgEMg-' ] ;
-	$possible_special->{'\Drafts'}  = [ 'Drafts', '&BCcENQRABD0EPgQyBDgEOgQ4-' ] ;
-	$possible_special->{'\Flagged'} = [ 'Flagged', 'Starred', '&BB8EPgQ8BDUERwQ1BD0EPQRLBDU-' ] ;
-	$possible_special->{'\Junk'}    = [ 'Junk', 'Spam', '&BCEEPwQwBDw-' ] ;
-	$possible_special->{'\Sent'}    = [ 'Sent', 'Sent Messages', 'Sent Items',
+        $possible_special->{'\All'}     = [ 'All', 'All Messages', '&BBIEQQQ1-' ] ;
+        $possible_special->{'\Archive'} = [ 'Archive', 'Archives', '&BBAEQARFBDgEMg-' ] ;
+        $possible_special->{'\Drafts'}  = [ 'Drafts', '&BCcENQRABD0EPgQyBDgEOgQ4-' ] ;
+        $possible_special->{'\Flagged'} = [ 'Flagged', 'Starred', '&BB8EPgQ8BDUERwQ1BD0EPQRLBDU-' ] ;
+        $possible_special->{'\Junk'}    = [ 'Junk', 'Spam', '&BCEEPwQwBDw-' ] ;
+        $possible_special->{'\Sent'}    = [ 'Sent', 'Sent Messages', 'Sent Items',
                                             'Gesendete Elemente', 'Gesendete Objekte',
-                                            '&AMk-l&AOk-ments envoy&AOk-s', 'Envoy&AOk-',
+                                            '&AMk-l&AOk-ments envoy&AOk-s', 'Envoy&AOk-', 'Objets envoy&AOk-s',
                                             'Elementos enviados',
                                             '&kAFP4W4IMH8wojCkMMYw4A-',
                                             '&BB4EQgQ,BEAEMAQyBDsENQQ9BD0ESwQ1-'] ;
-	$possible_special->{'\Trash'}   = [ 'Trash', '&BCMENAQwBDsENQQ9BD0ESwQ1-', '&BBoEPgRABDcEOAQ9BDA-' ] ;
+        $possible_special->{'\Trash'}   = [ 'Trash', '&BCMENAQwBDsENQQ9BD0ESwQ1-', '&BBoEPgRABDcEOAQ9BDA-' ] ;
 
-	foreach my $special ( qw( \All \Archive \Drafts \Flagged \Junk \Sent \Trash ) ){
-		foreach my $possible_folder ( @{ $possible_special->{$special} } ) {
-			$possible_special->{ $possible_folder } = $special ;
-		} ;
-	}
-        $sync->{possible_special} = $possible_special ;
-	$debug and myprint( Data::Dumper->Dump( [ $possible_special ], [ 'possible_special' ] )  ) ;
+        foreach my $special ( qw( \All \Archive \Drafts \Flagged \Junk \Sent \Trash ) ){
+                foreach my $possible_folder ( @{ $possible_special->{$special} } ) {
+                        $possible_special->{ $possible_folder } = $special ;
+                } ;
+        }
+        $mysync->{possible_special} = $possible_special ;
+        $debug and myprint( Data::Dumper->Dump( [ $possible_special ], [ 'possible_special' ] )  ) ;
         return( $possible_special ) ;
 }
 
 sub special_from_folders_hash {
-	my ( $imap, $side ) = @_ ;
-	my %special = (  ) ;
-        if ( not( Mail::IMAPClient->can( 'folders_hash' ) ) ) {
-        	my $error =  "$side: To have automagic rfc6154 folder mapping, upgrade Mail::IMAPClient >= 3.34\n" ;
+        my ( $imap, $side ) = @_ ;
+        my %special = (  ) ;
+
+        if ( ! defined $imap  ) { return ; }
+        $side = defined $side ? $side : 'Host?' ;
+
+        if ( ! $imap->can( 'folders_hash' ) ) {
+                my $error =  "$side: To have automagic rfc6154 folder mapping, upgrade Mail::IMAPClient >= 3.34\n" ;
                 errors_incr( $sync, $error ) ;
                 return( \%special ) ; # empty hash ref
         }
-	my $folders_hash = $imap->folders_hash(  ) ;
-	foreach my $fhash (@{ $folders_hash } ) {
-			my @special =  grep { /\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)/ } @{ $fhash->{attrs} }  ;
-			if ( @special ) {
-				my $special = $special[0] ; # keep first one. Could be not very good.
-				if ( exists  $special{ $special }  ) {
-					myprintf( "%s: special %-20s = %s already asigned to %s\n",
-					        $side, $fhash->{name}, join( q{ }, @special ), $special{ $special } ) ;
-				}else{
-					myprintf( "%s: special %-20s = %s\n",
-					        $side, $fhash->{name}, join( q{ }, @special ) ) ;
-					$special{ $special } = $fhash->{name} ;
-					$special{ $fhash->{name} } = $special ; # double entry value => key
-				}
-			}
-		}
+        my $folders_hash = $imap->folders_hash(  ) ;
+        foreach my $fhash (@{ $folders_hash } ) {
+                        my @special =  grep { /\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)/x } @{ $fhash->{attrs} }  ;
+                        if ( @special ) {
+                                my $special = $special[0] ; # keep first one. Could be not very good.
+                                if ( exists  $special{ $special }  ) {
+                                        myprintf( "%s: special %-20s = %s already assigned to %s\n",
+                                                $side, $fhash->{name}, join( q{ }, @special ), $special{ $special } ) ;
+                                }else{
+                                        myprintf( "%s: special %-20s = %s\n",
+                                                $side, $fhash->{name}, join( q{ }, @special ) ) ;
+                                        $special{ $special } = $fhash->{name} ;
+                                        $special{ $fhash->{name} } = $special ; # double entry value => key
+                                }
+                        }
+                }
         myprint( "\n" ) if ( %special ) ;
-	return( \%special ) ;
+        return( \%special ) ;
+}
+
+sub tests_special_from_folders_hash {
+	note( 'Entering tests_special_from_folders_hash()' ) ;
+
+
+        require Test::MockObject ;
+        my $imapT = Test::MockObject->new(  ) ;
+
+        is( undef, special_from_folders_hash(  ), 'special_from_folders_hash: no args' ) ;
+        is_deeply( {}, special_from_folders_hash( $imapT ), 'special_from_folders_hash: $imap void' ) ;
+
+        $imapT->mock( 'folders_hash', sub { return( [ { name => 'Sent', attrs => [ '\Sent' ] } ] ) } ) ;
+        is_deeply( { Sent => '\Sent', '\Sent' => 'Sent' }, special_from_folders_hash( $imapT ), 'special_from_folders_hash: $imap \Sent' ) ;
+
+	note( 'Leaving  tests_special_from_folders_hash()' ) ;
+        return(  ) ;
 }
 
 sub errors_incr {
-	my ( $mysync, @error ) = @ARG ;
-	$sync->{nb_errors}++ ;
-        
+        my ( $mysync, @error ) = @ARG ;
+        $sync->{nb_errors}++ ;
+
         if ( @error ) {
-		errors_log( $mysync, @error ) ;
+                errors_log( $mysync, @error ) ;
                 myprint( @error ) ;
         }
-        
+
         $mysync->{errorsmax} ||= $ERRORS_MAX ;
-	if ( $sync->{nb_errors} >= $mysync->{errorsmax} ) {
-		myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
+        if ( $sync->{nb_errors} >= $mysync->{errorsmax} ) {
+                myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
                 if ( $mysync->{errorsdump} ) {
                         myprint( errorsdump( $sync->{nb_errors}, errors_log( $mysync ) ) ) ;
                         # again since errorsdump(  ) can be very verbose and masq previous warning
-		        myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
-		}
+                        myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
+                }
                 exit_clean( $mysync, $EXIT_WITH_ERRORS_MAX ) ;
-	}
-	return ;
+        }
+        return ;
 }
 
 sub errors_log {
@@ -2652,7 +3257,7 @@ sub errors_log {
         }
 
         if ( @error ) {
-		push  @{ $mysync->{errors_log} }, join( q{}, @error  ) ;
+                push  @{ $mysync->{errors_log} }, join( q{}, @error  ) ;
         }
         if ( @{ $mysync->{errors_log} } ) {
                 return @{ $mysync->{errors_log} } ;
@@ -2663,126 +3268,132 @@ sub errors_log {
 }
 
 sub tests_errors_log {
+	note( 'Entering tests_errors_log()' ) ;
 
 
+	note( 'Leaving  tests_errors_log()' ) ;
+	return ;
 }
 
 
 sub errorsdump {
         my( $nb_errors, @errors_log ) = @ARG ;
-	my $error_num = 0 ;
-	my $errors_list = q{} ;
-	if ( @errors_log ) {
-		$errors_list = "++++ Listing $nb_errors errors encountered during the sync ( avoid this listing with --noerrorsdump ).\n" ;
-		foreach my $error ( @errors_log ) {
-			$error_num++ ;
-			$errors_list .= "Err $error_num/$nb_errors: $error" ;
-		}
-	}
-	return( $errors_list ) ;
+        my $error_num = 0 ;
+        my $errors_list = q{} ;
+        if ( @errors_log ) {
+                $errors_list = "++++ Listing $nb_errors errors encountered during the sync ( avoid this listing with --noerrorsdump ).\n" ;
+                foreach my $error ( @errors_log ) {
+                        $error_num++ ;
+                        $errors_list .= "Err $error_num/$nb_errors: $error" ;
+                }
+        }
+        return( $errors_list ) ;
 }
 
 
 sub tests_live_result {
-	my $nb_errors = shift ;
-	if ( $nb_errors  ) {
-		myprint( "Live tests failed with $nb_errors errors\n"  ) ;
-	} else {
-		myprint( "Live tests ended successfully\n"  ) ;
-	}
-	return ;
+	note( 'Entering tests_live_result()' ) ;
+
+        my $nb_errors = shift ;
+        if ( $nb_errors  ) {
+                myprint( "Live tests failed with $nb_errors errors\n"  ) ;
+        } else {
+                myprint( "Live tests ended successfully\n"  ) ;
+        }
+	note( 'Leaving  tests_live_result()' ) ;
+        return ;
 }
 
 sub foldersizesatend {
-	timenext(  ) ;
-	return if ( $imap1->IsUnconnected(  ) ) ;
-	return if ( $imap2->IsUnconnected(  ) ) ;
-	# Get all folders on host2 again since new were created
-	@h2_folders_all = sort $imap2->folders();
-	for ( @h2_folders_all ) {
-        	$h2_folders_all{ $_ } = 1 ;
-        	$h2_folders_all_UPPER{ uc  $_  } = 1 ;
+        timenext(  ) ;
+        return if ( $imap1->IsUnconnected(  ) ) ;
+        return if ( $imap2->IsUnconnected(  ) ) ;
+        # Get all folders on host2 again since new were created
+        @h2_folders_all = sort $imap2->folders();
+        for ( @h2_folders_all ) {
+                $h2_folders_all{ $_ } = 1 ;
+                $h2_folders_all_UPPER{ uc  $_  } = 1 ;
         } ;
-	( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( 'Host1', $imap1, $search1, @h1_folders_wanted ) ;
-	( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( 'Host2', $imap2, $search2, @h2_folders_from_1_wanted ) ;
+        ( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( 'Host1', $imap1, $search1, $sync->{abletosearch1}, @h1_folders_wanted ) ;
+        ( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( 'Host2', $imap2, $search2, $sync->{abletosearch2}, @h2_folders_from_1_wanted ) ;
         if ( not all_defined( $h1_nb_msg_end, $h1_bytes_end, $h2_nb_msg_end, $h2_bytes_end ) ) {
                 my $error = "Failure getting foldersizes, final differences will not be calculated\n" ;
                 errors_incr( $sync, $error ) ;
         }
-	return ;
+        return ;
 }
 
 sub size_filtered_flag {
-	my $h1_size = shift ;
+        my $h1_size = shift ;
 
-	if (defined $maxsize and $h1_size >= $maxsize) {
-		return( 1 ) ;
-	}
-	if (defined $minsize and $h1_size <= $minsize) {
-		return( 1 ) ;
-	}
-	return( 0 ) ;
+        if (defined $maxsize and $h1_size >= $maxsize) {
+                return( 1 ) ;
+        }
+        if (defined $minsize and $h1_size <= $minsize) {
+                return( 1 ) ;
+        }
+        return( 0 ) ;
 }
 
 sub sync_flags_fir {
-	my ( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) = @_ ;
+        my ( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) = @_ ;
 
-	if ( not defined  $h1_msg  ) { return } ;
-	if ( not defined  $h2_msg  ) { return } ;
+        if ( not defined  $h1_msg  ) { return } ;
+        if ( not defined  $h2_msg  ) { return } ;
 
-	my $h1_size = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'} ;
-	return if size_filtered_flag( $h1_size ) ;
+        my $h1_size = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'} ;
+        return if size_filtered_flag( $h1_size ) ;
 
-	# used cached flag values for efficiency
-	my $h1_flags = $h1_fir_ref->{ $h1_msg }->{ 'FLAGS' } || q{} ;
-	my $h2_flags = $h2_fir_ref->{ $h2_msg }->{ 'FLAGS' } || q{} ;
+        # used cached flag values for efficiency
+        my $h1_flags = $h1_fir_ref->{ $h1_msg }->{ 'FLAGS' } || q{} ;
+        my $h2_flags = $h2_fir_ref->{ $h2_msg }->{ 'FLAGS' } || q{} ;
 
-	sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
+        sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
 
         return ;
 }
 
 sub sync_flags_after_copy {
-	my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $permanentflags2 ) = @_ ;
+        my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $permanentflags2 ) = @_ ;
 
         my @h2_flags = $imap2->flags( $h2_msg ) ;
         my $h2_flags = "@h2_flags" ;
         ( $debug or $debugflags ) and myprint( "Host2 flags before resync by STORE on msg $h2_msg: $h2_flags\n"  ) ;
-	sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
+        sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
         return ;
 }
 
 sub sync_flags {
-	my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) = @_ ;
+        my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) = @_ ;
 
-	( $debug or $debugflags ) and
+        ( $debug or $debugflags ) and
         myprint( "Host1: flags init msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n"  ) ;
 
-	$h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
+        $h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
 
-	$h2_flags = flagscase( $h2_flags ) ;
+        $h2_flags = flagscase( $h2_flags ) ;
 
-	( $debug or $debugflags ) and
+        ( $debug or $debugflags ) and
         myprint( "Host1 flags filt msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n"  ) ;
 
 
-	# compare flags - set flags if there a difference
-	my @h1_flags = sort split(q{ }, $h1_flags );
-	my @h2_flags = sort split(q{ }, $h2_flags );
-	my $diff = compare_lists( \@h1_flags, \@h2_flags );
+        # compare flags - set flags if there a difference
+        my @h1_flags = sort split(q{ }, $h1_flags );
+        my @h2_flags = sort split(q{ }, $h2_flags );
+        my $diff = compare_lists( \@h1_flags, \@h2_flags );
 
-	$diff and ( $debug or $debugflags )
-		and     myprint( "Host2 flags msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n" ) ;
-	# This sets flags so flags can be removed with this
-	# When you remove a \Seen flag on host1 you want to it
-	# to be removed on host2. Just add flags is not what
-	# we need most of the time.
+        $diff and ( $debug or $debugflags )
+                and     myprint( "Host2 flags msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n" ) ;
+        # This sets flags so flags can be removed with this
+        # When you remove a \Seen flag on host1 you want to it
+        # to be removed on host2. Just add flags is not what
+        # we need most of the time.
 
-	if ( not $dry and $diff and not $imap2->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) {
-		my $error_msg = join q{}, "Host2 flags msg $h2_fold/$h2_msg could not add flags [@h1_flags]: ",
-		  $imap2->LastError || q{}, "\n" ;
-		errors_incr( $sync, $error_msg ) ;
-	}
+        if ( not $sync->{dry} and $diff and not $imap2->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) {
+                my $error_msg = join q{}, "Host2 flags msg $h2_fold/$h2_msg could not add flags [@h1_flags]: ",
+                  $imap2->LastError || q{}, "\n" ;
+                errors_incr( $sync, $error_msg ) ;
+        }
 
         return ;
 }
@@ -2790,7 +3401,7 @@ sub sync_flags {
 
 
 sub _filter {
-	my $str = shift or return q{} ;
+        my $str = shift or return q{} ;
         my $sz  = $SIZE_MAX_STR ;
         my $len = length $str ;
         if ( not $debug and $len > $sz*2 ) {
@@ -2805,7 +3416,7 @@ sub _filter {
 
 
 sub lost_connection {
-	my( $imap, $error_message ) = @_;
+        my( $imap, $error_message ) = @_;
         if ( $imap->IsUnconnected(  ) ) {
                 $sync->{nb_errors}++ ;
                 my $lcomm = $imap->LastIMAPCommand || q{} ;
@@ -2819,203 +3430,298 @@ sub lost_connection {
                 return( 1 ) ;
         }
         else{
-        	return( 0 ) ;
+                return( 0 ) ;
         }
 }
 
 sub max {
-	my @list = @_ ;
-	return( undef ) if ( 0 == scalar  @list  ) ;
-	my @sorted = sort { $a <=> $b } @list ;
-	return( pop @sorted ) ;
+        my @list = @_ ;
+        return( undef ) if ( 0 == scalar  @list  ) ;
+        
+        no warnings 'numeric' ;
+        no warnings 'uninitialized' ;
+
+        my @sorted = sort { $a <=> $b || $a cmp $b } @list ;
+        return( pop @sorted ) ;
 }
 
 sub tests_max {
-	ok( 0  == max( 0 ),  'max 0' ) ;
-	ok( 1  == max( 1 ),  'max 1' ) ;
-	ok( $MINUS_ONE == max( $MINUS_ONE ), 'max -1') ;
-	ok( not ( defined max(  ) ), 'max no arg' ) ;
-	ok( $NUMBER_100 == max( 1, $NUMBER_100 ), 'max 1 100' ) ;
-	ok( $NUMBER_100 == max( $NUMBER_100, 1 ), 'max 100 1' ) ;
-	ok( $NUMBER_100 == max( $NUMBER_100, $NUMBER_42, 1 ), 'max 100 42 1' ) ;
-	ok( $NUMBER_100 == max( $NUMBER_100, '42', 1 ), 'max 100 42 1' ) ;
-	ok( $NUMBER_100 == max( '100', '42', 1 ), 'max 100 42 1' ) ;
-	#ok( 100 == max( 100, 'haha', 1 ), 'max 100 42 1') ;
+	note( 'Entering tests_max()' ) ;
+        is( 0, max( 0 ),  'max 0 => 0' ) ;
+        is( 1, max( 1 ),  'max 1 => 1' ) ;
+        is( $MINUS_ONE, max( $MINUS_ONE ), 'max -1 => -1') ;
+        is( undef, max(  ), 'max no arg => undef' ) ;
+        is( $NUMBER_100, max( 1, $NUMBER_100 ), 'max 1 100 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, 1 ), 'max 100 1 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, $NUMBER_42, 1 ), 'max 100 42 1 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, '42', 1 ), 'max 100 42 1 => 100' ) ;
+        is( $NUMBER_100, max( '100', '42', 1 ), 'max 100 42 1 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, 'haha', 1 ), 'max 100 haha 1 => 100') ;
+	is( 1, max( $MINUS_ONE, 1 ), 'max -1 1 => 1') ;
+	is( 1, max( undef, 1 ), 'max undef 1 => 1' ) ;
+	is( 0, max( undef, 0 ), 'max undef 0 => 0' ) ;
+        is( 'haha', max( 'haha' ), 'max haha => haha') ;
+        is( 'bb', max( 'aa', 'bb' ), 'max aa bb => bb') ;
+        is( 'bb', max( 'bb', 'aa' ), 'max bb aa bb => bb') ;
+        is( 'bb', max( 'bb', 'aa', 'bb' ), 'max bb aa bb => bb') ;
+	note( 'Leaving  tests_max()' ) ;
+        return ;
+}
+
+sub min {
+        my @list = @_ ;
+        return( undef ) if ( 0 == scalar  @list  ) ;
+        no warnings 'numeric' ;
+        no warnings 'uninitialized' ;
+        my @sorted = sort { $a <=> $b || $a cmp $b } @list ;
+        return( shift @sorted ) ;
+}
+
+sub tests_min {
+	note( 'Entering tests_min()' ) ;
+
+        is( 0, min( 0 ),  'min 0 => 0' ) ;
+        is( 1, min( 1 ),  'min 1 => 1' ) ;
+        is( $MINUS_ONE, min( $MINUS_ONE ), 'min -1 => -1' ) ;
+        is( undef, min(  ), 'min no arg => undef' ) ;
+        is( 1, min( 1, $NUMBER_100 ), 'min 1 100 => 1' ) ;
+        is( 1, min( $NUMBER_100, 1 ), 'min 100 1 => 1' ) ;
+        is( 1, min( $NUMBER_100, $NUMBER_42, 1 ), 'min 100 42 1 => 1' ) ;
+        is( 1, min( $NUMBER_100, '42', 1 ), 'min 100 42 1 => 1' ) ;
+        is( 1, min( '100', '42', 1 ), 'min 100 42 1 => 1' ) ;
+        is( 'haha', min( 100, 'haha', 1 ), 'min 100 haha 1 => haha') ;
+	is( $MINUS_ONE, min( $MINUS_ONE, 1 ), 'min -1 1 => -1') ;
+	
+	is( undef, min( undef, 1 ), 'min undef 1 => undef' ) ;
+	is( undef, min( undef, 0 ), 'min undef 0 => undef' ) ;
+
+        is( 'haha', min( 'haha' ), 'min haha => haha') ;
+        is( 'aa', min( 'aa', 'bb' ), 'min aa bb => aa') ;
+        is( 'aa', min( 'bb', 'aa' ), 'min bb aa bb => aa') ;
+        is( 'aa', min( 'bb', 'aa', 'bb' ), 'min bb aa bb => aa') ;
+
+	note( 'Leaving  tests_min()' ) ;
         return ;
 }
 
 
 sub check_lib_version {
-	$debug and myprint( "IMAPClient $Mail::IMAPClient::VERSION\n"  ) ;
-	if ( '2.2.9' eq $Mail::IMAPClient::VERSION ) {
-		myprint( "imapsync no longer supports Mail::IMAPClient 2.2.9, upgrade it\n"  ) ;
-		return 0 ;
-	}
-	else{
-		# 3.x.x is no longer buggy with imapsync.
+        $debug and myprint( "IMAPClient $Mail::IMAPClient::VERSION\n"  ) ;
+        if ( '2.2.9' eq $Mail::IMAPClient::VERSION ) {
+                myprint( "imapsync no longer supports Mail::IMAPClient 2.2.9, upgrade it\n"  ) ;
+                return 0 ;
+        }
+        else{
+                # 3.x.x is no longer buggy with imapsync.
                 # 3.30 or currently superior is imposed in the Perl "use Mail::IMAPClient line".
-		return 1 ;
-	}
+                return 1 ;
+        }
         return ;
 }
 
 sub module_version_str {
-	my( $module_name, $module_version ) = @_ ;
-	my $str = mysprintf( "%-20s %s\n", $module_name, $module_version ) ;
+        my( $module_name, $module_version ) = @_ ;
+        my $str = mysprintf( "%-20s %s\n", $module_name, $module_version ) ;
         return( $str ) ;
 }
 
 sub modulesversion {
 
-	my @list_version;
+        my @list_version;
 
-	my $v ;
-	eval { require Mail::IMAPClient; $v = $Mail::IMAPClient::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Mail::IMAPClient', $v )  ;
+        my %modulesversion = (
+                'Authen::NTLM'          => sub { $Authen::NTLM::VERSION },
+                'Compress::Zlib'        => sub { $Compress::Zlib::VERSION },
+                'Crypt::OpenSSL::RSA'   => sub { $Crypt::OpenSSL::RSA::VERSION },
+                'Data::Uniqid'          => sub { $Data::Uniqid::VERSION },
+                'Digest::HMAC_MD5'      => sub { $Digest::HMAC_MD5::VERSION },
+                'Digest::HMAC_SHA1'     => sub { $Digest::HMAC_SHA1::VERSION },
+                'Digest::MD5'           => sub { $Digest::MD5::VERSION },
+                'File::Copy::Recursive' => sub { $File::Copy::Recursive::VERSION },
+                'File::Spec'            => sub { $File::Spec::VERSION },
+                'Getopt::Long'          => sub { $Getopt::Long::VERSION },
+                'HTML::Entities'        => sub { $HTML::Entities::VERSION },
+                'IO::Socket::INET6'     => sub { $IO::Socket::INET6::VERSION },
+                'IO::Socket::INET'      => sub { $IO::Socket::INET::VERSION },
+                'IO::Socket::SSL'       => sub { $IO::Socket::SSL::VERSION },
+                'IO::Socket'            => sub { $IO::Socket::VERSION },
+                'IO::Tee'               => sub { $IO::Tee::VERSION },
+                'JSON'                  => sub { $JSON::VERSION },
+                'JSON::WebToken'        => sub { $JSON::WebToken::VERSION },
+                'LWP'                   => sub { $LWP::VERSION },
+                'Mail::IMAPClient'      => sub { $Mail::IMAPClient::VERSION },
+                'Net::Ping'             => sub { $Net::Ping::VERSION },
+                'Net::SSLeay'           => sub { $Net::SSLeay::VERSION },
+                'Term::ReadKey'         => sub { $Term::ReadKey::VERSION },
+                'Test::MockObject'      => sub { $Test::MockObject::VERSION },
+                'Time::HiRes'           => sub { $Time::HiRes::VERSION },
+                'Unicode::String'       => sub { $Unicode::String::VERSION },
+                'URI::Escape'           => sub { $URI::Escape::VERSION },
+                #'Lalala'                => sub { $Lalala::VERSION },
+        ) ;
 
-	eval { require IO::Socket; $v = $IO::Socket::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket', $v )  ;
+        foreach my $module_name ( sort keys %modulesversion ) {
+                # trick from http://www.perlmonks.org/?node_id=152122
+                my $file_name = $module_name . '.pm' ;
+                $file_name =~s,::,/,xmgs; # Foo::Bar::Baz => Foo/Bar/Baz.pm
+                my $v ;
+                eval {
+                        require $file_name ;
+                        $v = defined $modulesversion{ $module_name } ? $modulesversion{ $module_name }->() : q{?} ;
+                } or $v = q{Not installed} ;
 
-	eval { require IO::Socket::INET; $v = $IO::Socket::INET::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket::INET', $v )  ;
+                push  @list_version, module_version_str( $module_name, $v )  ;
+        }
 
-	eval { require IO::Socket::INET6; $v = $IO::Socket::INET6::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket::INET6', $v )  ;
-
-	eval { require IO::Socket::SSL ; $v = $IO::Socket::SSL::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket::SSL ', $v )  ;
-
-	eval { require Net::SSLeay ; $v = $Net::SSLeay::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Net::SSLeay ', $v )  ;
-
-	eval { require Compress::Zlib; $v = $Compress::Zlib::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Compress::Zlib', $v )  ;
-
-	eval { require Digest::MD5; $v = $Digest::MD5::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Digest::MD5', $v )  ;
-
-	eval { require Digest::HMAC_MD5; $v = $Digest::HMAC_MD5::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Digest::HMAC_MD5', $v )  ;
-
-	eval { require Digest::HMAC_SHA1; $v = $Digest::HMAC_SHA1::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Digest::HMAC_SHA1', $v )  ;
-
-	eval { require Term::ReadKey; $v = $Term::ReadKey::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Term::ReadKey', $v )  ;
-
-	eval { require File::Spec; $v = $File::Spec::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'File::Spec', $v )  ;
-
-	eval { require Time::HiRes; $v = $Time::HiRes::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Time::HiRes', $v )  ;
-
-	eval { require Unicode::String; $v = $Unicode::String::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Unicode::String', $v )  ;
-
-	eval { require IO::Tee; $v = $IO::Tee::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Tee', $v )  ;
-
-	eval { require File::Copy::Recursive; $v = $File::Copy::Recursive::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'File::Copy::Recursive', $v )  ;
-
-	eval { require Authen::NTLM; $v = $Authen::NTLM::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Authen::NTLM', $v )  ;
-
-	eval { require URI::Escape; $v = $URI::Escape::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'URI::Escape', $v )  ;
-
-	eval { require Data::Uniqid; $v = $Data::Uniqid::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Data::Uniqid', $v )  ;
-
-	eval { require JSON; $v = $JSON::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'JSON', $v )  ;
-
-	eval { require JSON::WebToken; $v = $JSON::WebToken::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'JSON::WebToken', $v )  ;
-
-	eval { require Crypt::OpenSSL::RSA; $v = $Crypt::OpenSSL::RSA::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Crypt::OpenSSL::RSA', $v )  ;
-
-	eval { require LWP; $v = $LWP::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'LWP', $v )  ;
-
-	eval { require HTML::Entities; $v = $HTML::Entities::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'HTML::Entities', $v )  ;
-
-	#eval { require Filesys::DfPortable; $v = $Filesys::DfPortable::VERSION } or $v = q{?} ;
-	#push  @list_version, module_version_str( 'Filesys::DfPortable', $v )  ;
-
-	eval { require Getopt::Long; $v = $Getopt::Long::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Getopt::Long', $v )  ;
-
-	eval { require Test::MockObject; $v = $Test::MockObject::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Test::MockObject', $v )  ;
-
-	return( @list_version ) ;
+        return( @list_version ) ;
 }
 
 
 # Construct a command line copy with passwords replaced by MASKED.
 sub command_line_nopassword {
-	my @argv = @_ ;
-	my @argv_nopassword ;
+        my @argv = @_ ;
+        my @argv_nopassword ;
 
-        return( "@argv" ) if $showpasswords ;
-	while ( @argv ) {
-		my $arg = shift @argv ; # option name or value
-		if ( $arg =~ m/-password[12]/x ) {
-			shift @argv ; # password value
-			push  @argv_nopassword, $arg, 'MASKED'  ; # option name and fake value
-		}else{
-			push  @argv_nopassword, $arg ; # same option or value
-		}
-	}
-	return("@argv_nopassword") ;
+        return( "@argv" ) if $sync->{showpasswords} ;
+        while ( @argv ) {
+                my $arg = shift @argv ; # option name or value
+                if ( $arg =~ m/-password[12]/x ) {
+                        shift @argv ; # 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 {
+	note( 'Entering tests_command_line_nopassword()' ) ;
 
-	ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
-	ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
-	#myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
-	ok('--password1 MASKED' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
-	ok('--blabla --password1 MASKED --blibli'
-	eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
-	$showpasswords = 1 ;
-	ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
-	ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
-	#myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
-	ok('--password1 secret1' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
-	ok('--blabla --password1 secret1 --blibli'
-	eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
+        ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
+        ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
+        #myprint( 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');
+        $sync->{showpasswords} = 1 ;
+        ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
+        ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
+        #myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
+        ok('--password1 secret1' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
+        ok('--blabla --password1 secret1 --blibli'
+        eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
+
+	note( 'Leaving  tests_command_line_nopassword()' ) ;
         return ;
 }
 
-sub ask_for_password {
-	my ( $user, $host ) = @_ ;
-	myprint( "What's the password for $user" . '@' . "$host? (not visible while you type, then enter RETURN) "  ) ;
-	Term::ReadKey::ReadMode( 2 ) ;
-	my $password = <> ;
-	chomp $password ;
-	myprint( "\nGot it\n" ) ;
-	Term::ReadKey::ReadMode( 0 ) ;
-	return $password ;
+sub ask_for_password  {
+        my ( $user, $host ) = @ARG ;
+        myprint( "What's the password for $user" . '@' . "$host? (not visible while you type, then enter RETURN) "  ) ;
+        Term::ReadKey::ReadMode( 2 ) ;
+        my $password =  ;
+        chomp $password ;
+        myprint( "\nGot it\n" ) ;
+        Term::ReadKey::ReadMode( 0 ) ;
+        return $password ;
 }
 
+# Have to refactor get_password1() get_password2()
+# to have only get_password() and two calls
+sub get_password1 {
+
+	my $mysync = shift ;
+
+	$mysync->{password1}
+	|| $passfile1
+	|| 'PREAUTH' eq $authmech1
+	|| 'EXTERNAL' eq $authmech1
+	|| $ENV{IMAPSYNC_PASSWORD1}
+	|| do {
+        myprint( << 'FIN_PASSFILE'  ) ;
+
+If you are afraid of giving password on the command line arguments, you can put the
+password of user1 in a file named file1 and use "--passfile1 file1" instead of typing it.
+Then give this file restrictive permissions with the command "chmod 600 file1".
+An other solution is to set the environment variable IMAPSYNC_PASSWORD1
+FIN_PASSFILE
+
+		$mysync->{password1} = ask_for_password( $authuser1 || $mysync->{user1}, $mysync->{host1} ) ;
+	} ;
+
+	if ( defined  $passfile1  ) {
+		if ( ! -e -r $passfile1 ) {
+			myprint( "Failure: file from parameter --passfile1 $passfile1 does not exist or is not readable\n" ) ;
+			exit_clean( $mysync, $EX_NOINPUT ) ;
+		}
+		# passfile1 readable
+		$mysync->{password1} = firstline ( $passfile1 ) ;
+		return ;
+	}
+	if ( $ENV{IMAPSYNC_PASSWORD1} ) {
+		$mysync->{password1} = $ENV{IMAPSYNC_PASSWORD1} ;
+		return ;
+	}
+	return ;
+}
+
+sub get_password2 {
+
+	my $mysync = shift ;
+
+	$mysync->{password2}
+	|| $passfile2
+	|| 'PREAUTH' eq $authmech2
+	|| 'EXTERNAL' eq $authmech2
+	|| $ENV{IMAPSYNC_PASSWORD2}
+	|| do {
+        myprint( << 'FIN_PASSFILE'  ) ;
+
+If you are afraid of giving password on the command line arguments, you can put the
+password of user2 in a file named file2 and use "--passfile2 file2" instead of typing it.
+Then give this file restrictive permissions with the command "chmod 600 file2".
+An other solution is to set the environment variable IMAPSYNC_PASSWORD2
+FIN_PASSFILE
+
+		$mysync->{password2} = ask_for_password( $authuser2 || $mysync->{user2}, $mysync->{host2} ) ;
+	} ;
+
+
+	if ( defined  $passfile2  ) {
+		if ( ! -e -r $passfile2 ) {
+			myprint( "Failure: file from parameter --passfile2 $passfile2 does not exist or is not readable\n" ) ;
+			exit_clean( $mysync, $EX_NOINPUT ) ;
+		}
+		# passfile2 readable
+		$mysync->{password2} = firstline ( $passfile2 ) ;
+		return ;
+	}
+	if ( $ENV{IMAPSYNC_PASSWORD2} ) {
+		$mysync->{password2} = $ENV{IMAPSYNC_PASSWORD2} ;
+		return ;
+	}
+	return ;
+}
+
+
+
+
+
 sub catch_exit {
         my $mysync = shift ;
         my $signame = shift ;
         if ( $signame ) {
                 myprint( "\nGot a signal $signame\n" ) ;
         }
-	stats( $mysync ) ;
+        stats( $mysync ) ;
         myprint( "Ended by a signal\n" ) ;
-	exit_clean( $mysync, $EXIT_BY_SIGNAL ) ;
+        exit_clean( $mysync, $EXIT_BY_SIGNAL ) ;
         return ;
 }
 
 sub catch_reconnect {
-	my $mysync = shift ;
+        my $mysync = shift ;
         my $signame = shift ;
         myprint( "\nGot a signal $signame\n",
                 "Hit 2 ctr-c within 2 seconds to exit the program\n",
@@ -3031,24 +3737,109 @@ sub catch_reconnect {
 
         if ( ! defined $mysync->{imap1} ) { return ; }
         if ( ! defined $mysync->{imap2} ) { return ; }
-        
+
 
         myprint( "Info: reconnecting to host1 imap server\n" ) ;
         $mysync->{imap1}->State( Mail::IMAPClient::Unconnected ) ;
+	$mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
         $mysync->{imap1}->reconnect(  ) ;
         myprint( "Info: reconnecting to host2 imap server\n" ) ;
         $mysync->{imap2}->State( Mail::IMAPClient::Unconnected ) ;
+	$mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
         $mysync->{imap2}->reconnect(  ) ;
         myprint( "Info: reconnected to both imap servers\n" ) ;
         return ;
 }
 
+sub tests_reconnect_12_if_needed {
+	note( 'Entering tests_reconnect_12_if_needed()' ) ;
+
+	my $mysync ;
+
+	$mysync->{imap1} = Mail::IMAPClient->new(  ) ;
+	$mysync->{imap2} = Mail::IMAPClient->new(  ) ;
+	$mysync->{imap1}->Server( 'test1.lamiral.info' ) ;
+	$mysync->{imap2}->Server( 'test2.lamiral.info' ) ;
+	is( 2, reconnect_12_if_needed( $mysync ), 'reconnect_12_if_needed: test1&test2 .lamiral.info => 1' ) ;
+	is( 1, $mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_12_if_needed: test1.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;
+	is( 1, $mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_12_if_needed: test2.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;
+
+	note( 'Leaving  tests_reconnect_12_if_needed()' ) ;
+	return ;
+}
+
+sub reconnect_12_if_needed {
+        my $mysync = shift ;
+	#return 2 ;
+	if ( ! reconnect_if_needed( $mysync->{imap1} ) ) {
+		return ;
+	}
+	if ( ! reconnect_if_needed( $mysync->{imap2} ) ) {
+		return ;
+	}
+	# both were good
+	return 2 ;
+}
+
+
+sub tests_reconnect_if_needed {
+	note( 'Entering tests_reconnect_if_needed()' ) ;
+
+
+	my $myimap ;
+
+	is( undef, reconnect_if_needed( ), 'reconnect_if_needed: no args => undef' ) ;
+	is( undef, reconnect_if_needed( $myimap ), 'reconnect_if_needed: undef arg => undef' ) ;
+
+	$myimap = Mail::IMAPClient->new(  ) ;
+        $myimap->Debug( 1 ) ;
+	is( undef, reconnect_if_needed( $myimap ), 'reconnect_if_needed: empty new Mail::IMAPClient => undef' ) ;
+	$myimap->Server( 'test.lamiral.info' ) ;
+	is( 1, reconnect_if_needed( $myimap ), 'reconnect_if_needed: test.lamiral.info => 1' ) ;
+	is( 1, $myimap->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_if_needed: test.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;
+
+	note( 'Leaving  tests_reconnect_if_needed()' ) ;
+	return ;
+}
+
+sub reconnect_if_needed {
+	# return undef upon failure.
+	# return 1 upon connection success, with or without reconnection.
+
+        my $imap = shift ;
+
+	if ( ! defined $imap ) { return ; }
+	if ( ! $imap->Server(  ) ) { return ; }
+
+	if ( $imap->IsUnconnected(  ) ) {
+		$imap->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
+		if ( $imap->reconnect( ) )  {
+			return 1 ;
+		}
+	}else{
+		return 1 ;
+	}
+
+	# A last forced one
+	$imap->State( Mail::IMAPClient::Unconnected ) ;
+	$imap->reconnect(  ) ;
+	$imap->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
+	if ( $imap->noop ) {
+		# NOOP is ok
+		return 1 ;
+	}
+
+	return ;
+}
+
+
+
 sub here_twice {
         my $mysync = shift ;
         my $now = time ;
         my $previous = $mysync->{lastcatch} || 0 ;
         $mysync->{lastcatch} = $now ;
-        
+
         if ( $INTERVAL_TO_EXIT >= $now - $previous ) {
                 return $TRUE ;
         }else{
@@ -3057,40 +3848,219 @@ sub here_twice {
 }
 
 
-
-
 sub justconnect {
 
-	$imap1 = connect_imap( $host1, $port1, $debugimap1, $ssl1, $tls1, 'Host1', $sync->{h1}->{timeout}, $sync->{h1} ) ;
-	myprint( 'Host1 banner: ', $imap1->Banner(  )  ) ;
-	myprint( 'Host1 capability: ', join(q{ }, $imap1->capability(  ) ), "\n"  ) ;
-	$imap2 = connect_imap( $host2, $port2, $debugimap2, $ssl2, $tls2, 'Host2', $sync->{h2}->{timeout}, $sync->{h2} ) ;
-	myprint( 'Host2 banner: ', $imap2->Banner(  )  ) ;
-	myprint( 'Host2 capability: ', join(q{ }, $imap2->capability(  ) ), "\n"  ) ;
-	$imap1->logout(  ) ;
-	$imap2->logout(  ) ;
+        $imap1 = connect_imap( $sync->{host1}, $sync->{port1}, $debugimap1, $sync->{ssl1}, $sync->{tls1}, 'Host1', $sync->{h1}->{timeout}, $sync->{h1} ) ;
+        $imap2 = connect_imap( $sync->{host2}, $sync->{port2}, $debugimap2, $sync->{ssl2}, $sync->{tls2}, 'Host2', $sync->{h2}->{timeout}, $sync->{h2} ) ;
+        $imap1->logout(  ) ;
+        $imap2->logout(  ) ;
         return ;
 }
 
+
+sub tests_mailimapclient_connect {
+        note( 'Entering tests_mailimapclient_connect()' ) ;
+        my $imap ;
+        # ipv4 
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv4: new' ) ;
+        is( 'Mail::IMAPClient', ref( $imap ), 'mailimapclient_connect ipv4: ref is Mail::IMAPClient' ) ;
+        SKIP: {
+
+        if ( 'macosx' eq hostname() ) { skip( 'Tests avoided on macosx get stuck', 1 ) ; }
+        is( undef, $imap->connect(  ), 'mailimapclient_connect ipv4: connect with no server => failure' ) ;
+        }
+
+        is( 'test.lamiral.info', $imap->Server( 'test.lamiral.info' ), 'mailimapclient_connect ipv4: setting Server(test.lamiral.info)' ) ;
+        is( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4: setting Debug( 1 )' ) ;
+        is( 143, $imap->Port( 143 ), 'mailimapclient_connect ipv4: setting Port( 143 )' ) ;
+        is( 3, $imap->Timeout( 3 ), 'mailimapclient_connect ipv4: setting Timout( 30 )' ) ;
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::INET/, 'mailimapclient_connect ipv4: connect to test.lamiral.info' ) ;
+        like( $imap->logout( ), qr/Mail::IMAPClient/, 'mailimapclient_connect ipv4: logout' ) ;
+        is( undef, undef $imap, 'mailimapclient_connect ipv4: free variable' ) ;
+
+        # ipv4 + ssl
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv4 + ssl: new' ) ;
+        is( 'test.lamiral.info', $imap->Server( 'test.lamiral.info' ), 'mailimapclient_connect ipv4 + ssl: setting Server(test.lamiral.info)' ) ;
+        is( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4 + ssl: setting Debug( 1 )' ) ;
+        ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE ] ), 'mailimapclient_connect ipv4 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ;
+        is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv4 + ssl: setting Port( 993 )' ) ;
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::SSL/, 'mailimapclient_connect ipv4 + ssl: connect to test.lamiral.info' ) ;
+        is( $imap->logout( ), undef, 'mailimapclient_connect ipv4 + ssl: logout in ssl causes failure' ) ;
+        is( undef, undef $imap, 'mailimapclient_connect ipv4 + ssl: free variable' ) ;
+        
+        # ipv6 + ssl
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv6 + ssl: new' ) ;
+        is( 'ks2ipv6.lamiral.info', $imap->Server( 'ks2ipv6.lamiral.info' ), 'mailimapclient_connect ipv6 + ssl: setting Server(ks2ipv6.lamiral.info)' ) ;
+        ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE ] ), 'mailimapclient_connect ipv6 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ;
+        is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv6 + ssl: setting Port( 993 )' ) ;
+        SKIP: {
+        if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE can not do ipv6', 2 ) ; }
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::SSL/, 'mailimapclient_connect ipv6 + ssl: connect to ks2ipv6.lamiral.info' ) ;
+        is( $imap->logout( ), undef, 'mailimapclient_connect ipv6 + ssl: logout in ssl causes failure' ) ;
+        }
+        is( undef, undef $imap, 'mailimapclient_connect ipv6 + ssl: free variable' ) ;
+
+
+        note( 'Leaving  tests_mailimapclient_connect()' ) ;
+        return ;
+}
+
+sub tests_mailimapclient_connect_bug {
+        note( 'Entering tests_mailimapclient_connect_bug()' ) ;
+        my $imap ;
+
+        # ipv6
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv6: new' ) ;
+        is( 'ks2ipv6.lamiral.info', $imap->Server( 'ks2ipv6.lamiral.info' ), 'mailimapclient_connect ipv6: setting Server(ks2ipv6.lamiral.info)' ) ;        
+        is( 143, $imap->Port( 143 ), 'mailimapclient_connect ipv6: setting Port( 993 )' ) ;
+        
+        SKIP: {
+        if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE can not do ipv6', 1 ) ; }
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::INET/, 'mailimapclient_connect ipv6: connect to ks2ipv6.lamiral.info' ) 
+        or diag( 'mailimapclient_connect ipv6: ', $imap->LastError(  ), $!,  ) ;
+        }
+        #is( $imap->logout( ), undef, 'mailimapclient_connect ipv6: logout in ssl causes failure' ) ;
+        is( undef, undef $imap, 'mailimapclient_connect ipv6: free variable' ) ;
+
+        note( 'Leaving  tests_mailimapclient_connect_bug()' ) ;
+        return ;
+}
+
+sub mailimapclient_connect  {
+
+
+        return ;
+}
+
+
+      
+sub tests_connect_socket {
+        note( 'Entering tests_connect_socket()' ) ;
+        
+	is( undef, connect_socket(  ), 'connect_socket: no args' ) ;
+
+        my $socket ;
+        my $imap ;
+        SKIP: {
+                if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE cannot do ipv6', 2 ) ; }
+                
+	$socket = IO::Socket::INET6->new( 
+		PeerAddr => 'ks2ipv6.lamiral.info',
+		PeerPort => 143,
+	) ;
+
+	
+	ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 143 IO::Socket::INET6' ) ;
+        #$imap->Debug( 1 ) ;
+        #print $imap->capability(  ) ;
+	if ( $imap ) { 
+                $imap->logout(  ) ;
+        }
+	
+        #$IO::Socket::SSL::DEBUG = 4 ;
+	$socket = IO::Socket::SSL->new( 
+		PeerHost => 'ks2ipv6.lamiral.info',
+		PeerPort => 993,
+                SSL_verify_mode => SSL_VERIFY_NONE,
+	) ;
+	#print $socket ;
+	ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 993 IO::Socket::SSL' ) ;
+        #$imap->Debug( 1 ) ;
+        #print $imap->capability(  ) ;
+        $socket->close(  ) ;
+	if ( $imap ) { 
+                $socket->close(  ) ;
+        }
+        #$socket->close(SSL_no_shutdown => 1) ;
+        #$imap->logout(  ) ;
+        #print "\n" ;
+	#$imap->logout(  ) ;
+        }
+
+        note( 'Leaving  tests_connect_socket()' ) ;
+        return ;
+}
+
+sub connect_socket {
+	my( $socket ) = @ARG ;
+
+	if ( ! defined $socket ) { return ; }
+	
+	my $host = $socket->peerhost(  ) ;
+	my $port = $socket->peerport(  ) ;
+	#print "socket->peerhost: ", $socket->peerhost(  ), "\n" ;
+	#print "socket->peerport: ", $socket->peerport(  ), "\n" ;
+	my $imap = Mail::IMAPClient->new(  ) ;
+	$imap->Socket( $socket ) ;
+	my $banner = $imap->Results()->[0] ;
+	#myprint( "banner: $banner"  ) ;
+	return $imap ;
+}
+
+
+sub tests_probe_imapssl {
+        note( 'Entering tests_probe_imapssl()' ) ;
+
+        is( undef, probe_imapssl(  ),          'probe_imapssl: no args => undef' ) ;
+        is( undef, probe_imapssl( 'unknown' ), 'probe_imapssl: unknown => undef' ) ;
+
+	SKIP: {
+                if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE cannot do ipv6', 1 ) ; }
+                like( probe_imapssl( 'ks2ipv6.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: ks2ipv6.lamiral.info matches "* OK"' ) ;
+        } ;
+
+        like( probe_imapssl( 'test1.lamiral.info' ),   qr/^\* OK/, 'probe_imapssl: test1.lamiral.info matches "* OK"' ) ;
+        like( probe_imapssl( 'imap.gmail.com' ),       qr/^\* OK/, 'probe_imapssl: imap.gmail.com matches "* OK"' ) ;
+
+        note( 'Leaving  tests_probe_imapssl()' ) ;
+        return ;
+}
+
+sub probe_imapssl {
+        my $host = shift ;
+        
+        if ( ! $host ) { return ; }
+        
+  	my $socket = IO::Socket::SSL->new( 
+		PeerHost => $host,
+		PeerPort => $IMAP_SSL_PORT,
+                SSL_verify_mode => SSL_VERIFY_NONE,
+	) ;
+        #print "$socket\n" ;
+        if ( ! $socket ) { return ; }
+        
+        my $banner ;
+        $socket->sysread( $banner, 65_536 ) ;
+        #print "$banner" ;
+        $socket->close(  ) ;
+        return $banner ;
+
+}
+
 sub connect_imap {
-	my( $host, $port, $mydebugimap, $ssl, $tls, $Side, $mytimeout, $h ) = @_ ;
-	my $imap = Mail::IMAPClient->new() ;
-	if ( $ssl ) { set_ssl( $imap, $h ) }
-	if ( $tls ) { $imap->Tls( 1 ) }
-	$imap->Server( $host ) ;
-	$imap->Port( $port ) ;
-	$imap->Debug( $mydebugimap ) ;
+        my( $host, $port, $mydebugimap, $ssl, $tls, $Side, $mytimeout, $h ) = @_ ;
+        my $imap = Mail::IMAPClient->new(  ) ;
+        if ( $ssl ) { set_ssl( $imap, $h ) }
+        $imap->Server( $host ) ;
+        $imap->Port( $port ) ;
+        $imap->Debug( $mydebugimap ) ;
         $imap->Timeout( $mytimeout ) ;
-	$imap->connect(  )
-	  or die_clean( "$Side: Can not open imap connection on [$host]: $@\n" ) ;
 
+        my $side = lc $Side ;
+        myprint( "$Side: connecting on $side [$host] port [$port]\n"  ) ;
+
+        $imap->connect(  )
+          or die_clean( "$Side: Can not open imap connection on [$host]: " . $imap->LastError . " $OS_ERROR\n" ) ;
+		myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n"  ) ;
         my $banner = $imap->Results()->[0] ;
-        $imap->Banner( $banner ) ;
 
-        if ( $imap->Tls(  ) ) {
-        	set_tls( $imap, $h ) ;
-        	$imap->starttls(  )
-                or die_clean("$Side: Can not go to tls encryption on [$host]:", $imap->LastError, "\n" ) ;
+        myprint( "$Side banner: $banner"  ) ;
+        myprint( "$Side capability: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;
+
+        if ( $tls ) {
+                set_tls( $imap, $h ) ;
+                $imap->starttls(  )
+                or die_clean("$Side: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ;
                 myprint( "$Side: Socket successfuly converted to SSL\n"  ) ;
         }
         return( $imap ) ;
@@ -3099,57 +4069,63 @@ sub connect_imap {
 
 sub login_imap {
 
-	my @allargs = @_ ;
-	my(
-		$host, $port, $user, $domain, $password,
-		$mydebugimap, $mytimeout, $fastio,
-		$ssl, $tls, $authmech, $authuser, $reconnectretry,
-		$proxyauth, $uid, $split, $Side, $h ) = @allargs ;
+        my @allargs = @_ ;
+        my(
+                $host, $port, $user, $domain, $password,
+                $mydebugimap, $mytimeout, $fastio,
+                $ssl, $tls, $authmech, $authuser, $reconnectretry,
+                $proxyauth, $uid, $split, $Side, $h, $mysync ) = @allargs ;
 
-	my $side = lc $Side ;
-	myprint( "$Side: connecting and login on $side [$host] port [$port] with user [$user]\n"  ) ;
+        my $side = lc $Side ;
+        myprint( "$Side: connecting and login on $side [$host] port [$port] with user [$user]\n"  ) ;
 
-	my $imap = init_imap( @allargs ) ;
-
-	$imap->connect()
-	  or die_clean("$Side failure: can not open imap connection on $side [$host] with user [$user]: $@\n") ;
+        my $imap = init_imap( @allargs ) ;
 
+        $imap->connect()
+          or die_clean("$Side failure: can not open imap connection on $side [$host] with user [$user]: " . $imap->LastError . " $OS_ERROR\n" ) ;
+		myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n"  ) ;
         my $banner = $imap->Results()->[0] ;
-        $imap->Banner( $banner ) ;
-	myprint( "$Side banner: $banner"  ) ;
+
+        myprint( "$Side banner: $banner"  ) ;
+	myprint( "$Side capability before authentication: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;
+
+	if ( (! $ssl) and (! defined $tls ) and $imap->has_capability( 'STARTTLS' ) ) {
+		myprint( "$Side: going to ssl because STARTTLS is in CAPABILITY. Use --notls1 or --notls2 to avoid that behavior\n" ) ;
+		$tls = 1 ;
+	}
 
         if ( $authmech eq 'PREAUTH' ) {
-        	if ( $imap->IsAuthenticated( ) ) {
-        		$imap->Socket ;
-			myprintf("%s: Assuming PREAUTH for %s\n", $Side, $imap->Server ) ;
-        	}else{
-                	die_clean( "$Side failure: error login on $side [$host] with user [$user] auth [PREAUTH]" ) ;
+                if ( $imap->IsAuthenticated( ) ) {
+                        $imap->Socket ;
+                        myprintf("%s: Assuming PREAUTH for %s\n", $Side, $imap->Server ) ;
+                }else{
+                        die_clean( "$Side failure: error login on $side [$host] with user [$user] auth [PREAUTH]" ) ;
                 }
         }
 
-        if ( $imap->Tls(  ) ) {
-		set_tls( $imap, $h ) ;
-        	$imap->starttls(  )
+        if ( $tls ) {
+                set_tls( $imap, $h ) ;
+                $imap->starttls(  )
                 or die_clean("$Side failure: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ;
                 myprint( "$Side: Socket successfuly converted to SSL\n"  ) ;
         }
 
         authenticate_imap( $imap, @allargs ) ;
 
-	myprint( "$Side: success login on [$host] with user [$user] auth [$authmech]\n"  ) ;
-	return( $imap ) ;
+        myprint( "$Side: success login on [$host] with user [$user] auth [$authmech]\n"  ) ;
+        return( $imap ) ;
 }
 
 
 sub authenticate_imap {
 
-	my($imap,
+        my($imap,
            $host, $port, $user, $domain, $password,
-	   $mydebugimap, $mytimeout, $fastio,
-	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
-	   $proxyauth, $uid, $split, $Side, $h ) = @_ ;
+           $mydebugimap, $mytimeout, $fastio,
+           $ssl, $tls, $authmech, $authuser, $reconnectretry,
+           $proxyauth, $uid, $split, $Side, $h, $mysync ) = @_ ;
 
-	check_capability( $imap, $authmech, $Side ) ;
+        check_capability( $imap, $authmech, $Side ) ;
 
         if ( $proxyauth ) {
                 $imap->Authmechanism(q{}) ;
@@ -3159,29 +4135,29 @@ sub authenticate_imap {
                 $imap->User($user) ;
         }
 
-	$imap->Authcallback(\&xoauth)  if ( 'XOAUTH'  eq $authmech ) ;
-	$imap->Authcallback(\&xoauth2) if ( 'XOAUTH2' eq $authmech ) ;
-	$imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $authmech ) or ( 'EXTERNAL' eq $authmech )  ) ;
+        $imap->Authcallback(\&xoauth)  if ( 'XOAUTH'  eq $authmech ) ;
+        $imap->Authcallback(\&xoauth2) if ( 'XOAUTH2' eq $authmech ) ;
+        $imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $authmech ) or ( 'EXTERNAL' eq $authmech )  ) ;
 
         $imap->Domain($domain) if (defined $domain) ;
         $imap->Authuser($authuser) ;
         $imap->Password($password) ;
 
-	unless ( $authmech eq 'PREAUTH' or $imap->login( ) ) {
-		my $info  = "$Side failure: Error login on [$host] with user [$user] auth" ;
-		my $einfo = $imap->LastError || @{$imap->History}[$LAST] ;
-		chomp $einfo ;
-		my $error = "$info [$authmech]: $einfo\n" ;
+        unless ( $authmech eq 'PREAUTH' or $imap->login( ) ) {
+                my $info  = "$Side failure: Error login on [$host] with user [$user] auth" ;
+                my $einfo = $imap->LastError || @{$imap->History}[$LAST] ;
+                chomp $einfo ;
+                my $error = "$info [$authmech]: $einfo\n" ;
                 if ( $authmech eq 'LOGIN' or $imap->IsUnconnected(  ) or $authuser ) {
-                	die_clean( $error ) ;
+                        die_clean( $error ) ;
                 }else{
-			myprint( $error  ) ;
+                        myprint( $error  ) ;
                 }
-		myprint( "$Side info: trying LOGIN Auth mechanism on [$host] with user [$user]\n"  ) ;
-		$imap->Authmechanism(q{}) ;
-		$imap->login() or
-		  die_clean("$info [LOGIN]: ", $imap->LastError, "\n") ;
-	}
+                myprint( "$Side info: trying LOGIN Auth mechanism on [$host] with user [$user]\n"  ) ;
+                $imap->Authmechanism(q{}) ;
+                $imap->login() or
+                  die_clean("$info [LOGIN]: ", $imap->LastError, "\n") ;
+        }
 
         if ( $proxyauth ) {
                 if ( ! $imap->proxyauth( $user ) ) {
@@ -3192,41 +4168,50 @@ sub authenticate_imap {
                 }
         }
 
-	return ;
+        return ;
 }
 
-sub check_capability {
+sub check_capability  {
 
-	my( $imap, $authmech, $Side ) = @_ ;
+        my( $imap, $authmech, $Side ) = @_ ;
 
-	if ($imap->has_capability("AUTH=$authmech")
-	    or $imap->has_capability($authmech)
-	   ) {
-		myprintf("%s: %s says it has CAPABILITY for AUTHENTICATE %s\n",
-		       $Side, $imap->Server, $authmech);
+
+        if ($imap->has_capability( "AUTH=$authmech" )
+            or $imap->has_capability( $authmech ) ) {
+                myprintf("%s: %s says it has CAPABILITY for AUTHENTICATE %s\n",
+                       $Side, $imap->Server, $authmech) ;
+		return ;
+        }
+
+	if ( $authmech eq 'LOGIN' ) {
+		# Well, the warning is so common and useless that I prefer to remove it
+		# No more "... says it has NO CAPABILITY for AUTHENTICATE LOGIN"
+		return ;
 	}
-	else {
-		myprintf("%s: %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
-		       $Side, $imap->Server, $authmech);
-		if ($authmech eq 'PLAIN') {
-			myprint( "$Side: frequently PLAIN is only supported with SSL, ",
-			  "try --ssl or --tls options\n" ) ;
-		}
-	}
-	return ;
+
+
+	myprintf( "%s: %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
+                       $Side, $imap->Server, $authmech ) ;
+
+		       if ($authmech eq 'PLAIN') {
+		myprint( "$Side: frequently PLAIN is only supported with SSL, try --ssl or --tls options\n" ) ;
+        }
+
+        return ;
 }
 
 sub set_ssl {
-	my ( $imap, $h ) = @_ ;
+        my ( $imap, $h ) = @_ ;
         # SSL_version can be
         #    SSLv3 SSLv2 SSLv23 SSLv23:!SSLv2 (last one is the default in IO-Socket-SSL-1.953)
         #
 
         my $sslargs_hash = $h->{sslargs} ;
 
-	my $sslargs_default = {
-		SSL_verify_mode => $DEFAULT_SSL_VERIFY,
-        	SSL_verifycn_scheme => 'imap',
+        my $sslargs_default = {
+                SSL_verify_mode => $DEFAULT_SSL_VERIFY,
+                SSL_verifycn_scheme => 'imap',
+		SSL_cipher_list => 'DEFAULT:!DH',
         } ;
 
         # initiate with default values
@@ -3241,16 +4226,17 @@ sub set_ssl {
         my @sslargs_mix = %sslargs_mix ;
         #myprint( Data::Dumper->Dump( [ $sslargs_hash, $sslargs_default, \%sslargs_mix, \@sslargs_mix ] )  ) ;
         $imap->Ssl( \@sslargs_mix ) ;
-	return ;
+        return ;
 }
 
 sub set_tls {
-	my ( $imap, $h ) = @_ ;
+        my ( $imap, $h ) = @_ ;
 
         my $sslargs_hash = $h->{sslargs} ;
 
-	my $sslargs_default = {
-		SSL_verify_mode => $DEFAULT_SSL_VERIFY,
+        my $sslargs_default = {
+                SSL_verify_mode => $DEFAULT_SSL_VERIFY,
+		SSL_cipher_list => 'DEFAULT:!DH',
         } ;
 
         # initiate with default values
@@ -3265,42 +4251,47 @@ sub set_tls {
         my @sslargs_mix = %sslargs_mix ;
 
         $imap->Starttls( \@sslargs_mix ) ;
-	return ;
+        return ;
 }
 
 
 
 
 sub init_imap {
-	my(
-	   $host, $port, $user, $domain, $password,
-	   $mydebugimap, $mytimeout, $fastio,
-	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
-	   $proxyauth, $uid, $split, $Side, $h ) = @_ ;
+        my(
+           $host, $port, $user, $domain, $password,
+           $mydebugimap, $mytimeout, $fastio,
+           $ssl, $tls, $authmech, $authuser, $reconnectretry,
+           $proxyauth, $uid, $split, $Side, $h, $mysync ) = @_ ;
 
-	my ( $imap ) ;
+        my ( $imap ) ;
 
-	$imap = Mail::IMAPClient->new() ;
+        $imap = Mail::IMAPClient->new() ;
 
-	if ( $ssl ) { set_ssl( $imap, $h ) }
-	if ( $tls ) { $imap->Tls( 1 ) } # can not do set_tls() here because connect() will directly do a STARTTLS
-	$imap->Clear(1);
-	$imap->Server($host);
-	$imap->Port($port);
-	$imap->Fast_io($fastio);
-	$imap->Buffer($buffersize || $DEFAULT_BUFFER_SIZE);
-	$imap->Uid($uid);
-
-	$imap->Peek(1);
-	$imap->Debug($mydebugimap);
-	defined  $mytimeout  and $imap->Timeout( $mytimeout ) ;
-
-	$imap->Reconnectretry( $reconnectretry ) if ( $reconnectretry ) ;
-	$imap->Ignoresizeerrors( $allowsizemismatch ) ;
-	$split and $imap->Maxcommandlength( $SPLIT_FACTOR * $split ) ;
+        if ( $ssl ) { set_ssl( $imap, $h ) }
+        if ( $tls ) {  } # can not do set_tls() here because connect() will directly do a STARTTLS
+        $imap->Clear(1);
+        $imap->Server($host);
+        $imap->Port($port);
+        $imap->Fast_io($fastio);
+        $imap->Buffer($buffersize || $DEFAULT_BUFFER_SIZE);
+        $imap->Uid($uid);
 
 
-	return( $imap ) ;
+        $imap->Peek(1);
+        $imap->Debug($mydebugimap);
+	if ( $mysync->{ showpasswords } ) {
+		$imap->Showcredentials( 1 ) ;
+	}
+        defined  $mytimeout  and $imap->Timeout( $mytimeout ) ;
+
+        $imap->Reconnectretry( $reconnectretry ) if ( $reconnectretry ) ;
+	$imap->{IMAPSYNC_RECONNECT_COUNT} = 0 ;
+        $imap->Ignoresizeerrors( $allowsizemismatch ) ;
+        $split and $imap->Maxcommandlength( $SPLIT_FACTOR * $split ) ;
+
+
+        return( $imap ) ;
 
 }
 
@@ -3341,12 +4332,12 @@ sub plainauth {
 # If the password arg ends in .json, it will assume this new json method, otherwise it
 # will fallback to the "oauth client id;.p12" format it was previously using.
 sub xoauth2 {
-	require JSON::WebToken ;
-	require LWP::UserAgent ;
-	require HTML::Entities ;
-	require JSON ;
-	require JSON::WebToken::Crypt::RSA ;
-	require Crypt::OpenSSL::RSA ;
+        require JSON::WebToken ;
+        require LWP::UserAgent ;
+        require HTML::Entities ;
+        require JSON ;
+        require JSON::WebToken::Crypt::RSA ;
+        require Crypt::OpenSSL::RSA ;
         require Encode::Byte ;
         require IO::Socket::SSL ;
 
@@ -3355,11 +4346,11 @@ sub xoauth2 {
 
         my ($iss,$key);
 
-        if( $imap->Password =~ /^(.*\.json)$/ ) {
+        if( $imap->Password =~ /^(.*\.json)$/x ) {
             my $json = JSON->new( ) ;
             my $filename = $1;
             $debug and myprint( "XOAUTH2 json file: $filename\n" ) ;
-            open( my $FILE, '<', $filename ) or die_clean( "error [$filename]: $! " ) ;
+            open( my $FILE, '<', $filename ) or die_clean( "error [$filename]: $OS_ERROR " ) ;
             my $jsonfile = $json->decode( join q{}, <$FILE> ) ;
             close $FILE ;
 
@@ -3370,7 +4361,7 @@ sub xoauth2 {
         }
         else {
             # Get iss (service account address), keyfile name, and keypassword if necessary
-            ( $iss, my $keyfile, my $keypass ) = $imap->Password =~ /([\-\d\w\@\.]+);([a-zA-Z0-9 \_\-\.\/]+);?(.*)?/ ;
+            ( $iss, my $keyfile, my $keypass ) = $imap->Password =~ /([\-\d\w\@\.]+);([a-zA-Z0-9 \_\-\.\/]+);?(.*)?/x ;
 
             # Assume key password is google default if not provided
             $keypass = 'notasecret' if not $keypass;
@@ -3494,211 +4485,224 @@ sub xoauth {
         return encode_base64("$string", q{});
 }
 
-sub server_banner {
-	my $imap = shift;
-	my $banner = $imap->Banner() ||  "No banner\n";
-	return $banner;
- }
 
 
 sub banner_imapsync {
 
-	my @argv = @_ ;
+        my @argv = @_ ;
 
-	my $banner_imapsync = join q{},
-		q{$RCSfile: imapsync,v $ },
-		q{$Revision: 1.727 $ },
-		q{$Date: 2016/08/19 10:30:36 $ },
-		"\n", localhost_info(), "\n",
-		"Command line used:\n",
-		"$0 ", command_line_nopassword( @argv ), "\n" ;
+        my $banner_imapsync = join q{},
+                q{$RCSfile: imapsync,v $ },
+                q{$Revision: 1.836 $ },
+                q{$Date: 2017/09/05 16:14:53 $ },
+                "\n", localhost_info(), "\n",
+                "Command line used:\n",
+                "$PROGRAM_NAME ", command_line_nopassword( @argv ), "\n" ;
 
         return( $banner_imapsync ) ;
 }
 
-sub is_valid_directory {
-	my $dir = shift;
+sub do_valid_directory {
+        my $dir = shift;
 
-	# all good => return ok.
-	return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
+        # all good => return ok.
+        return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
 
-	# exist but bad
-	if ( -e $dir and not -d _ ) {
-		myprint( "Error: $dir exists but is not a directory\n"  ) ;
-		return( 0 ) ;
-	}
-	if ( -e $dir and not -w _ ) {
-		my $sb = stat $dir ;
-		myprintf( "Error: directory %s is not writable for user %s, permissions are %04o and owner is %s ( uid %s )\n",
-		         $dir, getpwuid_any_os( $EFFECTIVE_USER_ID ), ($sb->mode & oct($PERMISSION_FILTER) ), getpwuid_any_os( $sb->uid ), $sb->uid(  ) ) ;
-		return( 0 ) ;
-	}
-	# Trying to create it
-	myprint( "Creating directory $dir\n"  ) ;
-	eval { mkpath( $dir ) } ;
-	myprint( "$@" ) if ( $@ )  ;
-	return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
-	return( 0 ) ;
+        # exist but bad
+        if ( -e $dir and not -d _ ) {
+                myprint( "Error: $dir exists but is not a directory\n"  ) ;
+                return( 0 ) ;
+        }
+        if ( -e $dir and not -w _ ) {
+                my $sb = stat $dir ;
+                myprintf( "Error: directory %s is not writable for user %s, permissions are %04o and owner is %s ( uid %s )\n",
+                         $dir, getpwuid_any_os( $EFFECTIVE_USER_ID ), ($sb->mode & oct($PERMISSION_FILTER) ), getpwuid_any_os( $sb->uid ), $sb->uid(  ) ) ;
+                return( 0 ) ;
+        }
+        # Trying to create it
+        myprint( "Creating directory $dir\n"  ) ;
+        if ( ! eval { mkpath( $dir ) } ) {
+                myprint( "$EVAL_ERROR" ) if ( $EVAL_ERROR )  ;
+        }
+        return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
+        return( 0 ) ;
 }
 
-sub tests_is_valid_directory {
-        Readonly my $NB_UNIX_tests_is_valid_directory => 4 ;
-	SKIP: {
-		skip( 'Tests only for Unix', $NB_UNIX_tests_is_valid_directory ) if ( 'MSWin32' eq $OSNAME ) ;
-		ok( 1 == is_valid_directory( '.'), 'is_valid_directory: . good' ) ;
-		ok( 1 == is_valid_directory( './tmp/tests/valid/sub'), 'is_valid_directory: ./tmp/tests/valid/sub good' ) ;
-		diag( 'Error / not writable is on purpose' ) ;
-		ok( 0 == is_valid_directory( '/'), 'is_valid_directory: / bad' ) ;
-		diag( 'Error permission denied on /noway is on purpose' ) ;
-		ok( 0 == is_valid_directory( '/noway'), 'is_valid_directory: /noway bad' ) ;
-	}
-	return ;
+sub tests_do_valid_directory {
+	note( 'Entering tests_do_valid_directory()' ) ;
+
+        Readonly my $NB_UNIX_tests_do_valid_directory => 4 ;
+        SKIP: {
+                skip( 'Tests only for Unix', $NB_UNIX_tests_do_valid_directory ) if ( 'MSWin32' eq $OSNAME ) ;
+                ok( 1 == do_valid_directory( '.'), 'do_valid_directory: . good' ) ;
+                ok( 1 == do_valid_directory( './W/tmp/tests/valid/sub'), 'do_valid_directory: ./W/tmp/tests/valid/sub good' ) ;
+                diag( 'Error / not writable is on purpose' ) ;
+                ok( 0 == do_valid_directory( '/'), 'do_valid_directory: / bad' ) ;
+                diag( 'Error permission denied on /noway is on purpose' ) ;
+                ok( 0 == do_valid_directory( '/noway'), 'do_valid_directory: /noway bad' ) ;
+        }
+	note( 'Leaving  tests_do_valid_directory()' ) ;
+        return ;
 }
 
 sub write_pidfile {
-	my $pid_filename = shift ;
+        my $pid_filename = shift ;
         my $lock = shift ;
-        
-	myprint( "PID file is $pid_filename ( to change it use --pidfile filepath ; to avoid it use --pidfile \"\" )\n" ) ;
-	if ( -e $pid_filename and $lock ) {
-		myprint( "$pid_filename already exists, another imapsync may be curently running. Aborting imapsync.\n"  ) ;
+
+        myprint( "PID file is $pid_filename ( to change it use --pidfile filepath ; to avoid it use --pidfile \"\" )\n" ) ;
+        if ( -e $pid_filename and $lock ) {
+                myprint( "$pid_filename already exists, another imapsync may be curently running. Aborting imapsync.\n"  ) ;
                 exit $EXIT_PID_FILE_ALREADY_EXIST ;
-	}
-	if ( -e $pid_filename ) {
-		myprint( "$pid_filename already exists, overwriting it ( use --pidfilelocking to avoid concurrent runs )\n"  ) ;
-	}
+        }
+        if ( -e $pid_filename ) {
+                myprint( "$pid_filename already exists, overwriting it ( use --pidfilelocking to avoid concurrent runs )\n"  ) ;
+        }
 
-	open my $FILE_HANDLE, '>', $pid_filename
-        	or do {
-			myprint( "Could not open $pid_filename for writing. Check permissions or disk space."  ) ;
-		return ;
-	} ;
-        myprint( "Wrinting my PID $PROCESS_ID in $pid_filename\n"  ) ;
-	print $FILE_HANDLE $PROCESS_ID ;
-	close $FILE_HANDLE ;
+        open my $FILE_HANDLE, '>', $pid_filename
+                or do {
+                        myprint( "Could not open $pid_filename for writing. Check permissions or disk space."  ) ;
+                return ;
+        } ;
+        myprint( "Writing my PID $PROCESS_ID in $pid_filename\n"  ) ;
+        print $FILE_HANDLE $PROCESS_ID ;
+        close $FILE_HANDLE ;
 
-	return( $PROCESS_ID ) ;
+        return( $PROCESS_ID ) ;
 }
 
 sub remove_tmp_files {
-        my $mysync = shift ;
-	unlink $mysync->{pidfile} ;
-	return ;
+        my $mysync = shift or return ;
+	$mysync->{pidfile} or return ;
+        if ( -e $mysync->{pidfile} ) {
+		unlink $mysync->{pidfile} ;
+	}
+        return ;
 }
 
 
 sub exit_clean {
         my $mysync = shift ;
-	my $status = shift ;
-	$status = defined  $status  ? $status : $EXIT_UNKNOWN ;
+        my $status = shift ;
+        $status = defined  $status  ? $status : $EXIT_UNKNOWN ;
         remove_tmp_files( $mysync ) ;
         myprint( "Exiting with return value $status\n" ) ;
         if ( $mysync->{log} ) {
                 myprint( "Log file is $mysync->{logfile} ( to change it, use --logfile filepath ; or use --nolog to turn off logging )\n" ) ;
                 close $mysync->{logfile_handle} ;
         }
-	exit $status ;
+        exit $status ;
 }
 
 sub die_clean {
-	my @messages = @_ ;
+        my @messages = @_ ;
         remove_tmp_files( $sync ) ;
-	die @messages ;
+        myprint( @messages ) ;
+	exit 255 ;
 }
 
 sub missing_option {
-	my ( $option ) = @_ ;
-	die_clean( "$option option is mandatory, for help run $0 --help\n" ) ;
-	return ;
+        my ( $option ) = @_ ;
+        die_clean( "$option option is mandatory, for help run $PROGRAM_NAME --help\n" ) ;
+        return ;
 }
 
 
 sub fix_Inbox_INBOX_mapping {
-	my( $h1_all, $h2_all ) = @_ ;
+        my( $h1_all, $h2_all ) = @_ ;
 
-	my $regex = q{} ;
-	SWITCH: {
-		if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{INBOX}  ) { $regex = q{} ; last SWITCH ; } ;
-		if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{Inbox}  ) { $regex = q{} ; last SWITCH ; } ;
-		if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{Inbox}  ) { $regex = q{s/^INBOX$/Inbox/x} ; last SWITCH ; } ;
-		if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{INBOX}  ) { $regex = q{s/^Inbox$/INBOX/x} ; last SWITCH ; } ;
-	} ;
+        my $regex = q{} ;
+        SWITCH: {
+                if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{INBOX}  ) { $regex = q{} ; last SWITCH ; } ;
+                if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{Inbox}  ) { $regex = q{} ; last SWITCH ; } ;
+                if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{Inbox}  ) { $regex = q{s/^INBOX$/Inbox/x} ; last SWITCH ; } ;
+                if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{INBOX}  ) { $regex = q{s/^Inbox$/INBOX/x} ; last SWITCH ; } ;
+        } ;
         return( $regex ) ;
 }
 
 sub tests_fix_Inbox_INBOX_mapping {
+	note( 'Entering tests_fix_Inbox_INBOX_mapping()' ) ;
 
-	my( $h1_all, $h2_all ) ;
 
-	$h1_all = { 'INBOX' => q{} } ;
-	$h2_all = { 'INBOX' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX INBOX' ) ;
+        my( $h1_all, $h2_all ) ;
 
-	$h1_all = { 'Inbox' => q{} } ;
-	$h2_all = { 'Inbox' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox Inbox' ) ;
+        $h1_all = { 'INBOX' => q{} } ;
+        $h2_all = { 'INBOX' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX INBOX' ) ;
 
-	$h1_all = { 'INBOX' => q{} } ;
-	$h2_all = { 'Inbox' => q{} } ;
-	ok( q{s/^INBOX$/Inbox/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX Inbox' ) ;
+        $h1_all = { 'Inbox' => q{} } ;
+        $h2_all = { 'Inbox' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox Inbox' ) ;
 
-	$h1_all = { 'Inbox' => q{} } ;
-	$h2_all = { 'INBOX' => q{} } ;
-	ok( q{s/^Inbox$/INBOX/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox INBOX' ) ;
+        $h1_all = { 'INBOX' => q{} } ;
+        $h2_all = { 'Inbox' => q{} } ;
+        ok( q{s/^INBOX$/Inbox/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX Inbox' ) ;
 
-	$h1_all = { 'INBOX' => q{} } ;
-	$h2_all = { 'rrrrr' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX rrrrrr' ) ;
+        $h1_all = { 'Inbox' => q{} } ;
+        $h2_all = { 'INBOX' => q{} } ;
+        ok( q{s/^Inbox$/INBOX/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox INBOX' ) ;
 
-	$h1_all = { 'rrrrr' => q{} } ;
-	$h2_all = { 'Inbox' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: rrrrr Inbox' ) ;
+        $h1_all = { 'INBOX' => q{} } ;
+        $h2_all = { 'rrrrr' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX rrrrrr' ) ;
 
-	return ;
+        $h1_all = { 'rrrrr' => q{} } ;
+        $h2_all = { 'Inbox' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: rrrrr Inbox' ) ;
+
+	note( 'Leaving  tests_fix_Inbox_INBOX_mapping()' ) ;
+        return ;
 }
 
 
 sub jux_utf8_list {
-	my @s_inp = @_ ;
-	my $s_out = q{} ;
-	foreach my $s ( @s_inp ) {
-		$s_out .= jux_utf8( $s ) . "\n" ;
-	}
-	return( $s_out ) ;
+        my @s_inp = @_ ;
+        my $s_out = q{} ;
+        foreach my $s ( @s_inp ) {
+                $s_out .= jux_utf8( $s ) . "\n" ;
+        }
+        return( $s_out ) ;
 }
 
 sub tests_jux_utf8_list {
-	ok( q{} eq jux_utf8_list(  ), 'jux_utf8_list: void' ) ;
-	ok( "[]\n" eq jux_utf8_list( q{} ), 'jux_utf8_list: empty string' ) ;
-	ok( "[INBOX]\n" eq jux_utf8_list( 'INBOX' ), 'jux_utf8_list: INBOX' ) ;
-	ok( "[&ANY-] = [Ö]\n" eq jux_utf8_list( '&ANY-' ), 'jux_utf8_list: &ANY-' ) ;
-	return( 0 ) ;
+	note( 'Entering tests_jux_utf8_list()' ) ;
+
+        ok( q{} eq jux_utf8_list(  ), 'jux_utf8_list: void' ) ;
+        ok( "[]\n" eq jux_utf8_list( q{} ), 'jux_utf8_list: empty string' ) ;
+        ok( "[INBOX]\n" eq jux_utf8_list( 'INBOX' ), 'jux_utf8_list: INBOX' ) ;
+        ok( "[&ANY-] = [Ö]\n" eq jux_utf8_list( '&ANY-' ), 'jux_utf8_list: &ANY-' ) ;
+
+	note( 'Leaving  tests_jux_utf8_list()' ) ;
+        return( 0 ) ;
 }
 
 sub jux_utf8 {
-	# juxtapose utf8 at the right if different
+        # juxtapose utf8 at the right if different
         my ( $s_utf7 ) =  shift ;
         my ( $s_utf8 ) =  imap_utf7_decode( $s_utf7 ) ;
 
         if ( $s_utf7 eq $s_utf8 ) {
-        	#myprint( "[$s_utf7]\n"  ) ;
-        	return( "[$s_utf7]" ) ;
+                #myprint( "[$s_utf7]\n"  ) ;
+                return( "[$s_utf7]" ) ;
         }else{
-        	#myprint( "[$s_utf7] = [$s_utf8]\n"  ) ;
-        	return( "[$s_utf7] = [$s_utf8]" ) ;
+                #myprint( "[$s_utf7] = [$s_utf8]\n"  ) ;
+                return( "[$s_utf7] = [$s_utf8]" ) ;
         }
 }
 
 # editing utf8 can be tricky without an utf8 editor
 sub tests_jux_utf8 {
-	ok( '[INBOX]' eq jux_utf8( 'INBOX'), 'jux_utf8: INBOX => [INBOX]' ) ;
-	ok( '[&ZTZO9nux-] = [收件箱]' eq jux_utf8( '&ZTZO9nux-'), 'jux_utf8: => [&ZTZO9nux-] = [收件箱]' ) ;
-	ok( '[&ANY-] = [Ö]' eq jux_utf8( '&ANY-'), 'jux_utf8: &ANY- => [&ANY-] = [Ö]' ) ;
+	note( 'Entering tests_jux_utf8()' ) ;
+
+        ok( '[INBOX]' eq jux_utf8( 'INBOX'), 'jux_utf8: INBOX => [INBOX]' ) ;
+        ok( '[&ZTZO9nux-] = [收件箱]' eq jux_utf8( '&ZTZO9nux-'), 'jux_utf8: => [&ZTZO9nux-] = [收件箱]' ) ;
+        ok( '[&ANY-] = [Ö]' eq jux_utf8( '&ANY-'), 'jux_utf8: &ANY- => [&ANY-] = [Ö]' ) ;
         ok( '[]' eq jux_utf8( q{} ), 'jux_utf8: void => []' ) ;
         ok( '[+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]' eq jux_utf8( '+BD8EQAQ1BDQEOwQ+BDM-' ), 'jux_utf8: => [+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]' ) ;
         ok( '[&BB8EQAQ+BDUEOgRC-] = [Проект]'      eq jux_utf8( '&BB8EQAQ+BDUEOgRC-' ),    'jux_utf8: => [&BB8EQAQ+BDUEOgRC-] = [Проект]' ) ;
 
-	return( 0 ) ;
+	note( 'Leaving  tests_jux_utf8()' ) ;
+        return ;
 }
 
 # Copied from http://cpansearch.perl.org/src/FABPOT/Unicode-IMAPUtf7-2.01/lib/Unicode/IMAPUtf7.pm
@@ -3711,64 +4715,64 @@ sub imap_utf7_decode {
         # On remplace , par / dans les BASE 64 (, entre & et -)
         # On remplace les &, non suivi d'un - par +
         # On remplace les &- par &
-        $s =~ s/&([^,&\-]*),([^,\-&]*)\-/&$1\/$2\-/g ;
-        $s =~ s/&(?!\-)/\+/g ;
-        $s =~ s/&\-/&/g ;
+        $s =~ s/&([^,&\-]*),([^,\-&]*)\-/&$1\/$2\-/xg ;
+        $s =~ s/&(?!\-)/\+/xg ;
+        $s =~ s/&\-/&/xg ;
         return( Unicode::String::utf7( $s )->utf8 ) ;
 }
 
 sub imap_utf7_encode {
-	my ( $s ) = @_ ;
+        my ( $s ) = @_ ;
 
-	$s = Unicode::String::utf8( $s )->utf7 ;
+        $s = Unicode::String::utf8( $s )->utf7 ;
 
-	$s =~ s/\+([^\/&\-]*)\/([^\/\-&]*)\-/\+$1,$2\-/g ;
-	$s =~ s/&/&\-/g ;
-	$s =~ s/\+([^+\-]+)?\-/&$1\-/g ;
-	return( $s ) ;
+        $s =~ s/\+([^\/&\-]*)\/([^\/\-&]*)\-/\+$1,$2\-/xg ;
+        $s =~ s/&/&\-/xg ;
+        $s =~ s/\+([^+\-]+)?\-/&$1\-/xg ;
+        return( $s ) ;
 }
 
 
 
 
 sub select_folder {
-	my ( $imap, $folder, $hostside ) = @_ ;
-	if ( ! $imap->select( $folder ) ) {
-		my $error = join q{},
-			"$hostside folder $folder: Could not select: ",
-			$imap->LastError,  "\n" ;
-		errors_incr( $sync, $error ) ;
-		return( 0 ) ;
-	}else{
-		# ok select succeeded
-		return( 1 ) ;
-	}
+        my ( $imap, $folder, $hostside ) = @_ ;
+        if ( ! $imap->select( $folder ) ) {
+                my $error = join q{},
+                        "$hostside folder $folder: Could not select: ",
+                        $imap->LastError,  "\n" ;
+                errors_incr( $sync, $error ) ;
+                return( 0 ) ;
+        }else{
+                # ok select succeeded
+                return( 1 ) ;
+        }
 }
 
 sub examine_folder {
-	my ( $imap, $folder, $hostside ) = @_ ;
-	if ( ! $imap->examine( $folder ) ) {
-		my $error = join q{},
-			"$hostside folder $folder: Could not examine: ",
-			$imap->LastError,  "\n" ;
-		errors_incr( $sync, $error ) ;
-		return( 0 ) ;
-	}else{
-		# ok select succeeded
-		return( 1 ) ;
-	}
+        my ( $imap, $folder, $hostside ) = @_ ;
+        if ( ! $imap->examine( $folder ) ) {
+                my $error = join q{},
+                        "$hostside folder $folder: Could not examine: ",
+                        $imap->LastError,  "\n" ;
+                errors_incr( $sync, $error ) ;
+                return( 0 ) ;
+        }else{
+                # ok select succeeded
+                return( 1 ) ;
+        }
 }
 
 
 
 
 sub count_from_select {
-	my @lines = @_ ;
+        my @lines = @_ ;
         my $count ;
         foreach my $line ( @lines ) {
-        	#myprint( "line = [$line]\n"  ) ;
-                if ( $line =~ m/^\*\s+(\d+)\s+EXISTS/ ) {
-                	$count = $1 ;
+                #myprint( "line = [$line]\n"  ) ;
+                if ( $line =~ m/^\*\s+(\d+)\s+EXISTS/x ) {
+                        $count = $1 ;
                         return( $count ) ;
                 }
         }
@@ -3793,34 +4797,34 @@ sub count_from_select {
 
 
 sub create_folder_old {
-	my( $imap, $h2_fold, $h1_fold ) = @_ ;
+        my( $imap, $h2_fold, $h1_fold ) = @_ ;
 
-	myprint( "Creating (old way) folder [$h2_fold] on host2\n" ) ;
+        myprint( "Creating (old way) folder [$h2_fold] on host2\n" ) ;
         if ( ( 'INBOX' eq uc  $h2_fold )
          and ( $imap->exists( $h2_fold ) ) ) {
                 myprint( "Folder [$h2_fold] already exists\n"  ) ;
                 return( 1 ) ;
         }
-	if ( ! $dry ){
-		if ( ! $imap->create( $h2_fold ) ) {
-			my $error = join q{},
-				"Could not create folder [$h2_fold] from [$h1_fold]: ",
-				$imap->LastError(  ), "\n" ;
-			errors_incr( $sync, $error ) ;
+        if ( ! $sync->{dry} ){
+                if ( ! $imap->create( $h2_fold ) ) {
+                        my $error = join q{},
+                                "Could not create folder [$h2_fold] from [$h1_fold]: ",
+                                $imap->LastError(  ), "\n" ;
+                        errors_incr( $sync, $error ) ;
                         # success if folder exists ("already exists" error)
                         return( 1 ) if $imap->exists( $h2_fold ) ;
                         # failure since create failed
-			return( 0 ) ;
-		}else{
-			#create succeeded
+                        return( 0 ) ;
+                }else{
+                        #create succeeded
                         myprint( "Created ( the old way ) folder [$h2_fold] on host2\n"  ) ;
-			return( 1 ) ;
-		}
-	}else{
-		# dry mode, no folder so many imap will fail, assuming failure
-                myprint( "Created ( the old way ) folder [$h2_fold] on host2 $dry_message\n"  ) ;
-		return( 0 ) ;
-	}
+                        return( 1 ) ;
+                }
+        }else{
+                # dry mode, no folder so many imap will fail, assuming failure
+                myprint( "Created ( the old way ) folder [$h2_fold] on host2 $sync->{dry_message}\n"  ) ;
+                return( 0 ) ;
+        }
 }
 
 
@@ -3833,9 +4837,9 @@ sub create_folder {
                 return( 0 ) ;
         }
 
-	if ( $create_folder_old ) {
-        	return( create_folder_old( $imap2 , $h2_fold , $h1_fold ) ) ;
-	}
+        if ( $create_folder_old ) {
+                return( create_folder_old( $imap2 , $h2_fold , $h1_fold ) ) ;
+        }
         myprint( "Creating folder [$h2_fold] on host2\n"  ) ;
         if ( ( 'INBOX' eq uc  $h2_fold  )
          and ( $imap2->exists( $h2_fold ) ) ) {
@@ -3854,20 +4858,20 @@ sub create_folder {
                 return( 0 ) ;
         }
 
-        @parts = split /\Q$h2_sep\E/, $h2_fold ;
+        @parts = split /\Q$h2_sep\E/x, $h2_fold ;
         pop @parts ;
         $parent = join $h2_sep, @parts ;
-        $parent =~ s/^\s+|\s+$//g ;
+        $parent =~ s/^\s+|\s+$//xg ;
         if ( ( $parent ne q{} ) and ( ! $imap2->exists( $parent ) ) ) {
                 create_folder( $imap2 , $parent , $h1_fold ) ;
         }
 
-        if ( ! $dry ) {
+        if ( ! $sync->{dry} ) {
                 if ( ! $imap2->create( $h2_fold ) ) {
-			my $error = join q{},
-				"Could not create folder [$h2_fold] from [$h1_fold]: " ,
-				$imap2->LastError(  ), "\n" ;
-			errors_incr( $sync, $error ) ;
+                        my $error = join q{},
+                                "Could not create folder [$h2_fold] from [$h1_fold]: " ,
+                                $imap2->LastError(  ), "\n" ;
+                        errors_incr( $sync, $error ) ;
                         # success if folder exists ("already exists" error)
                         return( 1 ) if $imap2->exists( $h2_fold ) ;
                         # failure since create failed
@@ -3879,395 +4883,412 @@ sub create_folder {
                 }
         }else{
                 # dry mode, no folder so many imap will fail, assuming failure
-                myprint( "Created  folder [$h2_fold] on host2 $dry_message\n"  ) ;
+                myprint( "Created  folder [$h2_fold] on host2 $sync->{dry_message}\n"  ) ;
                 if ( ! $justfolders ) {
-			myprint( "Since --dry mode is on and folder [$h2_fold] on host2 does not exist yet, syncing messages will not be simulated.\n"
-			. "To simulate message syncing, use --justfolders without --dry to first create the missing folders then rerun the --dry sync.\n" ) ;
+                        myprint( "Since --dry mode is on and folder [$h2_fold] on host2 does not exist yet, syncing messages will not be simulated.\n"
+                        . "To simulate message syncing, use --justfolders without --dry to first create the missing folders then rerun the --dry sync.\n" ) ;
                 }
-		return( 0 ) ;
+                return( 0 ) ;
         }
 }
 
 
 
 sub tests_folder_routines {
-	ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 1'               );
-	ok(  add_to_requested_folders('folder_foo'), 'add_to_requested_folders folder_foo'       );
-	ok(  is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 2'               );
-	ok( !is_requested_folder('folder_NO_EXIST'), 'is_requested_folder folder_NO_EXIST'       );
-	ok( !remove_from_requested_folders('folder_foo'), 'removed folder_foo'                   );
-	ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 3'               );
-	my @f ;
-	ok(  @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f"        );
-	ok(  is_requested_folder('folder_bar'), 'is_requested_folder 4'                          );
-	ok(  is_requested_folder('folder_toto'), 'is_requested_folder 5'                         );
-	ok(  remove_from_requested_folders('folder_toto'), 'remove_from_requested_folders: '       );
-	ok( !is_requested_folder('folder_toto'), 'is_requested_folder 6'                         );
-	ok( !remove_from_requested_folders('folder_bar'), 'remove_from_requested_folders: empty' ) ;
+	note( 'Entering tests_folder_routines()' ) ;
+
+        ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 1'               );
+        ok(  add_to_requested_folders('folder_foo'), 'add_to_requested_folders folder_foo'       );
+        ok(  is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 2'               );
+        ok( !is_requested_folder('folder_NO_EXIST'), 'is_requested_folder folder_NO_EXIST'       );
+        ok( !remove_from_requested_folders('folder_foo'), 'removed folder_foo'                   );
+        ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 3'               );
+        my @f ;
+        ok(  @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f"        );
+        ok(  is_requested_folder('folder_bar'), 'is_requested_folder 4'                          );
+        ok(  is_requested_folder('folder_toto'), 'is_requested_folder 5'                         );
+        ok(  remove_from_requested_folders('folder_toto'), 'remove_from_requested_folders: '       );
+        ok( !is_requested_folder('folder_toto'), 'is_requested_folder 6'                         );
+        ok( !remove_from_requested_folders('folder_bar'), 'remove_from_requested_folders: empty' ) ;
 
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [] ), 'sort_requested_folders: all empty' ) ;
-	ok(  add_to_requested_folders('M_55'), 'add_to_requested_folders M_55'       );
+        ok(  add_to_requested_folders('M_55'), 'add_to_requested_folders M_55'       );
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'M_55' ] ), 'sort_requested_folders: middle' ) ;
-	@folderfirst = ( 'Z_11' ) ;
+        @folderfirst = ( 'Z_11' ) ;
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_55' ] ), 'sort_requested_folders: first+middle' ) ;
-	@folderlast = ( 'A_99' ) ;
+        @folderlast = ( 'A_99' ) ;
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_55', 'A_99' ] ), 'sort_requested_folders: first+middle+last 1' ) ;
 
-	ok(  add_to_requested_folders('M_55', 'M_44',), 'add_to_requested_folders M_55 M_44'       );
+        ok(  add_to_requested_folders('M_55', 'M_44',), 'add_to_requested_folders M_55 M_44'       );
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_44', 'M_55', 'A_99' ] ), 'sort_requested_folders: first+middle+last 2' ) ;
-	@folderfirst = qw( Z_22  Z_11 ) ;
-	@folderlast  = qw( A_99  A_88 ) ;
+        @folderfirst = qw( Z_22  Z_11 ) ;
+        @folderlast  = qw( A_99  A_88 ) ;
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [  'Z_22', 'Z_11', 'M_44', 'M_55', 'A_99', 'A_88' ] ), 'sort_requested_folders: first+middle+last 3' ) ;
 
-	return ;
-}
-
-
-sub sort_requested_folders {
-	my @requested_folders_sorted = () ;
-
-	foreach my $folder ( @folderfirst ) {
-        	remove_from_requested_folders( $folder ) ;
-        }
-
-	foreach my $folder ( @folderlast ) {
-        	remove_from_requested_folders( $folder ) ;
-        }
-
-	my @middle = sort keys %requested_folder ;
-
-        @requested_folders_sorted = ( @folderfirst, @middle, @folderlast ) ;
-
-	return( @requested_folders_sorted ) ;
-}
-
-sub is_requested_folder {
-	my ( $folder ) = @_;
-
-	return( defined  $requested_folder{ $folder }  ) ;
-}
-
-
-sub add_to_requested_folders {
-	my @wanted_folders = @_ ;
-
-	foreach my $folder ( @wanted_folders ) {
-	 	++$requested_folder{ $folder } ;
-	}
-	return( keys  %requested_folder  ) ;
-}
-
-sub remove_from_requested_folders {
-	my @wanted_folders = @_ ;
-
-	foreach my $folder ( @wanted_folders ) {
-	 	delete $requested_folder{ $folder } ;
-	}
-	return( keys %requested_folder ) ;
-}
-
-sub compare_lists {
-	my ($list_1_ref, $list_2_ref) = @_;
-
-	return($MINUS_ONE) 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 = $MINUS_ONE;
-
-
-	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 $MINUS_ONE 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($MINUS_ONE == compare_lists(undef , [])     , 'compare_lists, undef < []');
-	ok($MINUS_ONE == compare_lists(undef , [1])    , 'compare_lists, undef < [1]');
-	ok($MINUS_ONE == 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($MINUS_ONE == 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($MINUS_ONE == compare_lists( 0 ,  1 )          , 'compare_lists,  0  <  1 ') ;
-	ok($MINUS_ONE == compare_lists($MINUS_ONE ,  0 )          , 'compare_lists, -1  <  0 ') ;
-	ok($MINUS_ONE == 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($MINUS_ONE == compare_lists([1], [1,2])     , 'compare_lists,    [1] < [1,2]' ) ;
-	ok(+1 == compare_lists([2], [1,2])     , 'compare_lists,    [2] > [1,2]' ) ;
-	ok($MINUS_ONE == 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 .. $NUMBER_20_000] , [1 .. $NUMBER_20_000])
-                                               , 'compare_lists, [1..20_000] = [1..20_000]' ) ;
-	ok($MINUS_ONE == compare_lists([1], [2])       , 'compare_lists, [1] < [2]') ;
-	ok( 0 == compare_lists([2], [2])       , 'compare_lists, [0] = [2]') ;
-	ok(+1 == compare_lists([2], [1])       , 'compare_lists, [2] > [1]') ;
-
-	ok($MINUS_ONE == 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($MINUS_ONE == compare_lists(['a'],  ['aa'])  , 'compare_lists, ["a"] < ["aa"]') ;
-	ok($MINUS_ONE == compare_lists(['a'],  ['a', 'a']), 'compare_lists, ["a"] < ["a", "a"]') ;
-	ok( 0 == compare_lists([split q{ }, 'a b' ], ['a', 'b']), 'compare_lists, split') ;
-	ok( 0 == compare_lists([sort split q{ }, 'b a' ], ['a', 'b']), 'compare_lists, sort split') ;
+	note( 'Leaving  tests_folder_routines()' ) ;
         return ;
 }
 
 
-sub guess_prefix {
-	my @foldernames = @_ ;
+sub sort_requested_folders {
+        my @requested_folders_sorted = () ;
 
-	return( undef ) unless ( @foldernames ) ;
+        foreach my $folder ( @folderfirst ) {
+                remove_from_requested_folders( $folder ) ;
+        }
 
-	my $prefix_guessed = q{} ;
-	foreach my $folder ( @foldernames ) {
-		next if ( $folder =~ m{^INBOX$}i ) ; # no guessing from INBOX
-		if ( $folder !~ m{^INBOX}i ) {
-			$prefix_guessed = q{} ; # prefix empty guessed
-			last ;
-		}
-		if ( $folder =~ m{^(INBOX(?:\.|\/))}i ) {
-			$prefix_guessed = $1 ;  # prefix Inbox/ or INBOX. guessed
-		}
-	}
-	return( $prefix_guessed ) ;
+        foreach my $folder ( @folderlast ) {
+                remove_from_requested_folders( $folder ) ;
+        }
+
+        my @middle = sort keys %requested_folder ;
+
+        @requested_folders_sorted = ( @folderfirst, @middle, @folderlast ) ;
+
+        return( @requested_folders_sorted ) ;
+}
+
+sub is_requested_folder {
+        my ( $folder ) = @_;
+
+        return( defined  $requested_folder{ $folder }  ) ;
+}
+
+
+sub add_to_requested_folders {
+        my @wanted_folders = @_ ;
+
+        foreach my $folder ( @wanted_folders ) {
+                ++$requested_folder{ $folder } ;
+        }
+        return( keys  %requested_folder  ) ;
+}
+
+sub remove_from_requested_folders {
+        my @wanted_folders = @_ ;
+
+        foreach my $folder ( @wanted_folders ) {
+                delete $requested_folder{ $folder } ;
+        }
+        return( keys %requested_folder ) ;
+}
+
+sub compare_lists {
+        my ($list_1_ref, $list_2_ref) = @_;
+
+        return($MINUS_ONE) 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 = $MINUS_ONE;
+
+
+        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 $MINUS_ONE if ($last_used_indice < $#{ $list_2_ref } ) ;
+
+        # same size, each element equal
+        return 0 ;
+}
+
+sub tests_compare_lists {
+	note( 'Entering 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($MINUS_ONE == compare_lists(undef , [])     , 'compare_lists, undef < []');
+        ok($MINUS_ONE == compare_lists(undef , [1])    , 'compare_lists, undef < [1]');
+        ok($MINUS_ONE == 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($MINUS_ONE == 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($MINUS_ONE == compare_lists( 0 ,  1 )          , 'compare_lists,  0  <  1 ') ;
+        ok($MINUS_ONE == compare_lists($MINUS_ONE ,  0 )          , 'compare_lists, -1  <  0 ') ;
+        ok($MINUS_ONE == 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($MINUS_ONE == compare_lists([1], [1,2])     , 'compare_lists,    [1] < [1,2]' ) ;
+        ok(+1 == compare_lists([2], [1,2])     , 'compare_lists,    [2] > [1,2]' ) ;
+        ok($MINUS_ONE == 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 .. $NUMBER_20_000] , [1 .. $NUMBER_20_000])
+                                               , 'compare_lists, [1..20_000] = [1..20_000]' ) ;
+        ok($MINUS_ONE == compare_lists([1], [2])       , 'compare_lists, [1] < [2]') ;
+        ok( 0 == compare_lists([2], [2])       , 'compare_lists, [0] = [2]') ;
+        ok(+1 == compare_lists([2], [1])       , 'compare_lists, [2] > [1]') ;
+
+        ok($MINUS_ONE == 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($MINUS_ONE == compare_lists(['a'],  ['aa'])  , 'compare_lists, ["a"] < ["aa"]') ;
+        ok($MINUS_ONE == compare_lists(['a'],  ['a', 'a']), 'compare_lists, ["a"] < ["a", "a"]') ;
+        ok( 0 == compare_lists([split q{ }, 'a b' ], ['a', 'b']), 'compare_lists, split') ;
+        ok( 0 == compare_lists([sort split q{ }, 'b a' ], ['a', 'b']), 'compare_lists, sort split') ;
+
+	note( 'Leaving  tests_compare_lists()' ) ;
+        return ;
+}
+
+
+sub guess_prefix  {
+        my @foldernames = @_ ;
+
+        my $prefix_guessed = q{} ;
+        foreach my $folder ( @foldernames ) {
+                next if ( $folder =~ m{^INBOX$}xi ) ; # no guessing from INBOX
+                if ( $folder !~ m{^INBOX}xi ) {
+                        $prefix_guessed = q{} ; # prefix empty guessed
+                        last ;
+                }
+                if ( $folder =~ m{^(INBOX(?:\.|\/))}xi ) {
+                        $prefix_guessed = $1 ;  # prefix Inbox/ or INBOX. guessed
+                }
+        }
+        return( $prefix_guessed ) ;
 }
 
 sub tests_guess_prefix {
+	note( 'Entering tests_guess_prefix()' ) ;
 
-	ok( not( defined guess_prefix(  ) ), 'guess_prefix: no args' ) ;
-	ok( q{} eq guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
-	ok( q{} eq guess_prefix( 'Inbox' ), 'guess_prefix: Inbox alone' ) ;
-	ok( q{} eq guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
-	ok( 'INBOX/' eq guess_prefix( 'INBOX', 'INBOX/Junk' ), 'guess_prefix: INBOX INBOX/Junk' ) ;
-	ok( 'INBOX.' eq guess_prefix( 'INBOX', 'INBOX.Junk' ), 'guess_prefix: INBOX INBOX.Junk' ) ;
-	ok( 'Inbox/' eq guess_prefix( 'Inbox', 'Inbox/Junk' ), 'guess_prefix: Inbox Inbox/Junk' ) ;
-	ok( 'Inbox.' eq guess_prefix( 'Inbox', 'Inbox.Junk' ), 'guess_prefix: Inbox Inbox.Junk' ) ;
-	ok( 'INBOX/' eq guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr' ) ;
-	ok( q{} eq guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr', 'zzz' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr zzz' ) ;
-	ok( q{} eq guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
-	ok( q{} eq guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
+        is( guess_prefix(  ), q{}, 'guess_prefix: no args => empty string' ) ;
+        is( q{} , guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
+        is( q{} , guess_prefix( 'Inbox' ), 'guess_prefix: Inbox alone' ) ;
+        is( q{} , guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
+        is( 'INBOX/' , guess_prefix( 'INBOX', 'INBOX/Junk' ), 'guess_prefix: INBOX INBOX/Junk' ) ;
+        is( 'INBOX.' , guess_prefix( 'INBOX', 'INBOX.Junk' ), 'guess_prefix: INBOX INBOX.Junk' ) ;
+        is( 'Inbox/' , guess_prefix( 'Inbox', 'Inbox/Junk' ), 'guess_prefix: Inbox Inbox/Junk' ) ;
+        is( 'Inbox.' , guess_prefix( 'Inbox', 'Inbox.Junk' ), 'guess_prefix: Inbox Inbox.Junk' ) ;
+        is( 'INBOX/' , guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr' ) ;
+        is( q{} , guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr', 'zzz' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr zzz' ) ;
+        is( q{} , guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
+        is( q{} , guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
 
-	return ;
+	note( 'Leaving  tests_guess_prefix()' ) ;
+        return ;
 }
 
 sub get_prefix {
-	my( $imap, $prefix_in, $prefix_opt, $Side, $folders_ref ) = @_ ;
-	my( $prefix_out, $prefix_guessed ) ;
+        my( $imap, $prefix_in, $prefix_opt, $Side, $folders_ref ) = @_ ;
+        my( $prefix_out, $prefix_guessed ) ;
 
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting prefix\n"  ) ;
-	$prefix_guessed = guess_prefix( @{ $folders_ref } ) ;
-	myprint( "$Side: guessing prefix from folder listing: [$prefix_guessed]\n"  ) ;
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: Calling namespace capability\n"  ) ;
-	if ( $imap->has_capability( 'namespace' ) ) {
-		my $r_namespace = $imap->namespace(  ) ;
-		$prefix_out = $r_namespace->[0][0][0] ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting prefix\n"  ) ;
+        $prefix_guessed = guess_prefix( @{ $folders_ref } ) ;
+        myprint( "$Side: guessing prefix from folder listing: [$prefix_guessed]\n"  ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: Calling namespace capability\n"  ) ;
+        if ( $imap->has_capability( 'namespace' ) ) {
+                my $r_namespace = $imap->namespace(  ) ;
+                $prefix_out = $r_namespace->[0][0][0] ;
                 myprint( "$Side: prefix given by NAMESPACE: [$prefix_out]\n"  ) ;
-		if ( defined  $prefix_in  ) {
-                	myprint( "$Side: but using [$prefix_in] given by $prefix_opt\n"  ) ;
-                	$prefix_out = $prefix_in ;
-                	return( $prefix_out ) ;
+                if ( defined  $prefix_in  ) {
+                        myprint( "$Side: but using [$prefix_in] given by $prefix_opt\n"  ) ;
+                        $prefix_out = $prefix_in ;
+                        return( $prefix_out ) ;
                 }else{
-                	# all good
-	                return( $prefix_out ) ;
+                        # all good
+                        return( $prefix_out ) ;
                 }
-	}
-	else{
-        	if ( defined  $prefix_in  ) {
-                	myprint( "$Side: using [$prefix_in] given by $prefix_opt\n"  ) ;
-                	$prefix_out = $prefix_in ;
-                	return( $prefix_out ) ;
+        }
+        else{
+                if ( defined  $prefix_in  ) {
+                        myprint( "$Side: using [$prefix_in] given by $prefix_opt\n"  ) ;
+                        $prefix_out = $prefix_in ;
+                        return( $prefix_out ) ;
                 }else{
-			myprint(
-			  "$Side: No NAMESPACE capability so using guessed prefix [$prefix_guessed]\n",
-			  help_to_guess_prefix( $imap, $prefix_opt ) ) ;
-			return( $prefix_guessed ) ;
+                        myprint(
+                          "$Side: No NAMESPACE capability so using guessed prefix [$prefix_guessed]\n",
+                          help_to_guess_prefix( $imap, $prefix_opt ) ) ;
+                        return( $prefix_guessed ) ;
                 }
-	}
+        }
         return ;
 }
 
 
 sub guess_separator {
-	my @foldernames = @_ ;
+        my @foldernames = @_ ;
 
-	#return( undef ) unless ( @foldernames ) ;
+        #return( undef ) unless ( @foldernames ) ;
 
-	my $sep_guessed ;
-	my %counter ;
-	foreach my $folder ( @foldernames ) {
-		$counter{'/'}++  while ( $folder =~ m{/}g ) ;  # count /
-		$counter{'.'}++  while ( $folder =~ m{\.}g ) ; # count .
-		$counter{'\\\\'}++ while ( $folder =~ m{(\\){2}}g ) ; # count \\
-	}
-	my @race_sorted = sort { $counter{ $b } <=> $counter{ $a } } keys  %counter  ;
-	#myprint( "@race_sorted\n"  ) ;
-	$sep_guessed = shift @race_sorted || $LAST_RESSORT_SEPARATOR ; # / when nothing found.
-	return( $sep_guessed ) ;
+        my $sep_guessed ;
+        my %counter ;
+        foreach my $folder ( @foldernames ) {
+                $counter{'/'}++  while ( $folder =~ m{/}xg ) ;  # count /
+                $counter{'.'}++  while ( $folder =~ m{\.}xg ) ; # count .
+                $counter{'\\\\'}++ while ( $folder =~ m{(\\){2}}xg ) ; # count \\
+                $counter{'\\'}++ while ( $folder =~ m{[^\\](\\){1}(?=[^\\])}xg ) ; # count \
+        }
+        my @race_sorted = sort { $counter{ $b } <=> $counter{ $a } } keys  %counter  ;
+        $debug and myprint( "@foldernames\n@race_sorted\n", %counter, "\n"  ) ;
+        $sep_guessed = shift @race_sorted || $LAST_RESSORT_SEPARATOR ; # / when nothing found.
+        return( $sep_guessed ) ;
 }
 
 sub tests_guess_separator {
-	ok( '/' eq  guess_separator(  ), 'guess_separator: no args' ) ;
-	ok( '/' eq guess_separator( 'abcd' ), 'guess_separator: abcd' ) ;
-	ok( '/' eq guess_separator( 'a/b/c.d' ), 'guess_separator: a/b/c.d' ) ;
-	ok( '.' eq guess_separator( 'a.b/c.d' ), 'guess_separator: a.b/c.d' ) ;
-	ok( '\\\\' eq guess_separator( 'a\\\\b\\\\c.c\\\\d/e/f' ), 'guess_separator: a\\\\b\\\\c.c\\\\d/e/f' ) ;
-	return ;
+	note( 'Entering tests_guess_separator()' ) ;
+
+        ok( '/' eq  guess_separator(  ), 'guess_separator: no args' ) ;
+        ok( '/' eq guess_separator( 'abcd' ), 'guess_separator: abcd' ) ;
+        ok( '/' eq guess_separator( 'a/b/c.d' ), 'guess_separator: a/b/c.d' ) ;
+        ok( '.' eq guess_separator( 'a.b/c.d' ), 'guess_separator: a.b/c.d' ) ;
+        ok( '\\\\' eq guess_separator( 'a\\\\b\\\\c.c\\\\d/e/f' ), 'guess_separator: a\\\\b\\\\c.c\\\\d/e/f' ) ;
+        ok( '\\' eq guess_separator( 'a\\b\\c.c\\d/e/f' ), 'guess_separator: a\\b\\c.c\\d/e/f' ) ;
+        ok( '\\' eq guess_separator( 'a\\b' ), 'guess_separator: a\\b' ) ;
+        ok( '\\' eq guess_separator( 'a\\b\\c' ), 'guess_separator: a\\b\\c' ) ;
+
+	note( 'Leaving  tests_guess_separator()' ) ;
+        return ;
 }
 
 sub get_separator {
-	my( $imap, $sep_in, $sep_opt, $Side, $folders_ref ) = @_ ;
-	my( $sep_out, $sep_guessed ) ;
+        my( $imap, $sep_in, $sep_opt, $Side, $folders_ref ) = @_ ;
+        my( $sep_out, $sep_guessed ) ;
 
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting separator\n"  ) ;
-	$sep_guessed = guess_separator( @{ $folders_ref } ) ;
-	myprint( "$Side: guessing separator from folder listing: [$sep_guessed]\n"  ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting separator\n"  ) ;
+        $sep_guessed = guess_separator( @{ $folders_ref } ) ;
+        myprint( "$Side: guessing separator from folder listing: [$sep_guessed]\n"  ) ;
 
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: calling namespace capability\n"  ) ;
-	if ( $imap->has_capability( 'namespace' ) ) {
-		$sep_out = $imap->separator(  ) ;
-		if ( defined  $sep_out  ) {
-                	myprint( "$Side: separator given by NAMESPACE: [$sep_out]\n"  ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: calling namespace capability\n"  ) ;
+        if ( $imap->has_capability( 'namespace' ) ) {
+                $sep_out = $imap->separator(  ) ;
+                if ( defined  $sep_out  ) {
+                        myprint( "$Side: separator given by NAMESPACE: [$sep_out]\n"  ) ;
                         if ( defined  $sep_in  ) {
-                		myprint( "$Side: but using [$sep_in] given by $sep_opt\n"  ) ;
-                        	$sep_out = $sep_in ;
-                        	return( $sep_out ) ;
+                                myprint( "$Side: but using [$sep_in] given by $sep_opt\n"  ) ;
+                                $sep_out = $sep_in ;
+                                return( $sep_out ) ;
                         }else{
-                        	return( $sep_out ) ;
+                                return( $sep_out ) ;
                         }
-		}else{
-                	if ( defined  $sep_in  ) {
-                        	myprint( "$Side: NAMESPACE request failed but using [$sep_in] given by $sep_opt\n"  ) ;
-                        	$sep_out = $sep_in ;
-                        	return( $sep_out ) ;
-                        }else{
-				myprint(
-		  		"$Side: NAMESPACE request failed so using guessed separator [$sep_guessed]\n",
-                  		help_to_guess_sep( $imap, $sep_opt ) ) ;
-				return( $sep_guessed ) ;
-                        }
-                }
-	}
-	else{
-        	if ( defined  $sep_in  ) {
-                	myprint( "$Side: No NAMESPACE capability but using [$sep_in] given by $sep_opt\n"  ) ;
-                	$sep_out = $sep_in ;
-                	return( $sep_out ) ;
                 }else{
-			myprint(
-		  	"$Side: No NAMESPACE capability, so using guessed separator [$sep_guessed]\n",
-		      	help_to_guess_sep( $imap, $sep_opt ) ) ;
-			return( $sep_guessed ) ;
+                        if ( defined  $sep_in  ) {
+                                myprint( "$Side: NAMESPACE request failed but using [$sep_in] given by $sep_opt\n"  ) ;
+                                $sep_out = $sep_in ;
+                                return( $sep_out ) ;
+                        }else{
+                                myprint(
+                                "$Side: NAMESPACE request failed so using guessed separator [$sep_guessed]\n",
+                                help_to_guess_sep( $imap, $sep_opt ) ) ;
+                                return( $sep_guessed ) ;
+                        }
                 }
-	}
+        }
+        else{
+                if ( defined  $sep_in  ) {
+                        myprint( "$Side: No NAMESPACE capability but using [$sep_in] given by $sep_opt\n"  ) ;
+                        $sep_out = $sep_in ;
+                        return( $sep_out ) ;
+                }else{
+                        myprint(
+                        "$Side: No NAMESPACE capability, so using guessed separator [$sep_guessed]\n",
+                        help_to_guess_sep( $imap, $sep_opt ) ) ;
+                        return( $sep_guessed ) ;
+                }
+        }
         return ;
 }
 
 sub help_to_guess_sep {
-	my( $imap, $sep_opt ) = @_ ;
+        my( $imap, $sep_opt ) = @_ ;
 
-	my $help_to_guess_sep = "You can set the separator character with the $sep_opt option,\n"
-	. "the complete listing of folders may help you to find it\n"
-	. folders_list_to_help( $imap ) ;
+        my $help_to_guess_sep = "You can set the separator character with the $sep_opt option,\n"
+        . "the complete listing of folders may help you to find it\n"
+        . folders_list_to_help( $imap ) ;
 
-	return( $help_to_guess_sep ) ;
+        return( $help_to_guess_sep ) ;
 }
 
 sub help_to_guess_prefix {
-	my( $imap, $prefix_opt ) = @_ ;
+        my( $imap, $prefix_opt ) = @_ ;
 
-	my $help_to_guess_prefix = "You can set the prefix namespace with the $prefix_opt option,\n"
-	. "the folowing listing of folders may help you to find it:\n"
-	. folders_list_to_help( $imap ) ;
+        my $help_to_guess_prefix = "You can set the prefix namespace with the $prefix_opt option,\n"
+        . "the folowing listing of folders may help you to find it:\n"
+        . folders_list_to_help( $imap ) ;
 
-	return( $help_to_guess_prefix ) ;
+        return( $help_to_guess_prefix ) ;
 }
 
 
 sub folders_list_to_help {
-	my($imap) = @_ ;
+        my($imap) = @_ ;
 
-	my @folders = $imap->folders ;
-	my $listing = join q{}, map { "[$_]\n" } @folders ;
-	return( $listing ) ;
+        my @folders = $imap->folders ;
+        my $listing = join q{}, map { "[$_]\n" } @folders ;
+        return( $listing ) ;
 }
 
 
 sub tests_separator_invert {
-	$fixslash2 = 0 ;
-	ok( not( defined separator_invert(  )  ), 'separator_invert: no args' ) ;
-	ok( not( defined separator_invert( q{} ) ), 'separator_invert: not enough args' ) ;
-	ok( not( defined separator_invert( q{}, q{} ) ), 'separator_invert: not enough args' ) ;
+	note( 'Entering tests_separator_invert()' ) ;
 
-	ok( q{} eq separator_invert( q{}, q{}, q{} ), 'separator_invert: 3 empty strings' ) ;
-	ok( 'lalala' eq separator_invert( 'lalala', q{}, q{} ), 'separator_invert: empty separator' ) ;
-	ok( 'lalala' eq separator_invert( 'lalala', '/', '/' ), 'separator_invert: same separator /' ) ;
-	ok( 'lal/ala' eq separator_invert( 'lal/ala', '/', '/' ), 'separator_invert: same separator / 2' ) ;
-	ok( 'lal.ala' eq separator_invert( 'lal/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
-	ok( 'lal/ala' eq separator_invert( 'lal.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
-	ok( 'la.l/ala' eq separator_invert( 'la/l.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
+        $fixslash2 = 0 ;
+        ok( not( defined separator_invert(  )  ), 'separator_invert: no args' ) ;
+        ok( not( defined separator_invert( q{} ) ), 'separator_invert: not enough args' ) ;
+        ok( not( defined separator_invert( q{}, q{} ) ), 'separator_invert: not enough args' ) ;
 
-	ok( 'l/al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
+        ok( q{} eq separator_invert( q{}, q{}, q{} ), 'separator_invert: 3 empty strings' ) ;
+        ok( 'lalala' eq separator_invert( 'lalala', q{}, q{} ), 'separator_invert: empty separator' ) ;
+        ok( 'lalala' eq separator_invert( 'lalala', '/', '/' ), 'separator_invert: same separator /' ) ;
+        ok( 'lal/ala' eq separator_invert( 'lal/ala', '/', '/' ), 'separator_invert: same separator / 2' ) ;
+        ok( 'lal.ala' eq separator_invert( 'lal/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
+        ok( 'lal/ala' eq separator_invert( 'lal.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
+        ok( 'la.l/ala' eq separator_invert( 'la/l.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
+
+        ok( 'l/al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
         $fixslash2 = 1 ;
-	ok( 'l_al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
+        ok( 'l_al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
 
-	return ;
+	note( 'Leaving  tests_separator_invert()' ) ;
+        return ;
 }
 
 sub separator_invert {
-	my( $h1_fold, $h1_separator, $h2_separator ) = @_ ;
+        my( $h1_fold, $h1_separator, $h2_separator ) = @_ ;
 
-	return( undef ) if ( not defined  $h1_fold  or not defined  $h1_separator  or not defined  $h2_separator  ) ;
-	# The separator we hope we'll never encounter: 00000000 == 0x00
-	my $o_sep = "\000" ;
+        return( undef ) if ( not defined  $h1_fold  or not defined  $h1_separator  or not defined  $h2_separator  ) ;
+        # The separator we hope we'll never encounter: 00000000 == 0x00
+        my $o_sep = "\000" ;
 
-	my $h2_fold = $h1_fold ;
-	$h2_fold =~ s,\Q$h2_separator,$o_sep,xg ;
-	$h2_fold =~ s,\Q$h1_separator,$h2_separator,xg ;
-	$h2_fold =~ s,\Q$o_sep,$h1_separator,xg ;
+        my $h2_fold = $h1_fold ;
+        $h2_fold =~ s,\Q$h2_separator,$o_sep,xg ;
+        $h2_fold =~ s,\Q$h1_separator,$h2_separator,xg ;
+        $h2_fold =~ s,\Q$o_sep,$h1_separator,xg ;
         $h2_fold =~ s,/,_,xg if( $fixslash2 and '/' ne $h2_separator and '/' eq $h1_separator ) ;
-	return( $h2_fold ) ;
+        return( $h2_fold ) ;
 }
 
 
 sub tests_imap2_folder_name {
+	note( 'Entering tests_imap2_folder_name()' ) ;
 
 $h1_prefix = $h2_prefix = q{};
 $h1_sep = '/';
@@ -4344,459 +5365,480 @@ ok( 'TEST/TEST/TEST/TEST' eq imap2_folder_name( 'INBOX.TEST.test.Test.tesT' ), '
 ok( 'test/test/test/test' eq imap2_folder_name( 'INBOX.TEST.test.Test.tesT' ), 'imap2_folder_name: INBOX.TEST.test.Test.tesT' ) ;
 
 
-return ;
+	note( 'Leaving  tests_imap2_folder_name()' ) ;
+	return ;
 
 }
 
 sub imap2_folder_name {
-	my ( $h1_fold ) = @_ ;
-	my ( $h2_fold ) ;
-	if ( $sync->{f1f2}{ $h1_fold } ) {
-		$h2_fold = $sync->{f1f2}{ $h1_fold } ;
-		( $debug or $sync->{debugfolders} ) and myprint( "f1f2 [$h1_fold] -> [$h2_fold]\n"  ) ;
-		return( $h2_fold ) ;
-	}
-	if ( $sync->{f1f2auto}{ $h1_fold } ) {
-		$h2_fold = $sync->{f1f2auto}{ $h1_fold } ;
-		( $debug or $sync->{debugfolders} ) and myprint( "automap [$h1_fold] -> [$h2_fold]\n"  ) ;
-		return( $h2_fold ) ;
-	}
+        my ( $h1_fold ) = @_ ;
+        my ( $h2_fold ) ;
+        if ( $sync->{f1f2}{ $h1_fold } ) {
+                $h2_fold = $sync->{f1f2}{ $h1_fold } ;
+                ( $debug or $sync->{debugfolders} ) and myprint( "f1f2 [$h1_fold] -> [$h2_fold]\n"  ) ;
+                return( $h2_fold ) ;
+        }
+        if ( $sync->{f1f2auto}{ $h1_fold } ) {
+                $h2_fold = $sync->{f1f2auto}{ $h1_fold } ;
+                ( $debug or $sync->{debugfolders} ) and myprint( "automap [$h1_fold] -> [$h2_fold]\n"  ) ;
+                return( $h2_fold ) ;
+        }
 
-	$h2_fold = prefix_seperator_invertion( $h1_fold ) ;
-	$h2_fold = regextrans2( $h2_fold ) ;
-	return( $h2_fold ) ;
+        $h2_fold = prefix_seperator_invertion( $h1_fold ) ;
+        $h2_fold = regextrans2( $h2_fold ) ;
+        return( $h2_fold ) ;
 }
 
 sub prefix_seperator_invertion {
-	my ( $h1_fold ) = @_ ;
-	my ( $h2_fold ) ;
+        my ( $h1_fold ) = @_ ;
+        my ( $h2_fold ) ;
 
-	# first we remove the prefix
-	$h1_fold =~ s/^\Q$h1_prefix\E//x ;
-	( $debug or $sync->{debugfolders} ) and myprint( "removed host1 prefix: [$h1_fold]\n"  ) ;
-	$h2_fold = separator_invert( $h1_fold, $h1_sep, $h2_sep ) ;
-	( $debug or $sync->{debugfolders} ) and myprint( "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$/xi ) ) ;
-	( $debug or $sync->{debugfolders} ) and myprint( "added   host2 prefix: [$h2_fold]\n"  ) ;
-	return( $h2_fold ) ;
+        # first we remove the prefix
+        $h1_fold =~ s/^\Q$h1_prefix\E//x ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "removed host1 prefix: [$h1_fold]\n"  ) ;
+        $h2_fold = separator_invert( $h1_fold, $h1_sep, $h2_sep ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "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$/xi ) ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "added   host2 prefix: [$h2_fold]\n"  ) ;
+        return( $h2_fold ) ;
 }
 
 sub regextrans2 {
-	my( $h2_fold ) = @_ ;
-	# Transforming the folder name by the --regextrans2 option(s)
-	foreach my $regextrans2 ( @regextrans2 ) {
-	        my $h2_fold_before = $h2_fold ;
-		my $ret = eval "\$h2_fold =~ $regextrans2 ; 1 " ;
-		( $debug or $sync->{debugfolders} ) and myprint( "[$h2_fold_before] -> [$h2_fold] using regextrans2 [$regextrans2]\n"  ) ;
-                if ( not ( defined  $ret  ) or $@ ) {
-			die_clean( "error: eval regextrans2 '$regextrans2': $@\n" ) ;
+        my( $h2_fold ) = @_ ;
+        # Transforming the folder name by the --regextrans2 option(s)
+        foreach my $regextrans2 ( @regextrans2 ) {
+                my $h2_fold_before = $h2_fold ;
+                my $ret = eval "\$h2_fold =~ $regextrans2 ; 1 " ;
+                ( $debug or $sync->{debugfolders} ) and myprint( "[$h2_fold_before] -> [$h2_fold] using regextrans2 [$regextrans2]\n"  ) ;
+                if ( not ( defined  $ret  ) or $EVAL_ERROR ) {
+                        die_clean( "error: eval regextrans2 '$regextrans2': $EVAL_ERROR\n" ) ;
                 }
-	}
-	return( $h2_fold ) ;
+        }
+        return( $h2_fold ) ;
 }
 
 
 sub tests_decompose_regex {
-	ok( 1, 'decompose_regex 1' ) ;
-	ok( 0 == compare_lists( [ q{}, q{} ], [ decompose_regex( q{} ) ] ), 'decompose_regex empty string' ) ;
-	ok( 0 == compare_lists( [ '.*', 'lala' ], [ decompose_regex( 's/.*/lala/' ) ] ), 'decompose_regex s/.*/lala/' ) ;
-	return ;
+	note( 'Entering tests_decompose_regex()' ) ;
+
+        ok( 1, 'decompose_regex 1' ) ;
+        ok( 0 == compare_lists( [ q{}, q{} ], [ decompose_regex( q{} ) ] ), 'decompose_regex empty string' ) ;
+        ok( 0 == compare_lists( [ '.*', 'lala' ], [ decompose_regex( 's/.*/lala/' ) ] ), 'decompose_regex s/.*/lala/' ) ;
+
+	note( 'Leaving  tests_decompose_regex()' ) ;
+        return ;
 }
 
 sub decompose_regex {
-	my $regex = shift ;
-	my( $left_part, $right_part ) ;
+        my $regex = shift ;
+        my( $left_part, $right_part ) ;
 
-	( $left_part, $right_part ) = $regex =~ m{^s/((?:[^/]|\\/)+)/((?:[^/]|\\/)+)/}x;
+        ( $left_part, $right_part ) = $regex =~ m{^s/((?:[^/]|\\/)+)/((?:[^/]|\\/)+)/}x;
         return( q{}, q{} ) if not $left_part ;
-	return( $left_part, $right_part ) ;
+        return( $left_part, $right_part ) ;
 }
 
 
 sub foldersizes {
 
-	my ( $side, $imap, $search_cmd, @folders ) = @_ ;
-	my $total_size = 0 ;
-	my $total_nb = 0 ;
-	my $biggest_in_all = 0 ;
+        my ( $side, $imap, $search_cmd, $abletosearch, @folders ) = @_ ;
+        my $total_size = 0 ;
+        my $total_nb = 0 ;
+        my $biggest_in_all = 0 ;
 
-	my $nb_folders = scalar  @folders  ;
-	my $ct_folders = 0 ; # folder counter.
-	myprint( "++++ Calculating sizes of $nb_folders folders on $side\n"  ) ;
-	foreach my $folder ( @folders )     {
-		my $stot = 0 ;
-		my $nb_msgs = 0 ;
-		$ct_folders++ ;
-		myprintf( "$side folder %7s %-35s", "$ct_folders/$nb_folders", jux_utf8( $folder ) ) ;
+        my $nb_folders = scalar  @folders  ;
+        my $ct_folders = 0 ; # folder counter.
+        myprint( "++++ Calculating sizes of $nb_folders folders on $side\n"  ) ;
+        foreach my $folder ( @folders )     {
+                my $stot = 0 ;
+                my $nb_msgs = 0 ;
+                $ct_folders++ ;
+                myprintf( "$side folder %7s %-35s", "$ct_folders/$nb_folders", jux_utf8( $folder ) ) ;
                 if ( 'Host2' eq $side and not exists  $h2_folders_all_UPPER{ uc  $folder  }  ) {
-		        myprint( " does not exist yet\n") ;
-			next ;
-		}
+                        myprint( " does not exist yet\n") ;
+                        next ;
+                }
                 if ( 'Host1' eq $side and not exists  $h1_folders_all{ $folder }  ) {
-		        myprint( " does not exist\n" ) ;
-			next ;
-		}
+                        myprint( " does not exist\n" ) ;
+                        next ;
+                }
 
-		last if $imap->IsUnconnected(  ) ;
-		# FTGate is RFC buggy with EXAMINE it does not act as SELECT
-		#unless ( $imap->examine( $folder ) ) {
-		unless ( $imap->select( $folder ) ) {
-			my $error = join q{},
-				"$side Folder $folder: Could not select: ",
-				$imap->LastError,  "\n"  ;
-			errors_incr( $sync, $error ) ;
-			next ;
-		}
-		last if $imap->IsUnconnected(  ) ;
+                last if $imap->IsUnconnected(  ) ;
+                # FTGate is RFC buggy with EXAMINE it does not act as SELECT
+                #unless ( $imap->examine( $folder ) ) {
+                unless ( $imap->select( $folder ) ) {
+                        my $error = join q{},
+                                "$side Folder $folder: Could not select: ",
+                                $imap->LastError,  "\n"  ;
+                        errors_incr( $sync, $error ) ;
+                        next ;
+                }
+                last if $imap->IsUnconnected(  ) ;
 
-		my $hash_ref = { } ;
-		my @msgs = select_msgs( $imap, undef, $search_cmd, $folder ) ;
-		$nb_msgs = scalar  @msgs  ;
-		my $biggest_in_folder = 0 ;
-		@{ $hash_ref }{ @msgs } = ( undef ) if @msgs ;
+                my $hash_ref = { } ;
+                my @msgs = select_msgs( $imap, undef, $search_cmd, $abletosearch, $folder ) ;
+                $nb_msgs = scalar  @msgs  ;
+                my $biggest_in_folder = 0 ;
+                @{ $hash_ref }{ @msgs } = ( undef ) if @msgs ;
 
-		last if $imap->IsUnconnected(  ) ;
-		if ( $nb_msgs > 0 and @msgs ) {
-                	if ( $abletosearch ) {
-				if ( ! $imap->fetch_hash( \@msgs, 'RFC822.SIZE', $hash_ref) ) {
-                                        my $error = "$side failure with fetch_hash: $@" ;
+                last if $imap->IsUnconnected(  ) ;
+                if ( $nb_msgs > 0 and @msgs ) {
+                        if ( $abletosearch ) {
+                                if ( ! $imap->fetch_hash( \@msgs, 'RFC822.SIZE', $hash_ref) ) {
+                                        my $error = "$side failure with fetch_hash: $EVAL_ERROR" ;
                                         errors_incr( $sync, $error ) ;
                                         return ;
                                 }
                         }else{
-				my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
-				my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-				if ( ! $imap->fetch_hash( $fetch_hash_uids, 'RFC822.SIZE', $hash_ref ) ) {
-                                        my $error = "$side failure with fetch_hash: $@" ;
+                                my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
+                                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+                                if ( ! $imap->fetch_hash( $fetch_hash_uids, 'RFC822.SIZE', $hash_ref ) ) {
+                                        my $error = "$side failure with fetch_hash: $EVAL_ERROR" ;
                                         errors_incr( $sync, $error ) ;
                                         return ;
                                 }
                         }
-			for ( keys %{ $hash_ref } ) {
-                        	my $size =  $hash_ref->{ $_ }->{ 'RFC822.SIZE' } ;
-                        	$stot    += $size ;
+                        for ( keys %{ $hash_ref } ) {
+                                my $size =  $hash_ref->{ $_ }->{ 'RFC822.SIZE' } ;
+                                $stot    += $size ;
                                 $biggest_in_folder =  max( $biggest_in_folder, $size ) ;
                         }
-		}
+                }
 
-		myprintf( ' Size: %9s', $stot ) ;
-		myprintf( ' Messages: %5s', $nb_msgs ) ;
-		myprintf( " Biggest: %9s\n", $biggest_in_folder ) ;
-		$total_size += $stot ;
-		$total_nb += $nb_msgs ;
+                myprintf( ' Size: %9s', $stot ) ;
+                myprintf( ' Messages: %5s', $nb_msgs ) ;
+                myprintf( " Biggest: %9s\n", $biggest_in_folder ) ;
+                $total_size += $stot ;
+                $total_nb += $nb_msgs ;
                 $biggest_in_all =  max( $biggest_in_all, $biggest_in_folder ) ;
-	}
-	myprintf( "%s Nb folders:      %11s folders\n",    $side, $nb_folders ) ;
-	myprintf( "%s Nb messages:     %11s messages\n",   $side, $total_nb ) ;
-	myprintf( "%s Total size:      %11s bytes (%s)\n", $side, $total_size, bytes_display_string( $total_size ) ) ;
-	myprintf( "%s Biggest message: %11s bytes (%s)\n", $side, $biggest_in_all, bytes_display_string( $biggest_in_all ) ) ;
-	myprintf( "%s Time spent:      %11.1f seconds\n",  $side, timenext(  ) ) ;
+        }
+        myprintf( "%s Nb folders:      %11s folders\n",    $side, $nb_folders ) ;
+        myprintf( "%s Nb messages:     %11s messages\n",   $side, $total_nb ) ;
+        myprintf( "%s Total size:      %11s bytes (%s)\n", $side, $total_size, bytes_display_string( $total_size ) ) ;
+        myprintf( "%s Biggest message: %11s bytes (%s)\n", $side, $biggest_in_all, bytes_display_string( $biggest_in_all ) ) ;
+        myprintf( "%s Time spent:      %11.1f seconds\n",  $side, timenext(  ) ) ;
         return( $total_nb, $total_size ) ;
 }
 
 sub timenext {
-	my ( $timenow, $timediff ) ;
-	# $timebefore is global, beurk !
-	$timenow    = time ;
-	$timediff   = $timenow - $timebefore ;
-	$timebefore = $timenow ;
-	return( $timediff ) ;
+        my ( $timenow, $timediff ) ;
+        # $timebefore is global, beurk !
+        $timenow    = time ;
+        $timediff   = $timenow - $timebefore ;
+        $timebefore = $timenow ;
+        return( $timediff ) ;
 }
 
 sub timesince {
-	my $timeinit = shift ;
-	my ( $timenow, $timediff ) ;
-	$timenow    = time ;
-	$timediff   = $timenow - $timeinit ;
-	return( $timediff ) ;
+        my $timeinit = shift || 0 ;
+        my ( $timenow, $timediff ) ;
+        $timenow    = time ;
+        $timediff   = $timenow - $timeinit ;
+	# Often used in a division so no 0
+        return( max( 1, $timediff) ) ;
 }
 
 
 
 
 sub tests_flags_regex {
+	note( 'Entering tests_flags_regex()' ) ;
 
-	ok( q{} eq flags_regex(q{} ), 'flags_regex, null string q{}' ) ;
-	ok( q'\Seen NonJunk $Spam' eq flags_regex( q'\Seen NonJunk $Spam' ), 'flags_regex, nothing to do');
+        ok( q{} eq flags_regex(q{} ), 'flags_regex, null string q{}' ) ;
+        ok( q{\Seen NonJunk $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, nothing to do} ) ;
 
-	@regexflag = ('I am BAD' ) ;
+        @regexflag = ('I am BAD' ) ;
         ok( not ( defined flags_regex( q{} ) ), 'flags_regex, bad regex' ) ;
 
-	@regexflag = ( 's/NonJunk//g' ) ;
-	ok( q'\Seen  $Spam' eq flags_regex( q'\Seen NonJunk $Spam' ), q{flags_regex, remove NonJunk: 's/NonJunk//g'} ) ;
-	@regexflag = ( q's/\$Spam//g' ) ;
-	ok( '\Seen NonJunk ' eq flags_regex( q'\Seen NonJunk $Spam' ), q{flags_regex, remove $Spam: 's/\$Spam//g'} ) ;
+        @regexflag = ( 's/NonJunk//g' ) ;
+        ok( q{\Seen  $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove NonJunk: 's/NonJunk//g'} ) ;
+        @regexflag = ( q's/\$Spam//g' ) ;
+        ok( q{\Seen NonJunk } eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove $Spam: 's/\$Spam//g'} ) ;
 
-	@regexflag = ( 's/\\\\Seen//g' ) ;
+        @regexflag = ( 's/\\\\Seen//g' ) ;
 
-	ok( q' NonJunk $Spam' eq flags_regex( q'\Seen NonJunk $Spam' ), q{flags_regex, remove \Seen: 's/\\\\\\\\Seen//g'} ) ;
+        ok( q{ NonJunk $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove \Seen: 's/\\\\\\\\Seen//g'} ) ;
 
-	@regexflag = ( 's/(\s|^)[^\\\\]\w+//g' ) ;
-	ok( '\Seen \Middle \End'   eq flags_regex( q'\Seen NonJunk \Middle $Spam \End' ), q{flags_regex: only \word among \Seen NonJunk \Middle $Spam \End} ) ;
-	ok( ' \Seen \Middle \End1' eq flags_regex( q'Begin \Seen NonJunk \Middle $Spam \End1 End' ), 
-                     q'flags_regex: only \word among Begin \Seen NonJunk \Middle $Spam \End1 End' ) ;
+        @regexflag = ( 's/(\s|^)[^\\\\]\w+//g' ) ;
+        ok( q{\Seen \Middle \End}   eq flags_regex( q{\Seen NonJunk \Middle $Spam \End} ), q{flags_regex: only \word among \Seen NonJunk \Middle $Spam \End} ) ;
+        ok( q{ \Seen \Middle \End1} eq flags_regex( q{Begin \Seen NonJunk \Middle $Spam \End1 End} ),
+                     q{flags_regex: only \word among Begin \Seen NonJunk \Middle $Spam \End1 End} ) ;
 
-	@regexflag = ( q'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( '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 = ( q{s/.*?(Keep1|Keep2|Keep3)/$1 /g} ) ;
+        ok( 'Keep1 Keep2  ReB' eq flags_regex('ReA Keep1 REM Keep2 ReB'), 'Keep only regex' ) ;
 
-	@regexflag = ( q'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( '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 = ( q'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'), q{Keep only regex 's/(.*)/\$1 jrdH8u/'} ) ;
-	@regexflag = ('s/jrdH8u *//');
-	ok('REM  REM  REM REM REM ' eq flags_regex('REM  REM  REM REM REM jrdH8u'), q{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'), q{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(q{} 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( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string' ) ;
-	ok( q{}
-	   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 = ( q{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' ) ;
 
 
-	@regexflag = (
-	's/.*?(?:(\\\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg'
-	);
+        @regexflag = ( q{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' ) ;
 
-	ok( '\\Deleted \\Answered '
-	eq flags_regex('Blabla \$Junk \\Deleted machin \\Answered truc'),
-	'Keep only regex: Exchange case (Phil)' ) ;
+        @regexflag = ( 's/(.*)/$1 jrdH8u/' ) ;
+        ok('REM  REM  REM REM REM jrdH8u' eq flags_regex('REM  REM  REM REM REM'), q{Keep only regex 's/(.*)/\$1 jrdH8u/'} ) ;
+        @regexflag = ('s/jrdH8u *//');
+        ok('REM  REM  REM REM REM ' eq flags_regex('REM  REM  REM REM REM jrdH8u'), q{Keep only regex s/jrdH8u *//} ) ;
 
-	ok( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string (Phil)' ) ;
+        @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( q{}
-	eq flags_regex('Blabla $Junk  machin  truc'),
-	'Keep only regex: Exchange case, no accepted flags (Phil)' ) ;
+        ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), q{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(q{} eq flags_regex('REM  REM REM REM REM'), 'Keep only regex');
 
-	ok('\\Deleted \\Answered \\Draft \\Flagged '
-	eq flags_regex('\\Deleted    \\Answered  \\Draft \\Flagged '),
-	'Keep only regex: Exchange case (Phil)' ) ;
+        @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 *//'
+        );
 
-	return ;
+        ok('\\Deleted \\Answered '
+            eq flags_regex('Blabla $Junk \\Deleted machin \\Answered truc'), 'Keep only regex: Exchange case' ) ;
+        ok( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string' ) ;
+        ok( q{}
+           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( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string (Phil)' ) ;
+
+        ok( q{}
+        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)' ) ;
+
+	note( 'Leaving  tests_flags_regex()' ) ;
+        return ;
 }
 
 sub flags_regex {
-	my ( $h1_flags ) = @_ ;
-	foreach my $regexflag ( @regexflag ) {
-		my $h1_flags_orig = $h1_flags ;
-		$debugflags and myprint( "eval \$h1_flags =~ $regexflag\n"  ) ;
-		my $ret = eval "\$h1_flags =~ $regexflag ; 1 " ;
-		$debugflags and myprint( "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n"  ) ;
-                if( not ( defined $ret ) or $@ ) {
-			myprint( "Error: eval regexflag '$regexflag': $@\n"  ) ;
+        my ( $h1_flags ) = @_ ;
+        foreach my $regexflag ( @regexflag ) {
+                my $h1_flags_orig = $h1_flags ;
+                $debugflags and myprint( "eval \$h1_flags =~ $regexflag\n"  ) ;
+                my $ret = eval "\$h1_flags =~ $regexflag ; 1 " ;
+                $debugflags and myprint( "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n"  ) ;
+                if( not ( defined $ret ) or $EVAL_ERROR ) {
+                        myprint( "Error: eval regexflag '$regexflag': $EVAL_ERROR\n"  ) ;
                         return( undef ) ;
                 }
-	}
-	return( $h1_flags ) ;
+        }
+        return( $h1_flags ) ;
 }
 
 sub acls_sync {
-	my($h1_fold, $h2_fold) = @_ ;
-	if ( $syncacls ) {
-		my $h1_hash = $imap1->getacl($h1_fold)
-		  or myprint( "Could not getacl for $h1_fold: $@\n" ) ;
-		my $h2_hash = $imap2->getacl($h2_fold)
-		  or myprint( "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' ;
-			myprint( "acl $user: [$acl]\n" ) ;
-			next if ($h1_hash->{$user} && $h2_hash->{$user} &&
-				 $h1_hash->{$user} eq $h2_hash->{$user});
-			unless ($dry) {
-				myprint( "setting acl $h2_fold $user $acl\n" ) ;
-				$imap2->setacl($h2_fold, $user, $acl)
-				  or myprint( "Could not set acl: $@\n" ) ;
-			}
-		}
-	}
+        my($h1_fold, $h2_fold) = @_ ;
+        if ( $syncacls ) {
+                my $h1_hash = $imap1->getacl($h1_fold)
+                  or myprint( "Could not getacl for $h1_fold: $EVAL_ERROR\n" ) ;
+                my $h2_hash = $imap2->getacl($h2_fold)
+                  or myprint( "Could not getacl for $h2_fold: $EVAL_ERROR\n" ) ;
+                my %users = map { ($_, 1) } ( keys  %{ $h1_hash} , keys %{ $h2_hash }  ) ;
+                foreach my $user (sort keys %users ) {
+                        my $acl = $h1_hash->{$user} || 'none' ;
+                        myprint( "acl $user: [$acl]\n" ) ;
+                        next if ($h1_hash->{$user} && $h2_hash->{$user} &&
+                                 $h1_hash->{$user} eq $h2_hash->{$user});
+                        unless ($sync->{dry}) {
+                                myprint( "setting acl $h2_fold $user $acl\n" ) ;
+                                $imap2->setacl($h2_fold, $user, $acl)
+                                  or myprint( "Could not set acl: $EVAL_ERROR\n" ) ;
+                        }
+                }
+        }
         return ;
 }
 
 
 sub tests_permanentflags {
+	note( 'Entering tests_permanentflags()' ) ;
 
-	my $string;
-	ok(q{} 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(q{} eq permanentflags('Blabla'), 'permanentflags nothing');
+        my $string;
+        ok(q{} 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(q{} eq permanentflags('Blabla'), 'permanentflags nothing');
+
+	note( 'Leaving  tests_permanentflags()' ) ;
         return ;
 }
 
 sub permanentflags {
-	my @lines = @_ ;
+        my @lines = @_ ;
 
-	foreach my $line (@lines) {
-		if ( $line =~ m{\[PERMANENTFLAGS\s\(([^)]+?)\)\]}x ) {
-			( $debugflags or $debug ) and myprint( "permanentflags: $line"  ) ;
-			my $permanentflags = $1 ;
-			if ( $permanentflags =~ m{\\\*}x ) {
-				$permanentflags = q{} ;
-			}
-			return($permanentflags) ;
-		} ;
-	}
+        foreach my $line (@lines) {
+                if ( $line =~ m{\[PERMANENTFLAGS\s\(([^)]+?)\)\]}x ) {
+                        ( $debugflags or $debug ) and myprint( "permanentflags: $line"  ) ;
+                        my $permanentflags = $1 ;
+                        if ( $permanentflags =~ m{\\\*}x ) {
+                                $permanentflags = q{} ;
+                        }
+                        return($permanentflags) ;
+                } ;
+        }
         return( q{} ) ;
 }
 
 sub tests_flags_filter {
+	note( 'Entering tests_flags_filter()' ) ;
 
-	ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' );
-	ok( q{} 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 ' );
-        return ;
+        ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' );
+        ok( q{} 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 ' );
+
+	note( 'Leaving  tests_flags_filter()' ) ;
+	return ;
 }
 
 sub flags_filter {
-	my( $flags, $allowed_flags ) = @_ ;
+        my( $flags, $allowed_flags ) = @_ ;
 
-	my @flags = split  /\s+/x, $flags ;
-	my %allowed_flags = map { $_ => 1 } split q{ }, $allowed_flags ;
-	my @flags_out     = map { exists $allowed_flags{$_} ? $_ : () } @flags ;
+        my @flags = split  /\s+/x, $flags ;
+        my %allowed_flags = map { $_ => 1 } split q{ }, $allowed_flags ;
+        my @flags_out     = map { exists $allowed_flags{$_} ? $_ : () } @flags ;
 
-	my $flags_out = join q{ }, @flags_out ;
+        my $flags_out = join q{ }, @flags_out ;
 
-	return( $flags_out ) ;
+        return( $flags_out ) ;
 }
 
 sub flagscase {
-	my $flags = shift ;
+        my $flags = shift ;
 
-	my @flags = split /\s+/x, $flags ;
-	my %rfc_flags = map { $_ => 1 } split q{ }, '\Answered \Flagged \Deleted \Seen \Draft' ;
-	my @flags_out = map { exists $rfc_flags{ ucsecond( lc $_ ) } ? ucsecond( lc $_ ) : $_ } @flags ;
+        my @flags = split /\s+/x, $flags ;
+        my %rfc_flags = map { $_ => 1 } split q{ }, '\Answered \Flagged \Deleted \Seen \Draft' ;
+        my @flags_out = map { exists $rfc_flags{ ucsecond( lc $_ ) } ? ucsecond( lc $_ ) : $_ } @flags ;
 
-	my $flags_out = join q{ }, @flags_out ;
+        my $flags_out = join q{ }, @flags_out ;
 
-	return( $flags_out ) ;
+        return( $flags_out ) ;
 }
 
 sub tests_flagscase {
-	ok( '\Seen' eq flagscase( '\Seen' ), 'flagscase: \Seen -> \Seen' ) ;
-	ok( '\Seen' eq flagscase( '\SEEN' ), 'flagscase: \SEEN -> \Seen' ) ;
+	note( 'Entering tests_flagscase()' ) ;
 
-	ok( '\Seen \Draft' eq flagscase( '\SEEN \DRAFT' ), 'flagscase: \SEEN \DRAFT -> \Seen \Draft' ) ;
-	ok( '\Draft \Seen' eq flagscase( '\DRAFT \SEEN' ), 'flagscase: \DRAFT \SEEN -> \Draft \Seen' ) ;
+        ok( '\Seen' eq flagscase( '\Seen' ), 'flagscase: \Seen -> \Seen' ) ;
+        ok( '\Seen' eq flagscase( '\SEEN' ), 'flagscase: \SEEN -> \Seen' ) ;
 
-	ok( '\Draft LALA \Seen' eq flagscase( '\DRAFT  LALA \SEEN' ), 'flagscase: \DRAFT  LALA \SEEN -> \Draft LALA \Seen' ) ;
-	ok( '\Draft lala \Seen' eq flagscase( '\DRAFT  lala \SEEN' ), 'flagscase: \DRAFT  lala \SEEN -> \Draft lala \Seen' ) ;
+        ok( '\Seen \Draft' eq flagscase( '\SEEN \DRAFT' ), 'flagscase: \SEEN \DRAFT -> \Seen \Draft' ) ;
+        ok( '\Draft \Seen' eq flagscase( '\DRAFT \SEEN' ), 'flagscase: \DRAFT \SEEN -> \Draft \Seen' ) ;
+
+        ok( '\Draft LALA \Seen' eq flagscase( '\DRAFT  LALA \SEEN' ), 'flagscase: \DRAFT  LALA \SEEN -> \Draft LALA \Seen' ) ;
+        ok( '\Draft lala \Seen' eq flagscase( '\DRAFT  lala \SEEN' ), 'flagscase: \DRAFT  lala \SEEN -> \Draft lala \Seen' ) ;
+
+	note( 'Leaving  tests_flagscase()' ) ;
         return ;
 }
 
 
 
 sub ucsecond {
-	my $string = shift ;
-	my $output ;
+        my $string = shift ;
+        my $output ;
 
-	return( $string )  if ( 1 >= length $string ) ;
-	
-	$output = ( substr( $string, 0, 1) ) . ( uc substr $string, 1, 1 ) . ( substr $string, 2 ) ;
-	#myprint( "UUU $string -> $output\n"  ) ;
-	return( $output ) ;
+        return( $string )  if ( 1 >= length $string ) ;
+
+        $output = ( substr( $string, 0, 1) ) . ( uc substr $string, 1, 1 ) . ( substr $string, 2 ) ;
+        #myprint( "UUU $string -> $output\n"  ) ;
+        return( $output ) ;
 }
 
 
 sub tests_ucsecond {
-	ok( 'aBcde' eq ucsecond( 'abcde' ), 'ucsecond: abcde -> aBcde' ) ;
-	ok( 'ABCDE' eq ucsecond( 'ABCDE' ), 'ucsecond: ABCDE -> ABCDE'  ) ;
-	ok( 'ABCDE' eq ucsecond( 'AbCDE' ), 'ucsecond: AbCDE -> ABCDE'  ) ;
-	ok( 'ABCde' eq ucsecond( 'AbCde' ), 'ucsecond: AbCde -> ABCde'  ) ;
-	ok( 'A'     eq ucsecond( 'A' ),     'ucsecond: A  -> A'  ) ;
-	ok( 'AB'    eq ucsecond( 'Ab' ),    'ucsecond: Ab -> AB' ) ;
-	ok( '\B'    eq ucsecond( '\b' ),    'ucsecond: \b -> \B' ) ;
-	ok( '\Bcde' eq ucsecond( '\bcde' ), 'ucsecond: \bcde -> \Bcde' ) ;
+	note( 'Entering tests_ucsecond()' ) ;
+        ok( 'aBcde' eq ucsecond( 'abcde' ), 'ucsecond: abcde -> aBcde' ) ;
+        ok( 'ABCDE' eq ucsecond( 'ABCDE' ), 'ucsecond: ABCDE -> ABCDE'  ) ;
+        ok( 'ABCDE' eq ucsecond( 'AbCDE' ), 'ucsecond: AbCDE -> ABCDE'  ) ;
+        ok( 'ABCde' eq ucsecond( 'AbCde' ), 'ucsecond: AbCde -> ABCde'  ) ;
+        ok( 'A'     eq ucsecond( 'A' ),     'ucsecond: A  -> A'  ) ;
+        ok( 'AB'    eq ucsecond( 'Ab' ),    'ucsecond: Ab -> AB' ) ;
+        ok( '\B'    eq ucsecond( '\b' ),    'ucsecond: \b -> \B' ) ;
+        ok( '\Bcde' eq ucsecond( '\bcde' ), 'ucsecond: \bcde -> \Bcde' ) ;
+
+	note( 'Leaving  tests_ucsecond()' ) ;
         return ;
 }
 
 
 sub select_msgs {
-	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
-	my ( @msgs ) ;
+        my ( $imap, $msgs_all_hash_ref, $search_cmd, $abletosearch, $folder ) = @_ ;
+        my ( @msgs ) ;
 
-	if ( $abletosearch ) {
-		@msgs = select_msgs_by_search( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
-	}else{
-		@msgs = select_msgs_by_fetch( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
-	}
-	return(  @msgs ) ;
+        if ( $abletosearch ) {
+                @msgs = select_msgs_by_search( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
+        }else{
+                @msgs = select_msgs_by_fetch( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
+        }
+        return(  @msgs ) ;
 
 }
 
 sub select_msgs_by_search {
-	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
-	my ( @msgs, @msgs_all ) ;
+        my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
+        my ( @msgs, @msgs_all ) ;
 
         # Need to have the whole list in msgs_all_hash_ref
         # without calling messages() several times.
         # Need all messages list to avoid deleting useful cache part
         # in case of --search or --minage or --maxage
 
-	if ( ( defined  $msgs_all_hash_ref  and $usecache )
+        if ( ( defined  $msgs_all_hash_ref  and $usecache )
         or ( not defined  $maxage  and not defined  $minage  and not defined  $search_cmd  )
         ) {
 
-       		$debugdev and myprint( "Calling messages()\n"  ) ;
-		@msgs_all = $imap->messages(  ) ;
+                $debugdev and myprint( "Calling messages()\n"  ) ;
+                @msgs_all = $imap->messages(  ) ;
 
                 return if ( $#msgs_all == 0 && !defined  $msgs_all[0]  ) ;
 
@@ -4807,22 +5849,22 @@ sub select_msgs_by_search {
                 if ( not defined  $maxage  and not defined  $minage  and not defined  $search_cmd  ) {
                         return( @msgs_all ) ;
                 }
-	}
+        }
 
         if ( defined  $search_cmd  ) {
-        	@msgs = $imap->search( $search_cmd ) ;
+                @msgs = $imap->search( $search_cmd ) ;
                 return( @msgs ) ;
         }
 
-	# we are here only if $maxage or $minage is defined
+        # we are here only if $maxage or $minage is defined
         @msgs = select_msgs_by_age( $imap ) ;
-	return( @msgs );
+        return( @msgs );
 }
 
 
 sub select_msgs_by_fetch {
-	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
-	my ( @msgs, @msgs_all, %fetch ) ;
+        my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
+        my ( @msgs, @msgs_all, %fetch ) ;
 
         # Need to have the whole list in msgs_all_hash_ref
         # without calling messages() several times.
@@ -4830,10 +5872,10 @@ sub select_msgs_by_fetch {
         # in case of --search or --minage or --maxage
 
 
-	$debugdev and myprint( "Calling fetch_hash()\n"  ) ;
-	my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
-	my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-	%fetch = %{$imap->fetch_hash( $fetch_hash_uids, 'INTERNALDATE' ) } ;
+        $debugdev and myprint( "Calling fetch_hash()\n"  ) ;
+        my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
+        my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+        %fetch = %{$imap->fetch_hash( $fetch_hash_uids, 'INTERNALDATE' ) } ;
 
         @msgs_all = sort { $a <=> $b } keys  %fetch  ;
         $debugdev and myprint( "Done fetch_hash()\n"  ) ;
@@ -4849,138 +5891,142 @@ sub select_msgs_by_fetch {
         }
 
         if ( defined  $search_cmd  ) {
-		myprint( "Warning: strange to see --search with --noabletosearch, an error can happen\n"  ) ;
-        	@msgs = $imap->search( $search_cmd ) ;
+                myprint( "Warning: strange to see --search with --noabletosearch, an error can happen\n"  ) ;
+                @msgs = $imap->search( $search_cmd ) ;
                 return( @msgs ) ;
         }
 
-	# we are here only if $maxage or $minage is defined
-	my( @max, @min, $maxage_epoch, $minage_epoch ) ;
-	if ( defined  $maxage  ) { $maxage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ; }
-	if ( defined  $minage  ) { $minage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ; }
-	foreach my $msg ( @msgs_all ) {
-		my $idate = $fetch{ $msg }->{'INTERNALDATE'} ;
-		#myprint( "$idate\n"  ) ;
-		if ( defined  $maxage  and ( epoch( $idate ) >= $maxage_epoch ) ) {
-			push  @max, $msg  ;
-		}
-		if ( defined  $minage  and ( epoch( $idate ) <= $minage_epoch ) ) {
-			push  @min, $msg  ;
-		}
-	}
+        # we are here only if $maxage or $minage is defined
+        my( @max, @min, $maxage_epoch, $minage_epoch ) ;
+        if ( defined  $maxage  ) { $maxage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ; }
+        if ( defined  $minage  ) { $minage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ; }
+        foreach my $msg ( @msgs_all ) {
+                my $idate = $fetch{ $msg }->{'INTERNALDATE'} ;
+                #myprint( "$idate\n"  ) ;
+                if ( defined  $maxage  and ( epoch( $idate ) >= $maxage_epoch ) ) {
+                        push  @max, $msg  ;
+                }
+                if ( defined  $minage  and ( epoch( $idate ) <= $minage_epoch ) ) {
+                        push  @min, $msg  ;
+                }
+        }
         @msgs = msgs_from_maxmin( \@max, \@min ) ;
-	return( @msgs ) ;
+        return( @msgs ) ;
 }
 
 sub select_msgs_by_age {
-	my( $imap ) = @_ ;
+        my( $imap ) = @_ ;
 
-	my( @max, @min, @msgs, @inter, @union ) ;
+        my( @max, @min, @msgs, @inter, @union ) ;
 
-	if ( defined  $maxage  ) {
-		@max = $imap->sentsince( $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ) ;
-	}
-	if ( defined  $minage  ) {
-		@min = $imap->sentbefore( $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ) ;
-	}
+        if ( defined  $maxage  ) {
+                @max = $imap->sentsince( $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ) ;
+        }
+        if ( defined  $minage  ) {
+                @min = $imap->sentbefore( $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ) ;
+        }
 
-	@msgs = msgs_from_maxmin( \@max, \@min ) ;
-	return( @msgs ) ;
+        @msgs = msgs_from_maxmin( \@max, \@min ) ;
+        return( @msgs ) ;
 }
 
 sub msgs_from_maxmin {
-	my( $max_ref, $min_ref ) = @_ ;
-	my( @max, @min, @msgs, @inter, @union ) ;
+        my( $max_ref, $min_ref ) = @_ ;
+        my( @max, @min, @msgs, @inter, @union ) ;
 
-	@max = @{ $max_ref } ;
-	@min = @{ $min_ref } ;
+        @max = @{ $max_ref } ;
+        @min = @{ $min_ref } ;
 
-	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 = sort { $a <=> $b } keys  %inter  ;
-		@union = sort { $a <=> $b } keys  %union  ;
-		# normal case
-		if ( $minage <= $maxage )  { @msgs = @inter ; last SWITCH } ;
-		# just exclude messages between
-		if ( $minage > $maxage )  { @msgs = @union ; last SWITCH } ;
+        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 = sort { $a <=> $b } keys  %inter  ;
+                @union = sort { $a <=> $b } keys  %union  ;
+                # normal case
+                if ( $minage <= $maxage )  { @msgs = @inter ; last SWITCH } ;
+                # just exclude messages between
+                if ( $minage > $maxage )  { @msgs = @union ; last SWITCH } ;
 
-	}
-	return( @msgs ) ;
+        }
+        return( @msgs ) ;
 }
 
 sub tests_msgs_from_maxmin {
-	my @msgs ;
-	$maxage = $NUMBER_200 ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '1', '2' ], \@msgs ), 'msgs_from_maxmin: maxage++' ) ;
-	$minage = $NUMBER_100 ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '2' ], \@msgs ), 'msgs_from_maxmin:  -maxage++minage-' ) ;
-	$minage = $NUMBER_300 ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '1', '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++maxage-minage++' ) ;
-	$maxage = undef ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++minage-' ) ;
-	return ;
+	note( 'Entering tests_msgs_from_maxmin()' ) ;
+
+        my @msgs ;
+        $maxage = $NUMBER_200 ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '1', '2' ], \@msgs ), 'msgs_from_maxmin: maxage++' ) ;
+        $minage = $NUMBER_100 ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '2' ], \@msgs ), 'msgs_from_maxmin:  -maxage++minage-' ) ;
+        $minage = $NUMBER_300 ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '1', '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++maxage-minage++' ) ;
+        $maxage = undef ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++minage-' ) ;
+
+	note( 'Leaving  tests_msgs_from_maxmin()' ) ;
+        return ;
 }
 
 
 sub lastuid {
-	my $imap   = shift ;
-	my $folder = shift ;
-	my $lastuid_guess  = shift ;
-	my $lastuid ;
+        my $imap   = shift ;
+        my $folder = shift ;
+        my $lastuid_guess  = shift ;
+        my $lastuid ;
 
-	# rfc3501: The only reliable way to identify recent messages is to
-	#          look at message flags to see which have the \Recent flag
-	#          set, or to do a SEARCH RECENT.
-	# SEARCH RECENT doesn't work this way on courrier.
+        # rfc3501: The only reliable way to identify recent messages is to
+        #          look at message flags to see which have the \Recent flag
+        #          set, or to do a SEARCH RECENT.
+        # SEARCH RECENT doesn't work this way on courrier.
 
-	my @recent_messages ;
-	# SEARCH RECENT for each transfer can be expensive with a big folder
-	# Call commented for now
-	#@recent_messages = $imap->recent(  ) ;
-	#myprint( "Recent: @recent_messages\n" ) ;
+        my @recent_messages ;
+        # SEARCH RECENT for each transfer can be expensive with a big folder
+        # Call commented for now
+        #@recent_messages = $imap->recent(  ) ;
+        #myprint( "Recent: @recent_messages\n" ) ;
 
-	my $max_recent ;
-	$max_recent = max( @recent_messages ) ;
+        my $max_recent ;
+        $max_recent = max( @recent_messages ) ;
 
-	if ( defined  $max_recent  and ($lastuid_guess <= $max_recent ) ) {
-		$lastuid = $max_recent ;
-	}else{
-		$lastuid = $lastuid_guess
-	}
-	return( $lastuid ) ;
+        if ( defined  $max_recent  and ($lastuid_guess <= $max_recent ) ) {
+                $lastuid = $max_recent ;
+        }else{
+                $lastuid = $lastuid_guess
+        }
+        return( $lastuid ) ;
 }
 
 sub size_filtered {
-	my( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) = @_ ;
+        my( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) = @_ ;
 
         $h1_size = 0 if ( ! $h1_size ) ; # null if empty or undef
-	if (defined $maxsize and $h1_size > $maxsize) {
-		myprint( "msg $h1_fold/$h1_msg skipped ($h1_size exceeds maxsize limit $maxsize bytes)\n" ) ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-		return( 1 ) ;
-	}
-	if (defined $minsize and $h1_size <= $minsize) {
-		myprint( "msg $h1_fold/$h1_msg skipped ($h1_size smaller than minsize $minsize bytes)\n" ) ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-		return( 1 ) ;
-	}
-	return( 0 ) ;
+        if (defined $maxsize and $h1_size > $maxsize) {
+                myprint( "msg $h1_fold/$h1_msg skipped ($h1_size exceeds maxsize limit $maxsize bytes)\n" ) ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                return( 1 ) ;
+        }
+        if (defined $minsize and $h1_size <= $minsize) {
+                myprint( "msg $h1_fold/$h1_msg skipped ($h1_size smaller than minsize $minsize bytes)\n" ) ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                return( 1 ) ;
+        }
+        return( 0 ) ;
 }
 
 sub message_exists {
-	my( $imap, $msg ) = @_ ;
-	return( 1 ) if not $imap->Uid(  ) ;
+        my( $imap, $msg ) = @_ ;
+        return( 1 ) if not $imap->Uid(  ) ;
 
-	my $search_uid ;
+        my $search_uid ;
         ( $search_uid ) = $imap->search( "UID $msg" ) ;
         #myprint( "$search ? $msg\n"  ) ;
         return( 1 ) if ( $search_uid eq $msg ) ;
@@ -4988,82 +6034,82 @@ sub message_exists {
 }
 
 sub copy_message {
-	# copy
+        # copy
 
-	my ( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ;
-	( $debug or $dry) and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $dry_message\n" ) ;
+        my ( $mysync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ;
+        ( $debug or $mysync->{dry}) and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $mysync->{dry_message}\n" ) ;
 
-	my $h1_size  = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'}  || 0 ;
-	my $h1_flags = $h1_fir_ref->{$h1_msg}->{'FLAGS'}        || q{} ;
-	my $h1_idate = $h1_fir_ref->{$h1_msg}->{'INTERNALDATE'} || q{} ;
+        my $h1_size  = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'}  || 0 ;
+        my $h1_flags = $h1_fir_ref->{$h1_msg}->{'FLAGS'}        || q{} ;
+        my $h1_idate = $h1_fir_ref->{$h1_msg}->{'INTERNALDATE'} || q{} ;
 
 
         if ( size_filtered( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) ) {
-        	$h1_nb_msg_processed +=1 ;
+                $h1_nb_msg_processed +=1 ;
                 return ;
         }
 
-	debugsleep( $sync ) ;
-	myprint( "- msg $h1_fold/$h1_msg S[$h1_size] F[$h1_flags] I[$h1_idate] has RFC822.SIZE null!\n" ) if ( ! $h1_size )   ;
+        debugsleep( $mysync ) ;
+        myprint( "- msg $h1_fold/$h1_msg S[$h1_size] F[$h1_flags] I[$h1_idate] has RFC822.SIZE null!\n" ) if ( ! $h1_size )   ;
 
 
         if ( $checkmessageexists and not message_exists( $imap1, $h1_msg ) ) {
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-        	$h1_nb_msg_processed +=1 ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                $h1_nb_msg_processed +=1 ;
                 return ;
         }
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("C1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	my ( $string, $string_len ) ;
-        ( $string_len ) = message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, \$string ) ;
+        my ( $string, $string_len ) ;
+        ( $string_len ) = message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, \$string ) ;
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("C2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
         # not defined or empty $string
-        if ( ( not $string ) and ( not $string_len ) ) {
-		myprint( "- msg $h1_fold/$h1_msg skipped.\n"  ) ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-                $h1_nb_msg_processed +=1 ;
+        if ( ( not $string ) or ( not $string_len ) ) {
+                myprint( "- msg $h1_fold/$h1_msg skipped.\n"  ) ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                $h1_nb_msg_processed += 1 ;
                 return ;
         }
 
         # Lines too long (or not enough) => do no copy or fix
         if ( ( defined $maxlinelength ) or ( defined $minmaxlinelength ) ) {
-		$string = linelengthstuff( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate ) ;
-		if ( not defined  $string  ) {
-			$h1_nb_msg_processed +=1 ;
-			$total_bytes_skipped += $h1_size ;
-			$nb_msg_skipped += 1 ;
-			return ;
-		}
-	}
-
-	my $h1_date = date_for_host2( $h1_msg, $h1_idate ) ;
-
-	( $debug or $debugflags ) and
-        myprint( "Host1 flags init msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
-
-	$h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
-
-	( $debug or $debugflags ) and
-        myprint( "Host1 flags filt msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
-
-	$h1_date = undef if ($h1_date eq q{});
-
-	my $new_id = append_message_on_host2( \$string, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) ;
-
-	if ( $new_id and $syncflagsaftercopy ) {
-        	sync_flags_after_copy( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $new_id, $permanentflags2 ) ;
+                $string = linelengthstuff( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate ) ;
+                if ( not defined  $string  ) {
+                        $h1_nb_msg_processed +=1 ;
+                        $total_bytes_skipped += $h1_size ;
+                        $nb_msg_skipped += 1 ;
+                        return ;
+                }
         }
 
-	if ( $sync->{debugmemory} ) {
-        	myprintf("C3: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
+        my $h1_date = date_for_host2( $h1_msg, $h1_idate ) ;
+
+        ( $debug or $debugflags ) and
+        myprint( "Host1 flags init msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
+
+        $h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
+
+        ( $debug or $debugflags ) and
+        myprint( "Host1 flags filt msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
+
+        $h1_date = undef if ($h1_date eq q{});
+
+        my $new_id = append_message_on_host2( \$string, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) ;
+
+        if ( $new_id and $syncflagsaftercopy ) {
+                sync_flags_after_copy( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $new_id, $permanentflags2 ) ;
+        }
+
+        if ( $mysync->{debugmemory} ) {
+                myprintf("C3: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
         return $new_id ;
@@ -5072,51 +6118,51 @@ sub copy_message {
 
 
 sub linelengthstuff {
-	my( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate  ) = @_ ;
-	my $maxlinelength_string = max_line_length( $string ) ;
+        my( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate  ) = @_ ;
+        my $maxlinelength_string = max_line_length( $string ) ;
         $debugmaxlinelength and myprint( "msg $h1_fold/$h1_msg maxlinelength: $maxlinelength_string\n"  ) ;
 
         if ( ( defined $minmaxlinelength )  and ( $maxlinelength_string <= $minmaxlinelength ) ) {
-		my $subject = subject( $string ) ;
-         	$debugdev and myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
-                      	. "(Subject:[$subject]) (max line length under minmaxlinelength $minmaxlinelength bytes)\n" ) ;
-         	return ;
+                my $subject = subject( $string ) ;
+                $debugdev and myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
+                        . "(Subject:[$subject]) (max line length under minmaxlinelength $minmaxlinelength bytes)\n" ) ;
+                return ;
         }
 
         if ( ( defined $maxlinelength )  and ( $maxlinelength_string > $maxlinelength ) ) {
-         	my $subject = subject( $string ) ;
-		if ( $maxlinelengthcmd ) {
-			$string = pipemess( $string, $maxlinelengthcmd ) ;
-			# string undef means something was bad.
-			if ( not ( defined  $string  ) ) {
-				myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] "
-				      . "(Subject:[$subject]) could not be successfully transformed by --maxlinelengthcmd option\n" ) ;
-				return ;
-			}else{
-				return $string ;
-			}
-		}
-         	myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
+                my $subject = subject( $string ) ;
+                if ( $maxlinelengthcmd ) {
+                        $string = pipemess( $string, $maxlinelengthcmd ) ;
+                        # string undef means something was bad.
+                        if ( not ( defined  $string  ) ) {
+                                myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] "
+                                      . "(Subject:[$subject]) could not be successfully transformed by --maxlinelengthcmd option\n" ) ;
+                                return ;
+                        }else{
+                                return $string ;
+                        }
+                }
+                myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
                       . "(Subject:[$subject]) (line length exceeds maxlinelength $maxlinelength bytes)\n" ) ;
-		return ;
-	}
-	return $string ;
+                return ;
+        }
+        return $string ;
 }
 
 
 sub message_for_host2 {
 
-# global variable list: 
+# global variable list:
 # @skipmess
 # @regexmess
 # @pipemess
 # $addheader
 # $debugcontent
 # $debug
-# 
+#
 # API current
 #
-# at failure: 
+# at failure:
 #   * return nothing ( will then be undef or () )
 #   * $string_ref content is undef or empty
 # at success:
@@ -5124,78 +6170,78 @@ sub message_for_host2 {
 #   * $string_ref content filled with message
 
 # API future
-# 
-# 
-	my ( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) = @_ ;
+#
+#
+        my ( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) = @_ ;
 
         # abort when missing a parameter
-        if ( (!$sync) or  (!$h1_msg) or (!$h1_fold) or (!$h1_size) or (!defined $h1_flags) or (!$h1_idate) or (!$h1_fir_ref) or (!$string_ref) ) {
+        if ( (!$sync) or  (!$h1_msg) or (!$h1_fold) or (!$h1_size) or (!defined $h1_flags) or (!defined $h1_idate) or (!$h1_fir_ref) or (!$string_ref) ) {
                 return ;
         }
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("M1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-        my $imap1 = $sync->{imap1} ;
-	my $string_ok = $imap1->message_to_file( $string_ref, $h1_msg ) ;
+        my $imap1 = $mysync->{imap1} ;
+        my $string_ok = $imap1->message_to_file( $string_ref, $h1_msg ) ;
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("M2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	my $string_len = length_ref( $string_ref  ) ;
+        my $string_len = length_ref( $string_ref  ) ;
 
 
-	unless ( defined  $string_ok  and $string_len ) {
-		# undef or 0 length
-		my $error = join q{},
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] could not be fetched: ",
-			$imap1->LastError || q{}, "\n"  ;
-		errors_incr( $sync, $error ) ;
-		$total_bytes_error += $h1_size if ( $h1_size ) ;
+        unless ( defined  $string_ok  and $string_len ) {
+                # undef or 0 length
+                my $error = join q{},
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] could not be fetched: ",
+                        $imap1->LastError || q{}, "\n"  ;
+                errors_incr( $mysync, $error ) ;
+                $total_bytes_error += $h1_size if ( $h1_size ) ;
                 $h1_nb_msg_processed +=1 ;
-		return ;
-	}
+                return ;
+        }
 
-	if ( @skipmess ) {
-		my $match = skipmess( ${ $string_ref } ) ;
+        if ( @skipmess ) {
+                my $match = skipmess( ${ $string_ref } ) ;
                 # string undef means the eval regex was bad.
                 if ( not ( defined  $match  ) ) {
-                	myprint(
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
+                        myprint(
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                         . " could not be skipped by --skipmess option, bad regex\n" ) ;
-                	return ;
+                        return ;
                 }
                 if ( $match ) {
                         my $subject = subject( ${ $string_ref } ) ;
                         myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                             . " (Subject:[$subject]) skipped by --skipmess\n" ) ;
-                	return ;
+                        return ;
                 }
-	}
+        }
 
-	if ( @regexmess ) {
-		${ $string_ref } = regexmess( ${ $string_ref } ) ;
+        if ( @regexmess ) {
+                ${ $string_ref } = regexmess( ${ $string_ref } ) ;
                 # string undef means the eval regex was bad.
                 if ( not ( defined  ${ $string_ref }  ) ) {
-                	myprint(
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
+                        myprint(
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                         . " could not be transformed by --regexmess\n" ) ;
-                	return ;
+                        return ;
                 }
-	}
+        }
 
-	if ( @pipemess ) {
-		${ $string_ref } = pipemess( ${ $string_ref }, @pipemess ) ;
+        if ( @pipemess ) {
+                ${ $string_ref } = pipemess( ${ $string_ref }, @pipemess ) ;
                 # string undef means something was bad.
                 if ( not ( defined  ${ $string_ref }  ) ) {
-                	myprint(
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
+                        myprint(
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                         . " could not be successfully transformed by --pipemess option\n" ) ;
-                	return ;
+                        return ;
                 }
-	}
+        }
 
         if ( $addheader and defined $h1_fir_ref->{$h1_msg}->{'NO_HEADER'} ) {
                 my $header = add_header( $h1_msg ) ;
@@ -5205,85 +6251,89 @@ sub message_for_host2 {
 
         $string_len = length_ref( $string_ref  ) ;
 
-	$debugcontent and myprint(
-		q{=} x $STD_CHAR_PER_LINE, "\n",
-		"F message content begin next line ($string_len characters long)\n",
-		${ $string_ref },
-		"F message content ended on previous line\n", q{=} x $STD_CHAR_PER_LINE, "\n" ) ;
+        $debugcontent and myprint(
+                q{=} x $STD_CHAR_PER_LINE, "\n",
+                "F message content begin next line ($string_len characters long)\n",
+                ${ $string_ref },
+                "F message content ended on previous line\n", q{=} x $STD_CHAR_PER_LINE, "\n" ) ;
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("M3: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	return $string_len ;
+        return $string_len ;
 }
 
 sub tests_message_for_host2 {
-        
-        my ( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) ;
-        
+	note( 'Entering tests_message_for_host2()' ) ;
+
+
+        my ( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) ;
+
         is( undef, message_for_host2(  ), q{message_for_host2: no args} ) ;
-        is( undef, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), q{message_for_host2: undef args} ) ;
+        is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), q{message_for_host2: undef args} ) ;
 
         require Test::MockObject ;
         my $imapT = Test::MockObject->new(  ) ;
-        $sync->{imap1} = $imapT ;
+        $mysync->{imap1} = $imapT ;
         my $string ;
-        
+
         $h1_msg = 1 ;
         $h1_fold = 'FoldFoo';
-        $h1_size =  9 ; 
-        $h1_flags = '' ; 
+        $h1_size =  9 ;
+        $h1_flags = '' ;
         $h1_idate = '10-Jul-2015 09:00:00 +0200' ;
         $h1_fir_ref = {} ;
         $string_ref = \$string ;
-        $imapT->mock( 'message_to_file',   
+        $imapT->mock( 'message_to_file',
                 sub {
-                        my ( $imap, $string_ref, $msg ) = @_ ;
-                        ${$string_ref} = 'blablabla' ;
-                        return length ${$string_ref} ;
+                        my ( $imap, $mystring_ref, $msg ) = @_ ;
+                        ${$mystring_ref} = 'blablabla' ;
+                        return length ${$mystring_ref} ;
                 }
         ) ;
-        is( 9, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+        is( 9, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
         q{message_for_host2: msg 1 == "blablabla", length} ) ;
         is( 'blablabla', $string, q{message_for_host2: msg 1 == "blablabla", value} ) ;
- 
+
         # so far so good
         # now the --pipemess stuff
 
-	SKIP: {
+        SKIP: {
                 Readonly my $NB_WIN_tests_message_for_host2 => 0 ;
-		skip( 'Not on MSWin32', $NB_WIN_tests_message_for_host2 ) if ('MSWin32' ne $OSNAME) ;
-		# Windows
-		# "type" command does not accept redirection of STDIN with <
-		# "sort" does
+                skip( 'Not on MSWin32', $NB_WIN_tests_message_for_host2 ) if ('MSWin32' ne $OSNAME) ;
+                # Windows
+                # "type" command does not accept redirection of STDIN with <
+                # "sort" does
 
-	} ;
+        } ;
 
-	SKIP: {
+        SKIP: {
                 Readonly my $NB_UNX_tests_message_for_host2 => 6 ;
-		skip( 'Not on Unix', $NB_UNX_tests_message_for_host2 ) if ('MSWin32' eq $OSNAME) ;
-		# Unix
-                
+                skip( 'Not on Unix', $NB_UNX_tests_message_for_host2 ) if ('MSWin32' eq $OSNAME) ;
+                # Unix
+
                 # no change by cat
                 @pipemess = ( 'cat' ) ;
-                is( 9, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+                is( 9, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                 q{message_for_host2: --pipemess 'cat', length} ) ;
                 is( 'blablabla', $string, q{message_for_host2: --pipemess 'cat', value} ) ;
 
-                
+
                 # failure by false
                 @pipemess = ( 'false' ) ;
-                is( undef, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+                is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                 q{message_for_host2: --pipemess 'false', length} ) ;
                 is( undef, $string, q{message_for_host2: --pipemess 'false', value} ) ;
 
                 # failure by true since no output
                 @pipemess = ( 'true' ) ;
-                is( undef, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+                is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                 q{message_for_host2: --pipemess 'true', length} ) ;
                 is( undef, $string, q{message_for_host2: --pipemess 'true', value} ) ;
         }
+
+	note( 'Leaving  tests_message_for_host2()' ) ;
         return ;
 }
 
@@ -5294,6 +6344,8 @@ sub length_ref {
 }
 
 sub tests_length_ref {
+	note( 'Entering tests_length_ref()' ) ;
+
         my $notdefined ;
         is( q{}, length_ref( \$notdefined ), q{length_ref: value not defined} ) ;
         my $notref ;
@@ -5302,200 +6354,257 @@ sub tests_length_ref {
         my $lala = 'lala' ;
         is( 4, length_ref( \$lala ), q{length_ref: lala length == 4} ) ;
         is( 4, length_ref( \'lili' ), q{length_ref: lili length == 4} ) ;
+
+	note( 'Leaving  tests_length_ref()' ) ;
         return ;
 }
 
 sub date_for_host2 {
-	my( $h1_msg, $h1_idate ) = @_ ;
+        my( $h1_msg, $h1_idate ) = @_ ;
 
-	my $h1_date = q{} ;
+        my $h1_date = q{} ;
 
-	if ( $syncinternaldates ) {
-		$h1_date = $h1_idate ;
-		$debug and myprint( "internal date from host1: [$h1_date]\n"  ) ;
-		$h1_date = good_date( $h1_date ) ;
-		$debug and myprint( "internal date from host1: [$h1_date] (fixed)\n"  ) ;
-	}
+        if ( $syncinternaldates ) {
+                $h1_date = $h1_idate ;
+                $debug and myprint( "internal date from host1: [$h1_date]\n"  ) ;
+                $h1_date = good_date( $h1_date ) ;
+                $debug and myprint( "internal date from host1: [$h1_date] (fixed)\n"  ) ;
+        }
 
-	if ( $idatefromheader ) {
-		$h1_date = $imap1->get_header( $h1_msg, 'Date' ) ;
-		$debug and myprint( "header date from host1: [$h1_date]\n"  ) ;
-		$h1_date = good_date( $h1_date ) ;
-		$debug and myprint( "header date from host1: [$h1_date] (fixed)\n"  ) ;
-	}
+        if ( $idatefromheader ) {
+                $h1_date = $imap1->get_header( $h1_msg, 'Date' ) ;
+                $debug and myprint( "header date from host1: [$h1_date]\n"  ) ;
+                $h1_date = good_date( $h1_date ) ;
+                $debug and myprint( "header date from host1: [$h1_date] (fixed)\n"  ) ;
+        }
 
-	return( $h1_date ) ;
+        return( $h1_date ) ;
 }
 
 sub flags_for_host2 {
-	my( $h1_flags, $permanentflags2 ) = @_ ;
-	# RFC 2060: This flag can not be altered by any client
-	$h1_flags =~ s@\\Recent\s?@@xgi ;
+        my( $h1_flags, $permanentflags2 ) = @_ ;
+        # RFC 2060: This flag can not be altered by any client
+        $h1_flags =~ s@\\Recent\s?@@xgi ;
         my $h1_flags_re ;
         if ( @regexflag and defined( $h1_flags_re = flags_regex( $h1_flags ) ) ) {
                 $h1_flags = $h1_flags_re ;
         }
-	$h1_flags = flagscase( $h1_flags ) if $flagscase ;
+        $h1_flags = flagscase( $h1_flags ) if $flagscase ;
         $h1_flags = flags_filter( $h1_flags, $permanentflags2) if ( $permanentflags2 and $filterflags ) ;
 
-	return( $h1_flags ) ;
+        return( $h1_flags ) ;
 }
 
 sub subject {
-	my $string = shift ;
-	my $subject = q{} ;
+        my $string = shift ;
+        my $subject = q{} ;
 
         my $header = extract_header( $string ) ;
 
         if( $header =~ m/^Subject:\s*([^\n\r]*)\r?$/msx ) {
-        	#myprint( "MMM[$1]\n"  ) ;
-        	$subject = $1 ;
+                #myprint( "MMM[$1]\n"  ) ;
+                $subject = $1 ;
         }
-	return( $subject ) ;
+        return( $subject ) ;
 }
 
 sub tests_subject {
-	ok( q{} eq subject( q{} ), 'subject: null') ;
-	ok( 'toto le hero' eq subject( 'Subject: toto le hero' ), 'subject: toto le hero') ;
-	ok( 'toto le hero' eq subject( 'Subject:toto le hero' ), 'subject: toto le hero blank') ;
-	ok( 'toto le hero' eq subject( "Subject:toto le hero\r\n" ), 'subject: toto le hero\r\n') ;
+	note( 'Entering tests_subject()' ) ;
+
+        ok( q{} eq subject( q{} ), 'subject: null') ;
+        ok( 'toto le hero' eq subject( 'Subject: toto le hero' ), 'subject: toto le hero') ;
+        ok( 'toto le hero' eq subject( 'Subject:toto le hero' ), 'subject: toto le hero blank') ;
+        ok( 'toto le hero' eq subject( "Subject:toto le hero\r\n" ), 'subject: toto le hero\r\n') ;
 
         my $MESS ;
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 From: lalala
 Subject: toto le hero
 Date: zzzzzz
 
 Boogie boogie
 EOF
-	ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 2') ;
+        ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 2') ;
 
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 Subject: toto le hero
 From: lalala
 Date: zzzzzz
 
 Boogie boogie
 EOF
-	ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 3') ;
+        ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 3') ;
 
 
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 From: lalala
 Subject: cuicui
 Date: zzzzzz
 
 Subject: toto le hero
 EOF
-	ok( 'cuicui' eq subject( $MESS ), 'subject: cuicui') ;
+        ok( 'cuicui' eq subject( $MESS ), 'subject: cuicui') ;
 
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 From: lalala
 Date: zzzzzz
 
 Subject: toto le hero
 EOF
-	ok( q{} eq subject( $MESS ), 'subject: null but body could') ;
+        ok( q{} eq subject( $MESS ), 'subject: null but body could') ;
 
-	return ;
+	note( 'Leaving  tests_subject()' ) ;
+        return ;
 }
 
 
 # GlobVar
-# $dry
+# $sync
 # $max_msg_size_in_bytes
 # $imap2
 # $imap1
 # $total_bytes_error
 # $h1_nb_msg_processed
 # $h2_uidguess
-# $total_bytes_transferred
-# $nb_msg_transferred
-# $begin_transfer_time
-# $time_spent
 # ...
 #
 #
 sub append_message_on_host2 {
-	my( $string_ref, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) = @_ ;
-	if ( $sync->{debugmemory} ) {
-        	myprintf("A1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
+        my( $string_ref, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) = @_ ;
+        if ( $sync->{debugmemory} ) {
+                myprintf("A1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	my $new_id ;
-	if ( ! $dry ) {
-		$max_msg_size_in_bytes = max( $h1_size, $max_msg_size_in_bytes ) ;
-		$new_id = $imap2->append_string( $h2_fold, ${ $string_ref }, $h1_flags, $h1_date ) ;
-	        if ( $sync->{debugmemory} ) {
-        	        myprintf("A2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
+        my $new_id ;
+        if ( ! $sync->{dry} ) {
+                $max_msg_size_in_bytes = max( $h1_size, $max_msg_size_in_bytes ) ;
+                $new_id = $imap2->append_string( $h2_fold, ${ $string_ref }, $h1_flags, $h1_date ) ;
+                if ( $sync->{debugmemory} ) {
+                        myprintf("A2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
                 }
-		if ( ! $new_id){
-                	my $subject = subject( ${ $string_ref } ) ;
+                if ( ! $new_id){
+                        my $subject = subject( ${ $string_ref } ) ;
                         my $error_imap = $imap2->LastError || q{} ;
-			my $error = "- msg $h1_fold/$h1_msg {$string_len} couldn't append  (Subject:[$subject]) to folder $h2_fold: $error_imap\n" ;
-			errors_incr( $sync, $error ) ;
-			$total_bytes_error += $h1_size;
+                        my $error = "- msg $h1_fold/$h1_msg {$string_len} could not append ( Subject:[$subject], Date:[$h1_date], Size:[$h1_size] ) to folder $h2_fold: $error_imap\n" ;
+                        errors_incr( $sync, $error ) ;
+                        $total_bytes_error += $h1_size;
                         $h1_nb_msg_processed +=1 ;
-			return ;
-		}
-		else{
-			# good
-			# $new_id is an id if the IMAP server has the
-			# UIDPLUS capability else just a ref
-			if ( $new_id !~ m{^\d+$}x ) {
-				$new_id = lastuid( $imap2, $h2_fold, $h2_uidguess ) ;
-			}
-			$h2_uidguess += 1 ;
-			$total_bytes_transferred += $h1_size ;
-			$nb_msg_transferred += 1 ;
+                        return ;
+                }
+                else{
+                        # good
+                        # $new_id is an id if the IMAP server has the
+                        # UIDPLUS capability else just a ref
+                        if ( $new_id !~ m{^\d+$}x ) {
+                                $new_id = lastuid( $imap2, $h2_fold, $h2_uidguess ) ;
+                        }
+                        $h2_uidguess += 1 ;
+                        $sync->{total_bytes_transferred} += $h1_size ;
+                        $sync->{nb_msg_transferred} += 1 ;
                         $h1_nb_msg_processed +=1 ;
 
-                        my $time_spent = timesince( $begin_transfer_time ) ;
-                        my $rate = bytes_display_string( $total_bytes_transferred / $time_spent ) ;
+                        my $time_spent = timesince( $sync->{begin_transfer_time} ) ;
+                        my $rate = bytes_display_string( $sync->{total_bytes_transferred} / $time_spent ) ;
                         my $eta = eta( $time_spent,
-                                       $h1_nb_msg_processed, $h1_nb_msg_start, $nb_msg_transferred ) ;
-                        my $amount_transferred = bytes_display_string( $total_bytes_transferred ) ;
-			myprintf( "msg %s/%-19s copied to %s/%-10s %.2f msgs/s  %s/s %s copied  %s\n",
-                        $h1_fold, "$h1_msg {$string_len}", $h2_fold, $new_id, $nb_msg_transferred/$time_spent, $rate,
+                                       $h1_nb_msg_processed, $h1_nb_msg_start, $sync->{nb_msg_transferred} ) ;
+                        my $amount_transferred = bytes_display_string( $sync->{total_bytes_transferred} ) ;
+                        myprintf( "msg %s/%-19s copied to %s/%-10s %.2f msgs/s  %s/s %s copied  %s\n",
+                        $h1_fold, "$h1_msg {$string_len}", $h2_fold, $new_id, $sync->{nb_msg_transferred}/$time_spent, $rate,
                         $amount_transferred,
                         $eta );
-                        sleep_if_needed( $time_spent, $total_bytes_transferred, $nb_msg_transferred ) ;
+                        sleep_if_needed( $sync ) ;
                         if ( $usecache and $cacheaftercopy and $new_id =~ m{^\d+$}x ) {
-				$debugcache and myprint( "touch $cache_dir/${h1_msg}_$new_id\n"  ) ;
-				touch( "$cache_dir/${h1_msg}_$new_id" )
-                        	or croak( "Couldn't touch $cache_dir/${h1_msg}_$new_id" ) ;
+                                $debugcache and myprint( "touch $cache_dir/${h1_msg}_$new_id\n"  ) ;
+                                touch( "$cache_dir/${h1_msg}_$new_id" )
+                                or croak( "Couldn't touch $cache_dir/${h1_msg}_$new_id" ) ;
                         }
-			if ( $delete ) {
-				delete_message_on_host1( $h1_msg, $h1_fold ) ;
-			}
-			#myprint( "PRESS ENTER" ) and my $a = <> ;
+                        if ( $delete1 ) {
+                                delete_message_on_host1( $h1_msg, $h1_fold ) ;
+                        }
+                        #myprint( "PRESS ENTER" ) and my $a = <> ;
                         return( $new_id ) ;
-		}
-	}
-	else{
-		# NOOP to avoid timeout on large folders.
-		$imap2->noop(  ) ;
-		$nb_msg_skipped_dry_mode += 1 ;
+                }
+        }
+        else{
+                $nb_msg_skipped_dry_mode += 1 ;
                 $h1_nb_msg_processed +=1 ;
-	}
+        }
 
+        return ;
+}
+
+sub tests_sleep_if_needed {
+	note( 'Entering tests_sleep_if_needed()' ) ;
+
+	is( undef, sleep_if_needed(  ), 'sleep_if_needed: no args => undef' ) ;
+	my $mysync ;
+	is( undef, sleep_if_needed( $mysync ), 'sleep_if_needed: arg undef => undef' ) ;
+
+	$mysync->{maxbytespersecond} = 1000 ;
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: maxbytespersecond only => no sleep => 0' ) ;
+	$mysync->{begin_transfer_time} = time ; # now
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: begin_transfer_time now => no sleep => 0' ) ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 0 => no sleep => 0' ) ;
+
+	$mysync->{total_bytes_transferred} = 2200 ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before
+	is( '0.20', sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 2200 since 2s => sleep 0.2s' ) ;
+	is( '0',  sleep_if_needed( $mysync ),   'sleep_if_needed: total_bytes_transferred == 2200 since 2+2 == 4s => no sleep' ) ;
+
+	$mysync->{maxsleep} = 0.1 ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before again
+	is( '0.10', sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 4000 since 2s but maxsleep 0.1s => sleep 0.1s' ) ;
+	
+	$mysync->{maxbytesafter} = 4000 ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before again
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: maxbytesafter == total_bytes_transferred => no sleep => 0' ) ;
+
+	note( 'Leaving  tests_sleep_if_needed()' ) ;
 	return ;
 }
 
+
 sub sleep_if_needed {
-	my( $time_spent, $total_bytes_transferred, $nb_msg_transferred ) = @_ ;
-        my $sleep_max_messages = sleep_max_messages( $nb_msg_transferred, $time_spent, $maxmessagespersecond ) ;
-        my $sleep_max_bytes = sleep_max_bytes( $total_bytes_transferred, $time_spent, $maxbytespersecond  ) ;
-        my $sleep_max = max( $sleep_max_messages, $sleep_max_bytes ) ;
+        my( $mysync ) = shift ;
+
+	if ( ! $mysync ) {
+		return ;
+	}
+	# No need to go further if there is no limit set
+	if (  not ( $mysync->{maxmessagespersecond}
+		or $mysync->{maxbytespersecond} )
+	) {
+		return ;
+	}
+	
+	$mysync->{maxsleep} = defined $mysync->{maxsleep} ? $mysync->{maxsleep} : $MAX_SLEEP ;
+	
+	my $time_spent = timesince( $mysync->{begin_transfer_time} ) ;
+        my $sleep_max_messages = sleep_max_messages( $mysync->{nb_msg_transferred}, $time_spent, $mysync->{maxmessagespersecond} ) ;
+
+	my $maxbytesafter = $mysync->{maxbytesafter} || 0 ;
+	my $total_bytes_transferred = $mysync->{total_bytes_transferred} || 0 ;
+	my $total_bytes_to_consider = $total_bytes_transferred - $maxbytesafter ;
+
+	#myprint( "maxbytesafter:$maxbytesafter\n" ) ;
+	#myprint( "total_bytes_to_consider:$total_bytes_to_consider\n" ) ;
+
+        my $sleep_max_bytes = sleep_max_bytes( $total_bytes_to_consider, $time_spent, $mysync->{maxbytespersecond}  ) ;
+        my $sleep_max = min( $mysync->{maxsleep}, max( $sleep_max_messages, $sleep_max_bytes ) ) ;
+	$sleep_max = mysprintf( "%.2f", $sleep_max ) ; # round with 2 decimals.
         if ( $sleep_max > 0 ) {
-        	myprintf( "sleeping %.2f s\n", $sleep_max ) ;
+                myprint( "sleeping $sleep_max s\n" ) ;
                 sleep $sleep_max ;
+		# Slept
+		return $sleep_max ;
         }
-	return ;
+	# No sleep
+        return 0 ;
 }
 
 sub sleep_max_messages {
-	# how long we have to sleep to go under max_messages_per_second
+        # how long we have to sleep to go under max_messages_per_second
         my( $nb_msg_transferred, $time_spent, $maxmessagespersecond ) = @_ ;
         if ( ( not defined  $maxmessagespersecond  ) or $maxmessagespersecond <= 0 ) { return( 0 ) } ;
         my $sleep = ( $nb_msg_transferred / $maxmessagespersecond ) - $time_spent ;
@@ -5505,417 +6614,454 @@ sub sleep_max_messages {
 
 
 sub tests_sleep_max_messages {
-	ok( 0 == sleep_max_messages( 4, 2, undef ),  'sleep_max_messages: maxmessagespersecond = undef') ;
-	ok( 0 == sleep_max_messages( 4, 2, 0 ),  'sleep_max_messages: maxmessagespersecond = 0') ;
-	ok( 0 == sleep_max_messages( 4, 2, $MINUS_ONE ), 'sleep_max_messages: maxmessagespersecond = -1') ;
-	ok( 0 == sleep_max_messages( 4, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max reached') ;
-	ok( 2 == sleep_max_messages( 8, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max over') ;
-	ok( 0 == sleep_max_messages( 2, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max not reached') ;
-	return ;
+	note( 'Entering tests_sleep_max_messages()' ) ;
+
+        ok( 0 == sleep_max_messages( 4, 2, undef ),  'sleep_max_messages: maxmessagespersecond = undef') ;
+        ok( 0 == sleep_max_messages( 4, 2, 0 ),  'sleep_max_messages: maxmessagespersecond = 0') ;
+        ok( 0 == sleep_max_messages( 4, 2, $MINUS_ONE ), 'sleep_max_messages: maxmessagespersecond = -1') ;
+        ok( 0 == sleep_max_messages( 4, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max reached') ;
+        ok( 2 == sleep_max_messages( 8, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max over') ;
+        ok( 0 == sleep_max_messages( 2, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max not reached') ;
+
+	note( 'Leaving  tests_sleep_max_messages()' ) ;
+        return ;
 }
 
 
 sub sleep_max_bytes {
-	# how long we have to sleep to go under max_bytes_per_second
-        my( $total_bytes_transferred, $time_spent, $maxbytespersecond ) = @_ ;
+        # how long we have to sleep to go under max_bytes_per_second
+        my( $total_bytes_to_consider, $time_spent, $maxbytespersecond ) = @_ ;
+	$total_bytes_to_consider ||= 0 ;
+	$time_spent ||= 0 ;
+
         if ( ( not defined  $maxbytespersecond  ) or $maxbytespersecond <= 0 ) { return( 0 ) } ;
-        my $sleep = ( $total_bytes_transferred / $maxbytespersecond ) - $time_spent ;
+	#myprint( "total_bytes_to_consider:$total_bytes_to_consider\n" ) ;
+        my $sleep = ( $total_bytes_to_consider / $maxbytespersecond ) - $time_spent ;
         # the sleep must be positive
         return( max( 0, $sleep ) ) ;
 }
 
 
 sub tests_sleep_max_bytes {
-	ok( 0 == sleep_max_bytes( 4000, 2, undef ),  'sleep_max_bytes: maxbytespersecond = undef') ;
-	ok( 0 == sleep_max_bytes( 4000, 2, 0 ),  'sleep_max_bytes: maxbytespersecond = 0') ;
-	ok( 0 == sleep_max_bytes( 4000, 2, $MINUS_ONE ), 'sleep_max_bytes: maxbytespersecond = -1') ;
-	ok( 0 == sleep_max_bytes( 4000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max reached') ;
-	ok( 2 == sleep_max_bytes( 8000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max over') ;
-	ok( 0 == sleep_max_bytes( 2000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max not reached') ;
-	return ;
+	note( 'Entering tests_sleep_max_bytes()' ) ;
+
+        ok( 0 == sleep_max_bytes( 4000, 2, undef ),  'sleep_max_bytes: maxbytespersecond == undef => sleep 0' ) ;
+        ok( 0 == sleep_max_bytes( 4000, 2, 0 ),  'sleep_max_bytes: maxbytespersecond = 0 => sleep 0') ;
+        ok( 0 == sleep_max_bytes( 4000, 2, $MINUS_ONE ), 'sleep_max_bytes: maxbytespersecond = -1 => sleep 0') ;
+        ok( 0 == sleep_max_bytes( 4000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max reached sharp => sleep 0') ;
+        ok( 2 == sleep_max_bytes( 8000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max over => sleep a little') ;
+        ok( 0 == sleep_max_bytes( -8000, 2, 2000 ), 'sleep_max_bytes: maxbytespersecond = 2k max not reached => sleep 0') ;
+        ok( 0 == sleep_max_bytes( 2000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max not reached => sleep 0') ;
+        ok( 0 == sleep_max_bytes( -2000, 2, 1000 ), 'sleep_max_bytes: maxbytespersecond = 1k max not reached => sleep 0') ;
+
+	note( 'Leaving  tests_sleep_max_bytes()' ) ;
+        return ;
 }
 
 
 
 
-# 6 GlobVar: $dry_message $dry $imap1 $h1_nb_msg_deleted $expunge $expunge1
+# 6 GlobVar: $sync $imap1 $h1_nb_msg_deleted  $expunge1
 sub delete_message_on_host1  {
-	my( $h1_msg, $h1_fold ) = @_ ;
-	my $expunge_message = q{} ;
-	$expunge_message = 'and expunged' if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ;
-	myprint( "Host1 msg $h1_fold/$h1_msg marked deleted $expunge_message $dry_message\n"  ) ;
-        if ( ! $dry ) {
-        	$imap1->delete_message( $h1_msg ) ;
-        	$h1_nb_msg_deleted += 1 ;
-        	$imap1->expunge(  ) if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ;
+        my( $h1_msg, $h1_fold ) = @_ ;
+        my $expunge_message = q{} ;
+        $expunge_message = 'and expunged' if ( $expungeaftereach and $expunge1 ) ;
+        myprint( "Host1 msg $h1_fold/$h1_msg marked deleted $expunge_message $sync->{dry_message}\n"  ) ;
+        if ( ! $sync->{dry} ) {
+                $imap1->delete_message( $h1_msg ) ;
+                $h1_nb_msg_deleted += 1 ;
+                $imap1->expunge(  ) if ( $expungeaftereach and $expunge1 ) ;
         }
         return ;
 }
 
 
 sub eta {
-	my( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) = @_ ;
-	return( q{} ) if not $foldersizes ;
+        my( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) = @_ ;
+        return( q{} ) if not $foldersizes ;
 
-        my $time_remaining = time_remaining( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) ;
-        my $nb_msg_remaining = $h1_nb_msg_start - $h1_nb_processed ;
+        my $time_remaining = time_remaining( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) ;
+        my $nb_msg_remaining = $my_h1_nb_msg_start - $h1_nb_processed ;
         my $eta_date = localtime( time + $time_remaining ) ;
-        return( mysprintf( 'ETA: %s  %1.0f s  %s/%s msgs left', $eta_date, $time_remaining, $nb_msg_remaining, $h1_nb_msg_start ) ) ;
+        return( mysprintf( 'ETA: %s  %1.0f s  %s/%s msgs left', $eta_date, $time_remaining, $nb_msg_remaining, $my_h1_nb_msg_start ) ) ;
 }
 
 sub time_remaining {
 
-	my( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) = @_ ;
+        my( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) = @_ ;
 
-	my $time_remaining = ( $my_time_spent / $nb_transferred ) * ( $h1_nb_msg_start - $h1_nb_processed ) ;
-	return( $time_remaining ) ;
+        my $time_remaining = ( $my_time_spent / $nb_transferred ) * ( $my_h1_nb_msg_start - $h1_nb_processed ) ;
+        return( $time_remaining ) ;
 }
 
 
 sub tests_time_remaining {
+	note( 'Entering tests_time_remaining()' ) ;
 
-	ok( 1 == time_remaining( 1, 1,  2, 1 ), 'time_remaining: 1, 1, 2, 1 -> 1'  ) ;
-	ok( 1 == time_remaining( 9, 9, 10, 9 ), 'time_remaining: 9, 9, 10, 9 -> 1' ) ;
-	ok( 9 == time_remaining( 1, 1, 10, 1 ), 'time_remaining: 1, 1, 10, 1 -> 1' ) ;
-	return ;
+
+        ok( 1 == time_remaining( 1, 1,  2, 1 ), 'time_remaining: 1, 1, 2, 1 -> 1'  ) ;
+        ok( 1 == time_remaining( 9, 9, 10, 9 ), 'time_remaining: 9, 9, 10, 9 -> 1' ) ;
+        ok( 9 == time_remaining( 1, 1, 10, 1 ), 'time_remaining: 1, 1, 10, 1 -> 1' ) ;
+
+	note( 'Leaving  tests_time_remaining()' ) ;
+        return ;
 }
 
 
 sub cache_map {
-	my ( $cache_files_ref, $h1_msgs_ref, $h2_msgs_ref ) = @_;
-	my ( %map1_2, %map2_1, %done2 ) ;
+        my ( $cache_files_ref, $h1_msgs_ref, $h2_msgs_ref ) = @_;
+        my ( %map1_2, %map2_1, %done2 ) ;
 
-	my $h1_msgs_hash_ref = {  } ;
-	my $h2_msgs_hash_ref = {  } ;
+        my $h1_msgs_hash_ref = {  } ;
+        my $h2_msgs_hash_ref = {  } ;
 
-	@{ $h1_msgs_hash_ref }{ @{ $h1_msgs_ref } } = (  ) ;
-	@{ $h2_msgs_hash_ref }{ @{ $h2_msgs_ref } } = (  ) ;
+        @{ $h1_msgs_hash_ref }{ @{ $h1_msgs_ref } } = (  ) ;
+        @{ $h2_msgs_hash_ref }{ @{ $h2_msgs_ref } } = (  ) ;
 
-	foreach my $file ( sort @{ $cache_files_ref } ) {
-		$debugcache and myprint( "C12: $file\n"  ) ;
-		( $uid1, $uid2 ) = match_a_cache_file( $file ) ;
+        foreach my $file ( sort @{ $cache_files_ref } ) {
+                $debugcache and myprint( "C12: $file\n"  ) ;
+                ( $uid1, $uid2 ) = match_a_cache_file( $file ) ;
 
-		if (  exists( $h1_msgs_hash_ref->{ defined  $uid1  ? $uid1 : q{} } )
-		  and exists( $h2_msgs_hash_ref->{ defined  $uid2  ? $uid2 : q{} } ) ) {
-		  	# keep only the greatest uid2
-			# 130_2301 and
-			# 130_231  => keep only 130 -> 2301
+                if (  exists( $h1_msgs_hash_ref->{ defined  $uid1  ? $uid1 : q{} } )
+                  and exists( $h2_msgs_hash_ref->{ defined  $uid2  ? $uid2 : q{} } ) ) {
+                        # keep only the greatest uid2
+                        # 130_2301 and
+                        # 130_231  => keep only 130 -> 2301
 
-			# keep only the greatest uid1
-			# 1601_260 and
-			#  161_260 => keep only 1601 -> 260
-		  	my $max_uid2 = max( $uid2, $map1_2{ $uid1 } || $MINUS_ONE ) ;
-			if ( exists $done2{ $max_uid2 } ) {
-				if ( $done2{ $max_uid2 } < $uid1 )  {
-					$map1_2{ $uid1 } = $max_uid2 ;
-					delete $map1_2{ $done2{ $max_uid2 } } ;
-					$done2{ $max_uid2 } = $uid1 ;
-				}
-			}else{
-				$map1_2{ $uid1 } = $max_uid2 ;
-				$done2{ $max_uid2 } = $uid1 ;
-			}
-		};
+                        # keep only the greatest uid1
+                        # 1601_260 and
+                        #  161_260 => keep only 1601 -> 260
+                        my $max_uid2 = max( $uid2, $map1_2{ $uid1 } || $MINUS_ONE ) ;
+                        if ( exists $done2{ $max_uid2 } ) {
+                                if ( $done2{ $max_uid2 } < $uid1 )  {
+                                        $map1_2{ $uid1 } = $max_uid2 ;
+                                        delete $map1_2{ $done2{ $max_uid2 } } ;
+                                        $done2{ $max_uid2 } = $uid1 ;
+                                }
+                        }else{
+                                $map1_2{ $uid1 } = $max_uid2 ;
+                                $done2{ $max_uid2 } = $uid1 ;
+                        }
+                };
 
-	}
-	%map2_1 = reverse %map1_2 ;
-	return( \%map1_2, \%map2_1) ;
+        }
+        %map2_1 = reverse %map1_2 ;
+        return( \%map1_2, \%map2_1) ;
 }
 
 sub tests_cache_map {
-	#$debugcache = 1 ;
-	my @cache_files = qw (
-	100_200
-	101_201
-	120_220
-	142_242
-	143_243
-	177_277
-	177_278
-	177_279
-	155_255
-	180_280
-	181_280
-	182_280
-	130_231
-	130_2301
-	161_260
-	1601_260
-	) ;
+	note( 'Entering tests_cache_map()' ) ;
 
-	my $msgs_1 = [120, 142, 143, 144, 161, 1601,           177,      182, 130 ];
-	my $msgs_2 = [     242, 243,       260,      299, 377, 279, 255, 280, 231, 2301 ];
+        #$debugcache = 1 ;
+        my @cache_files = qw (
+        100_200
+        101_201
+        120_220
+        142_242
+        143_243
+        177_277
+        177_278
+        177_279
+        155_255
+        180_280
+        181_280
+        182_280
+        130_231
+        130_2301
+        161_260
+        1601_260
+        ) ;
 
-	my( $c12, $c21 ) ;
-	ok( ( $c12, $c21 ) = cache_map( \@cache_files, $msgs_1, $msgs_2 ), 'cache_map: 02' );
-	my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
-	my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
-	ok( 0 == compare_lists( [ 130, 142, 143,      177, 182, 1601      ], $a1 ), 'cache_map: 03' );
-	ok( 0 == compare_lists( [      242, 243, 260, 279, 280,      2301 ], $a2 ), 'cache_map: 04' );
-	ok( ! $c12->{161},        'cache_map: ! 161 ->  260' );
-	ok( 260  == $c12->{1601}, 'cache_map:  1601 ->  260' );
-	ok( 2301 == $c12->{130},  'cache_map:   130 -> 2301' );
-	#myprint( $c12->{1601}, "\n" ) ;
-	return ;
+        my $msgs_1 = [120, 142, 143, 144, 161, 1601,           177,      182, 130 ];
+        my $msgs_2 = [     242, 243,       260,      299, 377, 279, 255, 280, 231, 2301 ];
+
+        my( $c12, $c21 ) ;
+        ok( ( $c12, $c21 ) = cache_map( \@cache_files, $msgs_1, $msgs_2 ), 'cache_map: 02' );
+        my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
+        my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
+        ok( 0 == compare_lists( [ 130, 142, 143,      177, 182, 1601      ], $a1 ), 'cache_map: 03' );
+        ok( 0 == compare_lists( [      242, 243, 260, 279, 280,      2301 ], $a2 ), 'cache_map: 04' );
+        ok( ! $c12->{161},        'cache_map: ! 161 ->  260' );
+        ok( 260  == $c12->{1601}, 'cache_map:  1601 ->  260' );
+        ok( 2301 == $c12->{130},  'cache_map:   130 -> 2301' );
+        #myprint( $c12->{1601}, "\n" ) ;
+
+	note( 'Leaving  tests_cache_map()' ) ;
+        return ;
 
 }
 
 sub cache_dir_fix {
-	my $cache_dir = shift ;
+        my $cache_dir = shift ;
         $cache_dir =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'"\\])/\\$1/xg ;
         #myprint( "cache_dir_fix: $cache_dir\n"  ) ;
-	return( $cache_dir ) ;
+        return( $cache_dir ) ;
 }
 
 sub tests_cache_dir_fix {
-	ok( 'lalala' eq  cache_dir_fix('lalala'),  'cache_dir_fix: lalala -> lalala' );
-	ok( 'ii\\\\ii' eq  cache_dir_fix('ii\ii'), 'cache_dir_fix: ii\ii -> ii\\\\ii' );
-	ok( 'ii@ii' eq  cache_dir_fix('ii@ii'),  'cache_dir_fix: ii@ii -> ii@ii' );
-	ok( 'ii@ii\\:ii' eq  cache_dir_fix('ii@ii:ii'), 'cache_dir_fix: ii@ii:ii -> ii@ii\\:ii' );
-	ok( 'i\\\\i\\\\ii' eq  cache_dir_fix('i\i\ii'), 'cache_dir_fix: i\i\ii -> i\\\\i\\\\ii' );
-	ok( 'i\\\\ii' eq  cache_dir_fix('i\\ii'), 'cache_dir_fix: i\\ii -> i\\\\\\\\ii' );
-	ok( '\\\\ ' eq  cache_dir_fix('\\ '), 'cache_dir_fix: \\  -> \\\\\ ' );
-	ok( '\\\\ ' eq  cache_dir_fix('\ '), 'cache_dir_fix: \  -> \\\\\ ' );
-	ok( '\[bracket\]' eq  cache_dir_fix('[bracket]'), 'cache_dir_fix: [bracket] -> \[bracket\]' );
-	return ;
+	note( 'Entering tests_cache_dir_fix()' ) ;
+
+        ok( 'lalala' eq  cache_dir_fix('lalala'),  'cache_dir_fix: lalala -> lalala' );
+        ok( 'ii\\\\ii' eq  cache_dir_fix('ii\ii'), 'cache_dir_fix: ii\ii -> ii\\\\ii' );
+        ok( 'ii@ii' eq  cache_dir_fix('ii@ii'),  'cache_dir_fix: ii@ii -> ii@ii' );
+        ok( 'ii@ii\\:ii' eq  cache_dir_fix('ii@ii:ii'), 'cache_dir_fix: ii@ii:ii -> ii@ii\\:ii' );
+        ok( 'i\\\\i\\\\ii' eq  cache_dir_fix('i\i\ii'), 'cache_dir_fix: i\i\ii -> i\\\\i\\\\ii' );
+        ok( 'i\\\\ii' eq  cache_dir_fix('i\\ii'), 'cache_dir_fix: i\\ii -> i\\\\\\\\ii' );
+        ok( '\\\\ ' eq  cache_dir_fix('\\ '), 'cache_dir_fix: \\  -> \\\\\ ' );
+        ok( '\\\\ ' eq  cache_dir_fix('\ '), 'cache_dir_fix: \  -> \\\\\ ' );
+        ok( '\[bracket\]' eq  cache_dir_fix('[bracket]'), 'cache_dir_fix: [bracket] -> \[bracket\]' );
+
+	note( 'Leaving  tests_cache_dir_fix()' ) ;
+        return ;
 }
 
 sub cache_dir_fix_win {
-	my $cache_dir = shift ;
+        my $cache_dir = shift ;
         $cache_dir =~ s/(\[|\])/[$1]/xg ;
         #myprint( "cache_dir_fix_win: $cache_dir\n"  ) ;
-	return( $cache_dir ) ;
+        return( $cache_dir ) ;
 }
 
 sub tests_cache_dir_fix_win {
-	ok( 'lalala' eq  cache_dir_fix_win('lalala'),  'cache_dir_fix_win: lalala -> lalala' );
-	ok( '[[]bracket[]]' eq  cache_dir_fix_win('[bracket]'), 'cache_dir_fix_win: [bracket] -> [[]bracket[]]' );
-	return ;
+	note( 'Entering tests_cache_dir_fix_win()' ) ;
+
+        ok( 'lalala' eq  cache_dir_fix_win('lalala'),  'cache_dir_fix_win: lalala -> lalala' );
+        ok( '[[]bracket[]]' eq  cache_dir_fix_win('[bracket]'), 'cache_dir_fix_win: [bracket] -> [[]bracket[]]' );
+
+	note( 'Leaving  tests_cache_dir_fix_win()' ) ;
+        return ;
 }
 
 
 
 
 sub get_cache {
-	my ( $cache_dir, $h1_msgs_ref, $h2_msgs_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) = @_;
+        my ( $cache_dir, $h1_msgs_ref, $h2_msgs_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) = @_;
 
-	$debugcache and myprint( "Entering get_cache\n" ) ;
+        $debugcache and myprint( "Entering get_cache\n" ) ;
 
-	-d $cache_dir or return( undef ); # exit if cache directory doesn't exist
-	$debugcache and myprint( "cache_dir    : $cache_dir\n" ) ;
+        -d $cache_dir or return( undef ); # exit if cache directory doesn't exist
+        $debugcache and myprint( "cache_dir    : $cache_dir\n" ) ;
 
 
         if ( 'MSWin32' ne $OSNAME ) {
-        	$cache_dir = cache_dir_fix( $cache_dir ) ;
+                $cache_dir = cache_dir_fix( $cache_dir ) ;
         }else{
-        	$cache_dir = cache_dir_fix_win( $cache_dir ) ;
+                $cache_dir = cache_dir_fix_win( $cache_dir ) ;
         }
 
-	$debugcache and myprint( "cache_dir_fix: $cache_dir\n"  ) ;
+        $debugcache and myprint( "cache_dir_fix: $cache_dir\n"  ) ;
 
-	my @cache_files = bsd_glob( "$cache_dir/*" ) ;
-	#$debugcache and myprint( "cache_files: [@cache_files]\n"  ) ;
+        my @cache_files = bsd_glob( "$cache_dir/*" ) ;
+        #$debugcache and myprint( "cache_files: [@cache_files]\n"  ) ;
 
-	$debugcache and myprint( 'cache_files: ', scalar  @cache_files , " files found\n" ) ;
+        $debugcache and myprint( 'cache_files: ', scalar  @cache_files , " files found\n" ) ;
 
-	my( $cache_1_2_ref, $cache_2_1_ref )
-	  = cache_map( \@cache_files, $h1_msgs_ref, $h2_msgs_ref ) ;
+        my( $cache_1_2_ref, $cache_2_1_ref )
+          = cache_map( \@cache_files, $h1_msgs_ref, $h2_msgs_ref ) ;
 
-	clean_cache( \@cache_files, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
+        clean_cache( \@cache_files, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
 
-	$debugcache and myprint( "Exiting get_cache\n" ) ;
-	return( $cache_1_2_ref, $cache_2_1_ref ) ;
+        $debugcache and myprint( "Exiting get_cache\n" ) ;
+        return( $cache_1_2_ref, $cache_2_1_ref ) ;
 }
 
 
 sub tests_get_cache {
+	note( 'Entering tests_get_cache()' ) ;
 
-	ok( not( get_cache('/cache_no_exist') ), 'get_cache: /cache_no_exist' );
-	ok( ( not -d 'W/tmp/cache/F1/F2' or rmtree( 'W/tmp/cache/F1/F2' )), 'get_cache: rmtree W/tmp/cache/F1/F2' ) ;
-	ok( mkpath( 'W/tmp/cache/F1/F2' ), 'get_cache: mkpath W/tmp/cache/F1/F2' ) ;
+        ok( not( get_cache('/cache_no_exist') ), 'get_cache: /cache_no_exist' );
+        ok( ( not -d 'W/tmp/cache/F1/F2' or rmtree( 'W/tmp/cache/F1/F2' ) ), 'get_cache: rmtree W/tmp/cache/F1/F2' ) ;
+        ok( mkpath( 'W/tmp/cache/F1/F2' ), 'get_cache: mkpath W/tmp/cache/F1/F2' ) ;
 
-	my @test_files_cache = ( qw(
-	W/tmp/cache/F1/F2/100_200
-	W/tmp/cache/F1/F2/101_201
-	W/tmp/cache/F1/F2/120_220
-	W/tmp/cache/F1/F2/142_242
-	W/tmp/cache/F1/F2/143_243
-	W/tmp/cache/F1/F2/177_277
-	W/tmp/cache/F1/F2/177_377
-	W/tmp/cache/F1/F2/177_777
-	W/tmp/cache/F1/F2/155_255
-	) ) ;
-	ok( touch( @test_files_cache ), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
+        my @test_files_cache = ( qw(
+        W/tmp/cache/F1/F2/100_200
+        W/tmp/cache/F1/F2/101_201
+        W/tmp/cache/F1/F2/120_220
+        W/tmp/cache/F1/F2/142_242
+        W/tmp/cache/F1/F2/143_243
+        W/tmp/cache/F1/F2/177_277
+        W/tmp/cache/F1/F2/177_377
+        W/tmp/cache/F1/F2/177_777
+        W/tmp/cache/F1/F2/155_255
+        ) ) ;
+        ok( touch( @test_files_cache ), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
 
 
-	# on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
-	# on live:
-	my $msgs_1 = [120, 142, 143, 144,          177      ];
-	my $msgs_2 = [     242, 243,     299, 377, 777, 255 ];
+        # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
+        # on live:
+        my $msgs_1 = [120, 142, 143, 144,          177      ];
+        my $msgs_2 = [     242, 243,     299, 377, 777, 255 ];
 
         my $msgs_all_1 = { 120 => 0, 142 => 0, 143 => 0, 144 => 0, 177 => 0 } ;
         my $msgs_all_2 = { 242 => 0, 243 => 0, 299 => 0, 377 => 0, 777 => 0, 255 => 0 } ;
 
-	my( $c12, $c21 ) ;
-	ok( ( $c12, $c21 ) = get_cache( 'W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
-	my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
-	my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
-	ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' );
-	ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' );
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
-	ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200');
-	ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201');
+        my( $c12, $c21 ) ;
+        ok( ( $c12, $c21 ) = get_cache( 'W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
+        my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
+        my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
+        ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' );
+        ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' );
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
+        ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200');
+        ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201');
 
-	# test clean_cache executed
-	$maxage = 2 ;
-	ok( touch(@test_files_cache), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
-	ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
-	ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200');
-	ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201');
+        # test clean_cache executed
+        $maxage = 2 ;
+        ok( touch(@test_files_cache), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
+        ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
+        ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200');
+        ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201');
 
 
-	# strange files
-	#$debugcache = 1 ;
-	$maxage = undef ;
-	ok( ( not -d 'W/tmp/cache/rr\uee' or rmtree( 'W/tmp/cache/rr\uee' )), 'get_cache: rmtree W/tmp/cache/rr\uee' ) ;
-	ok( mkpath( 'W/tmp/cache/rr\uee' ), 'get_cache: mkpath W/tmp/cache/rr\uee' ) ;
+        # strange files
+        #$debugcache = 1 ;
+        $maxage = undef ;
+        ok( ( not -d 'W/tmp/cache/rr\uee' or rmtree( 'W/tmp/cache/rr\uee' )), 'get_cache: rmtree W/tmp/cache/rr\uee' ) ;
+        ok( mkpath( 'W/tmp/cache/rr\uee' ), 'get_cache: mkpath W/tmp/cache/rr\uee' ) ;
 
-	@test_files_cache = ( qw(
-	W/tmp/cache/rr\uee/100_200
-	W/tmp/cache/rr\uee/101_201
-	W/tmp/cache/rr\uee/120_220
-	W/tmp/cache/rr\uee/142_242
-	W/tmp/cache/rr\uee/143_243
-	W/tmp/cache/rr\uee/177_277
-	W/tmp/cache/rr\uee/177_377
-	W/tmp/cache/rr\uee/177_777
-	W/tmp/cache/rr\uee/155_255
-	) ) ;
-	ok( touch(@test_files_cache), 'get_cache: touch strange W/tmp/cache/...' ) ;
+        @test_files_cache = ( qw(
+        W/tmp/cache/rr\uee/100_200
+        W/tmp/cache/rr\uee/101_201
+        W/tmp/cache/rr\uee/120_220
+        W/tmp/cache/rr\uee/142_242
+        W/tmp/cache/rr\uee/143_243
+        W/tmp/cache/rr\uee/177_277
+        W/tmp/cache/rr\uee/177_377
+        W/tmp/cache/rr\uee/177_777
+        W/tmp/cache/rr\uee/155_255
+        ) ) ;
+        ok( touch(@test_files_cache), 'get_cache: touch strange W/tmp/cache/...' ) ;
 
-	# on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
-	# on live:
-	$msgs_1 = [120, 142, 143, 144,          177      ] ;
-	$msgs_2 = [     242, 243,     299, 377, 777, 255 ] ;
+        # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
+        # on live:
+        $msgs_1 = [120, 142, 143, 144,          177      ] ;
+        $msgs_2 = [     242, 243,     299, 377, 777, 255 ] ;
 
         $msgs_all_1 = { 120 => q{}, 142 => q{}, 143 => q{}, 144 => q{}, 177 => q{} } ;
         $msgs_all_2 = { 242 => q{}, 243 => q{}, 299 => q{}, 377 => q{}, 777 => q{}, 255 => q{} } ;
 
-	ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/rr\uee', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2), 'get_cache: strange path 02' );
-	$a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
-	$a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
-	ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: strange path 03' );
-	ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: strange path 04' );
-	ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 142_242');
-	ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 143_243');
-	ok( ! -f 'W/tmp/cache/rr\uee/100_200', 'get_cache: strange path file removed 100_200');
-	ok( ! -f 'W/tmp/cache/rr\uee/101_201', 'get_cache: strange path file removed 101_201');
-	return ;
+        ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/rr\uee', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2), 'get_cache: strange path 02' );
+        $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
+        $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
+        ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: strange path 03' );
+        ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: strange path 04' );
+        ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 142_242');
+        ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 143_243');
+        ok( ! -f 'W/tmp/cache/rr\uee/100_200', 'get_cache: strange path file removed 100_200');
+        ok( ! -f 'W/tmp/cache/rr\uee/101_201', 'get_cache: strange path file removed 101_201');
+
+	note( 'Leaving  tests_get_cache()' ) ;
+        return ;
 }
 
 sub match_a_cache_file {
-	my $file = shift ;
-	my ( $cache_uid1, $cache_uid2 ) ;
+        my $file = shift ;
+        my ( $cache_uid1, $cache_uid2 ) ;
 
-	return( ( undef, undef ) ) if ( ! $file ) ;
-	if ( $file =~ m{(?:^|/)(\d+)_(\d+)$}x ) {
-		$cache_uid1 = $1 ;
-		$cache_uid2 = $2 ;
-	}
-	return( $cache_uid1, $cache_uid2 ) ;
+        return( ( undef, undef ) ) if ( ! $file ) ;
+        if ( $file =~ m{(?:^|/)(\d+)_(\d+)$}x ) {
+                $cache_uid1 = $1 ;
+                $cache_uid2 = $2 ;
+        }
+        return( $cache_uid1, $cache_uid2 ) ;
 }
 
 sub tests_match_a_cache_file {
-	my ( $tuid1, $tuid2 ) ;
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file(  ), 'match_a_cache_file: no arg' ) ;
-	ok( ! defined  $tuid1 , 'match_a_cache_file: no arg 1' ) ;
-	ok( ! defined  $tuid2 , 'match_a_cache_file: no arg 2' ) ;
+	note( 'Entering tests_match_a_cache_file()' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( q{} ), 'match_a_cache_file: empty arg' ) ;
-	ok( ! defined  $tuid1 , 'match_a_cache_file: empty arg 1' ) ;
-	ok( ! defined  $tuid2 , 'match_a_cache_file: empty arg 2' ) ;
+        my ( $tuid1, $tuid2 ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file(  ), 'match_a_cache_file: no arg' ) ;
+        ok( ! defined  $tuid1 , 'match_a_cache_file: no arg 1' ) ;
+        ok( ! defined  $tuid2 , 'match_a_cache_file: no arg 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '000_000' ), 'match_a_cache_file: 000_000' ) ;
-	ok( '000' eq $tuid1, 'match_a_cache_file: 000_000 1' ) ;
-	ok( '000' eq $tuid2, 'match_a_cache_file: 000_000 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( q{} ), 'match_a_cache_file: empty arg' ) ;
+        ok( ! defined  $tuid1 , 'match_a_cache_file: empty arg 1' ) ;
+        ok( ! defined  $tuid2 , 'match_a_cache_file: empty arg 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ;
-	ok( '123' eq $tuid1, 'match_a_cache_file: 123_456 1' ) ;
-	ok( '456' eq $tuid2, 'match_a_cache_file: 123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '000_000' ), 'match_a_cache_file: 000_000' ) ;
+        ok( '000' eq $tuid1, 'match_a_cache_file: 000_000 1' ) ;
+        ok( '000' eq $tuid2, 'match_a_cache_file: 000_000 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ;
-	ok( '123' eq $tuid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ;
-	ok( '456' eq $tuid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ;
+        ok( '123' eq $tuid1, 'match_a_cache_file: 123_456 1' ) ;
+        ok( '456' eq $tuid2, 'match_a_cache_file: 123_456 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ;
-	ok( ! $tuid1, 'match_a_cache_file: /lala123_456 1' ) ;
-	ok( ! $tuid2, 'match_a_cache_file: /lala123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ;
+        ok( '123' eq $tuid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ;
+        ok( '456' eq $tuid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( 'la123_456' ), 'match_a_cache_file: NO la123_456' ) ;
-	ok( ! $tuid1, 'match_a_cache_file: la123_456 1' ) ;
-	ok( ! $tuid2, 'match_a_cache_file: la123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ;
+        ok( ! $tuid1, 'match_a_cache_file: /lala123_456 1' ) ;
+        ok( ! $tuid2, 'match_a_cache_file: /lala123_456 2' ) ;
 
-	return ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( 'la123_456' ), 'match_a_cache_file: NO la123_456' ) ;
+        ok( ! $tuid1, 'match_a_cache_file: la123_456 1' ) ;
+        ok( ! $tuid2, 'match_a_cache_file: la123_456 2' ) ;
+
+	note( 'Leaving  tests_match_a_cache_file()' ) ;
+        return ;
 }
 
 sub clean_cache {
-	my ( $cache_files_ref, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref )  = @_ ;
+        my ( $cache_files_ref, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref )  = @_ ;
 
-	$debugcache and myprint( "Entering clean_cache\n" ) ;
+        $debugcache and myprint( "Entering clean_cache\n" ) ;
 
-	$debugcache and myprint( map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %{ $cache_1_2_ref }  ) ;
-	foreach my $file ( @{ $cache_files_ref } ) {
-		$debugcache and myprint( "$file\n"  ) ;
-		my ( $cache_uid1, $cache_uid2 ) = match_a_cache_file( $file ) ;
-		$debugcache and myprint( "u1: $cache_uid1 u2: $cache_uid2 c12: ", $cache_1_2_ref->{ $cache_uid1 } || q{}, "\n") ;
-#		  or ( ! exists( $cache_1_2_ref->{ $cache_uid1 } ) )
-#		  or ( ! ( $cache_uid2 == $cache_1_2_ref->{ $cache_uid1 } ) )
-		if ( ( not defined  $cache_uid1  )
-		  or ( not defined  $cache_uid2  )
+        $debugcache and myprint( map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %{ $cache_1_2_ref }  ) ;
+        foreach my $file ( @{ $cache_files_ref } ) {
+                $debugcache and myprint( "$file\n"  ) ;
+                my ( $cache_uid1, $cache_uid2 ) = match_a_cache_file( $file ) ;
+                $debugcache and myprint( "u1: $cache_uid1 u2: $cache_uid2 c12: ", $cache_1_2_ref->{ $cache_uid1 } || q{}, "\n") ;
+#                 or ( ! exists( $cache_1_2_ref->{ $cache_uid1 } ) )
+#                 or ( ! ( $cache_uid2 == $cache_1_2_ref->{ $cache_uid1 } ) )
+                if ( ( not defined  $cache_uid1  )
+                  or ( not defined  $cache_uid2  )
                   or ( not exists  $h1_msgs_all_hash_ref->{ $cache_uid1 }  )
                   or ( not exists  $h2_msgs_all_hash_ref->{ $cache_uid2 }  )
                 ) {
-			$debugcache and myprint( "remove $file\n"  ) ;
-			unlink $file or myprint( "$!"  ) ;
-		}
-	}
+                        $debugcache and myprint( "remove $file\n"  ) ;
+                        unlink $file or myprint( "$OS_ERROR"  ) ;
+                }
+        }
 
-	$debugcache and myprint( "Exiting clean_cache\n" ) ;
-	return( 1 ) ;
+        $debugcache and myprint( "Exiting clean_cache\n" ) ;
+        return( 1 ) ;
 }
 
 sub tests_clean_cache {
+	note( 'Entering tests_clean_cache()' ) ;
 
-	ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache: rmtree W/tmp/cache/G1/G2' ) ;
-	ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache: mkpath W/tmp/cache/G1/G2' ) ;
+        ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache: rmtree W/tmp/cache/G1/G2' ) ;
+        ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache: mkpath W/tmp/cache/G1/G2' ) ;
 
-	my @test_files_cache = ( qw(
-	W/tmp/cache/G1/G2/100_200
-	W/tmp/cache/G1/G2/101_201
-	W/tmp/cache/G1/G2/120_220
-	W/tmp/cache/G1/G2/142_242
-	W/tmp/cache/G1/G2/143_243
-	W/tmp/cache/G1/G2/177_277
-	W/tmp/cache/G1/G2/177_377
-	W/tmp/cache/G1/G2/177_777
-	W/tmp/cache/G1/G2/155_255
-	) ) ;
-	ok( touch(@test_files_cache), 'clean_cache: touch W/tmp/cache/G1/G2/...' ) ;
+        my @test_files_cache = ( qw(
+        W/tmp/cache/G1/G2/100_200
+        W/tmp/cache/G1/G2/101_201
+        W/tmp/cache/G1/G2/120_220
+        W/tmp/cache/G1/G2/142_242
+        W/tmp/cache/G1/G2/143_243
+        W/tmp/cache/G1/G2/177_277
+        W/tmp/cache/G1/G2/177_377
+        W/tmp/cache/G1/G2/177_777
+        W/tmp/cache/G1/G2/155_255
+        ) ) ;
+        ok( touch(@test_files_cache), 'clean_cache: touch W/tmp/cache/G1/G2/...' ) ;
 
-	ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' );
-	ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' );
-	ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' );
+        ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' );
+        ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' );
+        ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' );
 
-	my $cache = {
-		142 => 242,
-		177 => 777,
-	} ;
+        my $cache = {
+                142 => 242,
+                177 => 777,
+        } ;
 
         my $all_1 = {
                 142 => q{},
@@ -5927,46 +7073,49 @@ sub tests_clean_cache {
                 242 => q{},
                 777 => q{},
         } ;
-	ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache: ' ) ;
+        ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache: ' ) ;
 
-	ok( ! -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' );
-	return ;
+        ok( ! -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' );
+
+	note( 'Leaving  tests_clean_cache()' ) ;
+        return ;
 }
 
 sub tests_clean_cache_2 {
+	note( 'Entering tests_clean_cache_2()' ) ;
 
-	ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache_2: rmtree W/tmp/cache/G1/G2' ) ;
-	ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache_2: mkpath W/tmp/cache/G1/G2' ) ;
+        ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache_2: rmtree W/tmp/cache/G1/G2' ) ;
+        ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache_2: mkpath W/tmp/cache/G1/G2' ) ;
 
-	my @test_files_cache = ( qw(
-	W/tmp/cache/G1/G2/100_200
-	W/tmp/cache/G1/G2/101_201
-	W/tmp/cache/G1/G2/120_220
-	W/tmp/cache/G1/G2/142_242
-	W/tmp/cache/G1/G2/143_243
-	W/tmp/cache/G1/G2/177_277
-	W/tmp/cache/G1/G2/177_377
-	W/tmp/cache/G1/G2/177_777
-	W/tmp/cache/G1/G2/155_255
-	) ) ;
-	ok( touch(@test_files_cache), 'clean_cache_2: touch W/tmp/cache/G1/G2/...' ) ;
+        my @test_files_cache = ( qw(
+        W/tmp/cache/G1/G2/100_200
+        W/tmp/cache/G1/G2/101_201
+        W/tmp/cache/G1/G2/120_220
+        W/tmp/cache/G1/G2/142_242
+        W/tmp/cache/G1/G2/143_243
+        W/tmp/cache/G1/G2/177_277
+        W/tmp/cache/G1/G2/177_377
+        W/tmp/cache/G1/G2/177_777
+        W/tmp/cache/G1/G2/155_255
+        ) ) ;
+        ok( touch(@test_files_cache), 'clean_cache_2: touch W/tmp/cache/G1/G2/...' ) ;
 
-	ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 before' );
-	ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 before' );
-	ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 before' );
+        ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 before' );
+        ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 before' );
+        ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 before' );
 
-	my $cache = {
-		142 => 242,
-		177 => 777,
-	} ;
+        my $cache = {
+                142 => 242,
+                177 => 777,
+        } ;
 
         my $all_1 = {
                 $NUMBER_100 => q{},
@@ -5982,105 +7131,131 @@ sub tests_clean_cache_2 {
 
 
 
-	ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache_2: ' ) ;
+        ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache_2: ' ) ;
 
-	ok(   -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 after' );
-	return ;
+        ok(   -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 after' );
+
+	note( 'Leaving  tests_clean_cache_2()' ) ;
+        return ;
 }
 
 
 
 sub tests_mkpath {
+	note( 'Entering tests_mkpath()' ) ;
 
-	ok( 1 == 1, 'tests_mkpath: 1 == 1' ) ;
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'mkpath: mkpath W/tmp/tests/' ) ;
+	
+        SKIP: {
+                skip( 'Tests only for Unix', 10   ) if ( 'MSWin32' eq $OSNAME ) ;
+                my $long_path_unix = '123456789/' x 30 ;
+                ok( ( -d "W/tmp/tests/long/$long_path_unix" or  mkpath( "W/tmp/tests/long/$long_path_unix" ) ), 'mkpath: mkpath 300 char' ) ;
+		ok( -d "W/tmp/tests/long/$long_path_unix", 'mkpath: mkpath > 300 char verified' ) ;
+                ok( ( -d "W/tmp/tests/long/$long_path_unix" and rmtree( 'W/tmp/tests/long/' ) ), 'mkpath: rmtree 300 char' ) ;
+		ok( ! -d "W/tmp/tests/long/$long_path_unix", 'mkpath: rmtree 300 char verified' ) ;
+		
+		ok( ( -d 'W/tmp/tests/trailing_dots...' or  mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ;
+		ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ;
+		ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ;
+		ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ;
 
-	SKIP: {
-		skip( 'Tests only for Unix', 2   ) if ( 'MSWin32' eq $OSNAME ) ;
-		my $long_path_unix = '123456789/' x 30 ;
-		ok( (-d "W/tmp/tests/long/$long_path_unix" or  mkpath( "W/tmp/tests/long/$long_path_unix" ) ), 'tests_mkpath: mkpath > 300 char' ) ;
-		ok( (-d "W/tmp/tests/long/$long_path_unix" and rmtree( 'W/tmp/tests/long/' ) ), 'tests_mkpath: rmtree > 300 char' ) ;
+		eval { ok( 1 / 0, 'mkpath: divide by 0' ) ; } or ok( 1, 'mkpath: can not divide by 0' ) ;
+		ok( 1, 'mkpath: still alive' ) ;
         } ;
 
-	SKIP: {
-		skip( 'Tests only for MSWin32', 6  ) if ( 'MSWin32' ne $OSNAME ) ;
-		my $long_path_2_prefix =  "$tmpdir\\imapsync_tests" || '\\\?\\E:\\TEMP\\imapsync_tests'  ;
-		myprint( "long_path_2_prefix: $long_path_2_prefix\n"  ) ;
+        SKIP: {
+                skip( 'Tests only for MSWin32', 13  ) if ( 'MSWin32' ne $OSNAME ) ;
+                my $long_path_2_prefix =  "$tmpdir\\imapsync_tests" || '\\\?\\E:\\TEMP\\imapsync_tests'  ;
+                myprint( "long_path_2_prefix: $long_path_2_prefix\n"  ) ;
 
-		my $long_path_2   = $long_path_2_prefix . '\\' . '123456789\\' x 10 . 'END' ;
-		my $long_path_300 = $long_path_2_prefix . '\\' . '123456789\\' x 30 . 'END' ;
+                my $long_path_100   = $long_path_2_prefix . '\\' . '123456789\\' x 10 . 'END' ;
+                my $long_path_300 = $long_path_2_prefix . '\\' . '123456789\\' x 30 . 'END' ;
 
-		myprint( "$long_path_2\n"  ) ;
+                #myprint( "$long_path_100\n"  ) ;
 
-		#ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'tests_mkpath: rmtree > 200 char' ) ;
-		#ok( ( -d $long_path_2_prefix or mkpath( "\\\\\?\\E:\\\\TEMP\\imapsync_tests" ) ), 'tests_mkpath: -d  small path 1' ) ;
+                ok( ( -d $long_path_2_prefix or mkpath( $long_path_2_prefix ) ), 'mkpath: -d mkpath small path' ) ;
+                ok( ( -d $long_path_2_prefix ), 'mkpath: -d mkpath small path done' ) ;
+                ok( ( -d $long_path_100        or mkpath( $long_path_100 ) ),        'mkpath: mkpath > 100 char' ) ;
+                ok( ( -d $long_path_100 ), 'mkpath: -d mkpath > 200 char done' ) ;
+                ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'mkpath: rmtree > 100 char' ) ;
+                ok( (! -d $long_path_2_prefix ), 'mkpath: ! -d rmtree done' ) ;
 
-		ok( ( -d $long_path_2_prefix or mkpath( $long_path_2_prefix ) ), 'tests_mkpath: -d mkpath small path' ) ;
-		ok( ( -d $long_path_2_prefix ), 'tests_mkpath: -d mkpath small path done' ) ;
-		ok( ( -d $long_path_2        or mkpath( $long_path_2 ) ),        'tests_mkpath: mkpath > 200 char' ) ;
-		ok( ( -d $long_path_2 ), 'tests_mkpath: -d mkpath > 200 char done' ) ;
-		ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'tests_mkpath: rmtree > 200 char' ) ;
-		ok( (! -d $long_path_2_prefix ), 'tests_mkpath: ! -d rmtree done' ) ;
+                # Without the eval the following mkpath 300 just kill the whole process without a whisper
+                #myprint( "$long_path_300\n"  ) ;
+                eval { ok( ( -d $long_path_300 or mkpath( $long_path_300 ) ),  'mkpath: create a path with 300 characters' ) ; } 
+			or ok( 1, 'mkpath: can not create a path with 300 characters' ) ;
+                ok( ( ( ! -d $long_path_300 ) or -d $long_path_300 and rmtree( $long_path_300 ) ), 'mkpath: rmtree the 300 character path' ) ;
+		ok( 1, 'mkpath: still alive' ) ;
 
-		myprint( "$long_path_300\n"  ) ;
-		# This one just kill the whole process without a whisper:
-		#ok( ( -d $long_path_300        or mkpath( $long_path_300 ) ),        'tests_mkpath: mkpath fails > 300 char' ) ;
-		#ok( ( -d $long_path_300 and rmtree( $long_path_300 ) ), 'tests_mkpath: rmtree \ > 300 char' ) ;
-	} ;
+		ok( ( -d 'W/tmp/tests/trailing_dots...' or  mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ;
+		ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ;
+		ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ;
+		ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ;
+		
+		
+        } ;
 
-	return 1 ;
+	note( 'Leaving  tests_mkpath()' ) ;
+	# Keep this because of the eval used by the caller (failed badly?)
+        return 1 ;
 }
 
 sub tests_touch {
+	note( 'Entering tests_touch()' ) ;
 
-	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'tests_touch: mkpath W/tmp/tests/' ) ;
-	ok( 1 == touch( 'W/tmp/tests/lala'), 'tests_touch: W/tmp/tests/lala') ;
-	ok( 1 == touch( 'W/tmp/tests/\y'), 'tests_touch: W/tmp/tests/\y') ;
-	ok( 0 == touch( '/no/no/no/aaa'), 'tests_touch: not /aaa') ;
-	ok( 1 == touch( 'W/tmp/tests/lili', 'W/tmp/tests/lolo'), 'tests_touch: 2 files') ;
-	ok( 0 == touch( 'W/tmp/tests/\y', '/no/no/aaa'), 'tests_touch: 2 files, 1 fails' ) ;
-	return ;
+        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'touch: mkpath W/tmp/tests/' ) ;
+        ok( 1 == touch( 'W/tmp/tests/lala'), 'touch: W/tmp/tests/lala') ;
+        ok( 1 == touch( 'W/tmp/tests/\y'), 'touch: W/tmp/tests/\y') ;
+        ok( 0 == touch( '/no/no/no/aaa'), 'touch: not /aaa') ;
+        ok( 1 == touch( 'W/tmp/tests/lili', 'W/tmp/tests/lolo'), 'touch: 2 files') ;
+        ok( 0 == touch( 'W/tmp/tests/\y', '/no/no/aaa'), 'touch: 2 files, 1 fails' ) ;
+
+	note( 'Leaving  tests_touch()' ) ;
+        return ;
 }
 
 
 sub touch {
-	my @files = @_ ;
-	my $failures = 0 ;
+        my @files = @_ ;
+        my $failures = 0 ;
 
-	foreach my $file ( @files ) {
-		my  $fh = IO::File->new ;
-		if ( $fh->open(">> $file" ) ) {
-			$fh->close ;
-		}else{
-                	myprint( "Could not open file $file in write/append mode\n"  ) ;
-                	$failures++ ;
+        foreach my $file ( @files ) {
+                my  $fh = IO::File->new ;
+                if ( $fh->open(">> $file" ) ) {
+                        $fh->close ;
+                }else{
+                        myprint( "Could not open file $file in write/append mode\n"  ) ;
+                        $failures++ ;
                 }
-	}
-	return( ! $failures );
+        }
+        return( ! $failures );
 }
 
 
 sub tests_tmpdir_has_colon_bug {
+	note( 'Entering tests_tmpdir_has_colon_bug()' ) ;
 
-	ok( 0 == tmpdir_has_colon_bug( q{} ),        'tmpdir_has_colon_bug: ' ) ;
-	ok( 0 == tmpdir_has_colon_bug( '/tmp' ),    'tmpdir_has_colon_bug: /tmp' ) ;
-	ok( 1 == tmpdir_has_colon_bug( 'C:' ),      'tmpdir_has_colon_bug: C:' ) ;
-	ok( 1 == tmpdir_has_colon_bug( 'C:\temp' ), 'tmpdir_has_colon_bug: C:\temp' ) ;
+        ok( 0 == tmpdir_has_colon_bug( q{} ),        'tmpdir_has_colon_bug: ' ) ;
+        ok( 0 == tmpdir_has_colon_bug( '/tmp' ),    'tmpdir_has_colon_bug: /tmp' ) ;
+        ok( 1 == tmpdir_has_colon_bug( 'C:' ),      'tmpdir_has_colon_bug: C:' ) ;
+        ok( 1 == tmpdir_has_colon_bug( 'C:\temp' ), 'tmpdir_has_colon_bug: C:\temp' ) ;
 
-        return( 0 ) ;
+	note( 'Leaving  tests_tmpdir_has_colon_bug()' ) ;
+        return ;
 }
 
 sub tmpdir_has_colon_bug {
-	my $path = shift ;
+        my $path = shift ;
 
-	my $path_filtered = filter_forbidden_characters( $path ) ;
-	if ( $path_filtered ne $path ) {
-        	( -d $path_filtered ) and myprint( "Path $path was previously mistakely changed to $path_filtered\n"  ) ;
-        	return( 1 ) ;
+        my $path_filtered = filter_forbidden_characters( $path ) ;
+        if ( $path_filtered ne $path ) {
+                ( -d $path_filtered ) and myprint( "Path $path was previously mistakely changed to $path_filtered\n"  ) ;
+                return( 1 ) ;
         }
         return( 0 ) ;
 }
@@ -6133,140 +7308,154 @@ sub tmpdir_fix_colon_bug {
 
 
 sub tests_cache_folder {
+	note( 'Entering tests_cache_folder()' ) ;
 
-	ok( '/path/fold1/fold2' eq cache_folder( q{}, '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( '/pa_th/fold1/fold2' eq cache_folder( q{}, '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( '/_p_a__th/fol_d1/fold2' eq cache_folder( q{}, '/>pp /path/fol_d1/fold2' ) ;
 
-	ok( 'D:/path/fold1/fold2' eq cache_folder( 'D:', '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( 'D:/pa_th/fold1/fold2' eq cache_folder( 'D:', '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( 'D:/_p_a__th/fol_d1/fold2' eq cache_folder( 'D:', '/>pp /path/fol_d1/fold2' ) ;
-	ok( '//' eq cache_folder( q{}, q{}, q{}, q{}), 'cache_folder:  -> //' ) ;
-	ok( '//_______' eq cache_folder( q{}, q{}, q{}, '*|?:"<>'), 'cache_folder: *|?:"<> -> //_______' ) ;
-	return ;
+        ok( '/path/fold1/fold2' eq cache_folder( q{}, '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( '/pa_th/fold1/fold2' eq cache_folder( q{}, '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( '/_p_a__th/fol_d1/fold2' eq cache_folder( q{}, '/>pp /path/fol_d1/fold2' ) ;
+
+        ok( 'D:/path/fold1/fold2' eq cache_folder( 'D:', '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( 'D:/pa_th/fold1/fold2' eq cache_folder( 'D:', '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( 'D:/_p_a__th/fol_d1/fold2' eq cache_folder( 'D:', '/>pp /path/fol_d1/fold2' ) ;
+        ok( '//' eq cache_folder( q{}, q{}, q{}, q{}), 'cache_folder:  -> //' ) ;
+        ok( '//_______' eq cache_folder( q{}, q{}, q{}, '*|?:"<>'), 'cache_folder: *|?:"<> -> //_______' ) ;
+
+	note( 'Leaving  tests_cache_folder()' ) ;
+        return ;
 }
 
 sub cache_folder {
-	my( $cache_base, $cache_dir, $h1_fold, $h2_fold ) = @_ ;
+        my( $cache_base, $cache_dir, $h1_fold, $h2_fold ) = @_ ;
 
-	my $sep_1 = $h1_sep || '/';
-	my $sep_2 = $h2_sep || '/';
+        my $sep_1 = $h1_sep || '/';
+        my $sep_2 = $h2_sep || '/';
 
-	#myprint( "$cache_dir h1_fold $h1_fold sep1 $sep_1 h2_fold $h2_fold sep2 $sep_2\n" ) ;
-	$h1_fold = convert_sep_to_slash( $h1_fold, $sep_1 ) ;
-	$h2_fold = convert_sep_to_slash( $h2_fold, $sep_2 ) ;
+        #myprint( "$cache_dir h1_fold $h1_fold sep1 $sep_1 h2_fold $h2_fold sep2 $sep_2\n" ) ;
+        $h1_fold = convert_sep_to_slash( $h1_fold, $sep_1 ) ;
+        $h2_fold = convert_sep_to_slash( $h2_fold, $sep_2 ) ;
 
         my $cache_folder = "$cache_base" . filter_forbidden_characters( "$cache_dir/$h1_fold/$h2_fold" ) ;
-	#myprint( "cache_folder [$cache_folder]\n"  ) ;
+        #myprint( "cache_folder [$cache_folder]\n"  ) ;
         return( $cache_folder ) ;
 }
 
 sub filter_forbidden_characters  {
-	my $string = shift ;
+        my $string = shift ;
+
+	if ( ! defined $string ) { return ; }
 
         if ( 'MSWin32' eq $OSNAME ) {
-        	# Move trailing whitespace to _ " a b /c d " -> " a b_/c d_"
-        	$string =~ s{\ (/|$)}{_$1}xg ;
+                # Move trailing whitespace to _ " a b /c d " -> " a b_/c d_"
+                $string =~ s{\ (/|$)}{_$1}xg ;
         }
         $string =~ s{[\Q*|?:"<>\E]}{_}xg ;
         #myprint( "[$string]\n"  ) ;
-	return( $string ) ;
+        return( $string ) ;
 }
 
 sub tests_filter_forbidden_characters  {
+	note( 'Entering tests_filter_forbidden_characters()' ) ;
 
-	ok( 'a_b' eq filter_forbidden_characters( 'a_b' ), 'filter_forbidden_characters: a_b -> a_b' ) ;
-	ok( 'a_b' eq filter_forbidden_characters( 'a*b' ), 'filter_forbidden_characters: a*b -> a_b' ) ;
-	ok( 'a_b' eq filter_forbidden_characters( 'a|b' ), 'filter_forbidden_characters: a|b -> a_b' ) ;
-	ok( 'a_b' eq filter_forbidden_characters( 'a?b' ), 'filter_forbidden_characters: a?b -> a_b' ) ;
-	ok( 'a_______b' eq filter_forbidden_characters( 'a*|?:"<>b' ), 'filter_forbidden_characters: a*|?:"<>b -> a_______b' ) ;
 
-	SKIP: {
-		skip( 'Not on MSWin32', 1 ) if ( 'MSWin32' eq $OSNAME ) ;
-		ok( ( 'a b ' eq filter_forbidden_characters( 'a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b "' ) ;
-	} ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a_b' ), 'filter_forbidden_characters: a_b -> a_b' ) ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a*b' ), 'filter_forbidden_characters: a*b -> a_b' ) ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a|b' ), 'filter_forbidden_characters: a|b -> a_b' ) ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a?b' ), 'filter_forbidden_characters: a?b -> a_b' ) ;
+        ok( 'a_______b' eq filter_forbidden_characters( 'a*|?:"<>b' ), 'filter_forbidden_characters: a*|?:"<>b -> a_______b' ) ;
 
-	SKIP: {
-		skip( 'Only on MSWin32', 2 ) if ( 'MSWin32' ne $OSNAME ) ;
-		ok( ( ' a b_' eq filter_forbidden_characters( ' a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b_"' ) ;
-		ok( ( ' a b_/ c d_' eq filter_forbidden_characters( ' a b / c d ' ) ), 'filter_forbidden_characters: " a b / c d " -> "a b_/ c d_"' ) ;
+        SKIP: {
+                skip( 'Not on MSWin32', 1 ) if ( 'MSWin32' eq $OSNAME ) ;
+                ok( ( 'a b ' eq filter_forbidden_characters( 'a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b "' ) ;
         } ;
 
-	return ;
+        SKIP: {
+                skip( 'Only on MSWin32', 2 ) if ( 'MSWin32' ne $OSNAME ) ;
+                ok( ( ' a b_' eq filter_forbidden_characters( ' a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b_"' ) ;
+                ok( ( ' a b_/ c d_' eq filter_forbidden_characters( ' a b / c d ' ) ), 'filter_forbidden_characters: " a b / c d " -> "a b_/ c d_"' ) ;
+        } ;
+
+	note( 'Leaving  tests_filter_forbidden_characters()' ) ;
+        return ;
 }
 
 sub convert_sep_to_slash {
-	my ( $folder, $sep ) = @_ ;
+        my ( $folder, $sep ) = @_ ;
 
-	$folder =~ s{\Q$sep\E}{/}xg ;
-	return( $folder ) ;
+        $folder =~ s{\Q$sep\E}{/}xg ;
+        return( $folder ) ;
 }
 
 sub tests_convert_sep_to_slash {
+	note( 'Entering tests_convert_sep_to_slash()' ) ;
 
-	ok(q{} eq convert_sep_to_slash(q{}, '/'), 'convert_sep_to_slash: no folder');
-	ok('INBOX' eq convert_sep_to_slash('INBOX', '/'), 'convert_sep_to_slash: INBOX');
-	ok('INBOX/foo' eq convert_sep_to_slash('INBOX/foo', '/'), 'convert_sep_to_slash: INBOX/foo');
-	ok('INBOX/foo' eq convert_sep_to_slash('INBOX_foo', '_'), 'convert_sep_to_slash: INBOX_foo');
-	ok('INBOX/foo/zob' eq convert_sep_to_slash('INBOX_foo_zob', '_'), 'convert_sep_to_slash: INBOX_foo_zob');
-	ok('INBOX/foo' eq convert_sep_to_slash('INBOX.foo', '.'), 'convert_sep_to_slash: INBOX.foo');
-	ok('INBOX/foo/hi' eq convert_sep_to_slash('INBOX.foo.hi', '.'), 'convert_sep_to_slash: INBOX.foo.hi');
-	return ;
+
+        ok(q{} eq convert_sep_to_slash(q{}, '/'), 'convert_sep_to_slash: no folder');
+        ok('INBOX' eq convert_sep_to_slash('INBOX', '/'), 'convert_sep_to_slash: INBOX');
+        ok('INBOX/foo' eq convert_sep_to_slash('INBOX/foo', '/'), 'convert_sep_to_slash: INBOX/foo');
+        ok('INBOX/foo' eq convert_sep_to_slash('INBOX_foo', '_'), 'convert_sep_to_slash: INBOX_foo');
+        ok('INBOX/foo/zob' eq convert_sep_to_slash('INBOX_foo_zob', '_'), 'convert_sep_to_slash: INBOX_foo_zob');
+        ok('INBOX/foo' eq convert_sep_to_slash('INBOX.foo', '.'), 'convert_sep_to_slash: INBOX.foo');
+        ok('INBOX/foo/hi' eq convert_sep_to_slash('INBOX.foo.hi', '.'), 'convert_sep_to_slash: INBOX.foo.hi');
+
+	note( 'Leaving  tests_convert_sep_to_slash()' ) ;
+        return ;
 }
 
 
 sub tests_regexmess {
+	note( 'Entering tests_regexmess()' ) ;
 
-	ok( 'blabla' eq regexmess( 'blabla' ), 'regexmess, no regexmess, nothing to do' ) ;
+        ok( 'blabla' eq regexmess( 'blabla' ), 'regexmess, no regexmess, nothing to do' ) ;
 
-	@regexmess = ( 'lalala' ) ;
-	ok( not( defined regexmess( 'popopo' ) ), 'regexmess, bad regex lalala' ) ;
+        @regexmess = ( 'lalala' ) ;
+        ok( not( defined regexmess( 'popopo' ) ), 'regexmess, bad regex lalala' ) ;
 
-	@regexmess = ( 's/p/Z/g' ) ;
-	ok( 'ZoZoZo' eq regexmess( 'popopo' ), 'regexmess, s/p/Z/g' ) ;
+        @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{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(          q{}
-	eq regexmess(q{}),
-	'From mbox 1 add colon blank');
+        @regexmess = ( 's{\AFrom\ }{From:}gxms' ) ;
+        ok(          q{}
+        eq regexmess(q{}),
+        'From mbox 1 add colon blank');
 
-	ok(          'From:'
-	eq regexmess('From '),
-	'From mbox 2 add colo');
+        ok(          'From:'
+        eq regexmess('From '),
+        'From mbox 2 add colo');
 
-	ok(          "\n" . 'From '
-	eq regexmess("\n" . 'From '),
-	'From mbox 3 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') ;
+        ok(          "From: zzz\n" . 'From '
+        eq regexmess("From  zzz\n" . 'From '),
+        'From mbox 4 add colo') ;
 
-	@regexmess = ( 's{\AFrom\ [^\n]*(\n)?}{}gxms' ) ;
-	ok(          q{}
-	eq regexmess(q{}),
-	'From mbox 1 remove, blank');
+        @regexmess = ( 's{\AFrom\ [^\n]*(\n)?}{}gxms' ) ;
+        ok(          q{}
+        eq regexmess(q{}),
+        'From mbox 1 remove, blank');
 
-	ok(          q{}
-	eq regexmess('From '),
-	'From mbox 2 remove');
+        ok(          q{}
+        eq regexmess('From '),
+        'From mbox 2 remove');
 
-	ok(          "\n" . 'From '
-	eq regexmess("\n" . 'From '),
-	'From mbox 3 remove');
+        ok(          "\n" . 'From '
+        eq regexmess("\n" . 'From '),
+        'From mbox 3 remove');
 
-	#myprint( "[", regexmess("From  zzz\n" . 'From '), "]" ) ;
-	ok(          q{}            . 'From '
-	eq regexmess("From  zzz\n" . 'From '),
-	'From mbox 4 remove');
+        #myprint( "[", regexmess("From  zzz\n" . 'From '), "]" ) ;
+        ok(          q{}            . 'From '
+        eq regexmess("From  zzz\n" . 'From '),
+        'From mbox 4 remove');
 
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6274,7 +7463,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 From  zzz
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6287,7 +7476,7 @@ EOM
 
 
 @regexmess = ( 's{\A((?:[^\n]+\n)+|)^Disposition-Notification-To:[^\n]*\n(\r?\n|.*\n\r?\n)}{$1$2}xms' ) ; # SUPER SUPER BEST!
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6295,7 +7484,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Disposition-Notification-To: Gilles LAMIRAL 
@@ -6304,10 +7493,10 @@ From:
 Hello,
 Bye.
 EOM
-	),
-	'regexmess: 1 Delete header Disposition-Notification-To:');
+        ),
+        'regexmess: 1 Delete header Disposition-Notification-To:');
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6315,7 +7504,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6325,9 +7514,9 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 2 Delete header Disposition-Notification-To:');
+        'regexmess: 2 Delete header Disposition-Notification-To:');
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6335,7 +7524,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Disposition-Notification-To: Gilles LAMIRAL 
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6345,9 +7534,9 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 3 Delete header Disposition-Notification-To:');
+        'regexmess: 3 Delete header Disposition-Notification-To:');
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6355,7 +7544,7 @@ From:
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Disposition-Notification-To: Gilles LAMIRAL 
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6365,10 +7554,10 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 4 Delete header Disposition-Notification-To:');
+        'regexmess: 4 Delete header Disposition-Notification-To:');
 
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6376,7 +7565,7 @@ From:
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6385,7 +7574,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 5 Delete header Disposition-Notification-To:');
+        'regexmess: 5 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6397,7 +7586,7 @@ Hello,
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6407,7 +7596,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 6 Delete header Disposition-Notification-To:');
+        'regexmess: 6 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6419,7 +7608,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6430,7 +7619,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 7 Delete header Disposition-Notification-To:');
+        'regexmess: 7 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6441,7 +7630,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6450,7 +7639,7 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 8 Delete header Disposition-Notification-To:');
+        'regexmess: 8 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6462,7 +7651,7 @@ Hello,
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6472,7 +7661,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 9 Delete header Disposition-Notification-To:');
+        'regexmess: 9 Delete header Disposition-Notification-To:');
 
 
 
@@ -6487,7 +7676,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6499,7 +7688,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 10 Delete header Disposition-Notification-To:');
+        'regexmess: 10 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6512,7 +7701,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6524,7 +7713,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 11 Delete header Disposition-Notification-To:');
+        'regexmess: 11 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6539,7 +7728,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6553,7 +7742,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 12 Delete header Disposition-Notification-To:');
+        'regexmess: 12 Delete header Disposition-Notification-To:');
 
 
 @regexmess = ( 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' ) ; # BAD!
@@ -6573,7 +7762,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6587,7 +7776,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 13 Delete header Disposition-Notification-To:');
+        'regexmess: 13 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6603,7 +7792,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Disposition-Notification-To: Gilles LAMIRAL 
@@ -6618,7 +7807,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 14 Delete header Disposition-Notification-To:');
+        'regexmess: 14 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6630,7 +7819,7 @@ Hello,
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Disposition-Notification-To: Gilles LAMIRAL 
@@ -6641,7 +7830,7 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 15 Delete header Disposition-Notification-To:');
+        'regexmess: 15 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6654,7 +7843,7 @@ Hello,
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6665,7 +7854,7 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 16 Delete header Disposition-Notification-To:');
+        'regexmess: 16 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6677,7 +7866,7 @@ Hello,
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Disposition-Notification-To: Gilles LAMIRAL 
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6688,76 +7877,78 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 17 Delete header Disposition-Notification-To:');
+        'regexmess: 17 Delete header Disposition-Notification-To:');
 
 
 
 # regex to play with Date: from the FAQ
 #@regexmess = 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}gxms'
 
-return ;
+	note( 'Leaving  tests_regexmess()' ) ;
+	return ;
 
 }
 
 sub regexmess {
-	my ( $string ) = @_ ;
-	foreach my $regexmess ( @regexmess ) {
-		$debug and myprint( "eval \$string =~ $regexmess\n"  ) ;
-		my $ret = eval "\$string =~ $regexmess ; 1" ;
+        my ( $string ) = @_ ;
+        foreach my $regexmess ( @regexmess ) {
+                $debug and myprint( "eval \$string =~ $regexmess\n"  ) ;
+                my $ret = eval "\$string =~ $regexmess ; 1" ;
                 #myprint( "eval [$ret]\n"  ) ;
-                if ( ( not $ret ) or $@ ) {
-			myprint( "Error: eval regexmess '$regexmess': $@"  ) ;
+                if ( ( not $ret ) or $EVAL_ERROR ) {
+                        myprint( "Error: eval regexmess '$regexmess': $EVAL_ERROR"  ) ;
                         return( undef ) ;
                 }
-	}
+        }
         $debug and myprint( "$string\n" ) ;
-	return( $string ) ;
+        return( $string ) ;
 }
 
 
 sub tests_skipmess {
+	note( 'Entering tests_skipmess()' ) ;
 
-	ok( not( defined skipmess( 'blabla' ) ), 'skipmess, no skipmess, no skip' ) ;
+        ok( not( defined skipmess( 'blabla' ) ), 'skipmess, no skipmess, no skip' ) ;
 
-	@skipmess = ('[') ;
-	ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex [' ) ;
+        @skipmess = ('[') ;
+        ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex [' ) ;
 
-	@skipmess = ('lalala') ;
-	ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex lalala' ) ;
+        @skipmess = ('lalala') ;
+        ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex lalala' ) ;
 
-	@skipmess = ('/popopo/') ;
-	ok( 1 == skipmess( 'popopo' ), 'skipmess, popopo match regex /popopo/' ) ;
+        @skipmess = ('/popopo/') ;
+        ok( 1 == skipmess( 'popopo' ), 'skipmess, popopo match regex /popopo/' ) ;
 
-	@skipmess = ('/popopo/') ;
-	ok( 0 == skipmess( 'rrrrrr' ), 'skipmess, rrrrrr does not match regex /popopo/' ) ;
+        @skipmess = ('/popopo/') ;
+        ok( 0 == skipmess( 'rrrrrr' ), 'skipmess, rrrrrr does not match regex /popopo/' ) ;
 
-	@skipmess = ('m{^$}') ;
-	ok( 1 == skipmess( q{} ),    'skipmess: empty string yes' ) ;
-	ok( 0 == skipmess( 'Hi!' ), 'skipmess: empty string no' ) ;
+        @skipmess = ('m{^$}') ;
+        ok( 1 == skipmess( q{} ),    'skipmess: empty string yes' ) ;
+        ok( 0 == skipmess( 'Hi!' ), 'skipmess: empty string no' ) ;
 
-	@skipmess = ('m{i}') ;
-	ok( 1 == skipmess( 'Hi!' ),  'skipmess: i string yes' ) ;
-	ok( 0 == skipmess( 'Bye!' ), 'skipmess: i string no' ) ;
+        @skipmess = ('m{i}') ;
+        ok( 1 == skipmess( 'Hi!' ),  'skipmess: i string yes' ) ;
+        ok( 0 == skipmess( 'Bye!' ), 'skipmess: i string no' ) ;
 
-	@skipmess = ('m{[\x80-\xff]}') ;
-	ok( 0 == skipmess( 'Hi!' ),  'skipmess: i 8bit no' ) ;
-	ok( 1 == skipmess( "\xff" ), 'skipmess: \xff 8bit yes' ) ;
+        @skipmess = ('m{[\x80-\xff]}') ;
+        ok( 0 == skipmess( 'Hi!' ),  'skipmess: i 8bit no' ) ;
+        ok( 1 == skipmess( "\xff" ), 'skipmess: \xff 8bit yes' ) ;
 
-	@skipmess = ('m{A}', 'm{B}') ;
-	ok( 0 == skipmess( 'Hi!' ),  'skipmess: A or B no' ) ;
-	ok( 0 == skipmess( 'lala' ), 'skipmess: A or B no' ) ;
-	ok( 0 == skipmess( "\xff" ), 'skipmess: A or B no' ) ;
-	ok( 1 == skipmess( 'AB' ),   'skipmess: A or B yes' ) ;
-	ok( 1 == skipmess( 'BA' ),   'skipmess: A or B yes' ) ;
-	ok( 1 == skipmess( 'AA' ),   'skipmess: A or B yes' ) ;
-	ok( 1 == skipmess( 'Ok Bye' ), 'skipmess: A or B yes' ) ;
+        @skipmess = ('m{A}', 'm{B}') ;
+        ok( 0 == skipmess( 'Hi!' ),  'skipmess: A or B no' ) ;
+        ok( 0 == skipmess( 'lala' ), 'skipmess: A or B no' ) ;
+        ok( 0 == skipmess( "\xff" ), 'skipmess: A or B no' ) ;
+        ok( 1 == skipmess( 'AB' ),   'skipmess: A or B yes' ) ;
+        ok( 1 == skipmess( 'BA' ),   'skipmess: A or B yes' ) ;
+        ok( 1 == skipmess( 'AA' ),   'skipmess: A or B yes' ) ;
+        ok( 1 == skipmess( 'Ok Bye' ), 'skipmess: A or B yes' ) ;
 
 
-	@skipmess = ( 'm#\A((?:[^\n]+\n)+|)^Content-Type: Message/Partial;[^\n]*\n(?:\n|.*\n\n)#ism' ) ; # SUPER BEST!
+        @skipmess = ( 'm#\A((?:[^\n]+\n)+|)^Content-Type: Message/Partial;[^\n]*\n(?:\n|.*\n\n)#ism' ) ; # SUPER BEST!
 
 
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Content-Type: Message/Partial; blabla
@@ -6769,7 +7960,7 @@ EOM
 ),
     'skipmess: 1 match Content-Type: Message/Partial' ) ;
 
-	ok( 0 == skipmess(
+        ok( 0 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6781,7 +7972,7 @@ EOM
     'skipmess: 2 not match Content-Type: Message/Partial' ) ;
 
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6793,7 +7984,7 @@ EOM
 ),
     'skipmess: 3 match Content-Type: Message/Partial' ) ;
 
-	ok( 0 == skipmess(
+        ok( 0 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6806,7 +7997,7 @@ EOM
     'skipmess: 4 not match Content-Type: Message/Partial' ) ;
 
 
-	ok( 0 == skipmess(
+        ok( 0 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6820,7 +8011,7 @@ EOM
     'skipmess: 5 not match Content-Type: Message/Partial' ) ;
 
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Content-Type: Message/Partial; blabla
@@ -6835,7 +8026,7 @@ EOM
 ),
     'skipmess: 6 match Content-Type: Message/Partial' ) ;
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Content-Type: Message/Partial;
@@ -6847,14 +8038,14 @@ EOM
 ),
     'skipmess: 7 match Content-Type: Message/Partial' ) ;
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Wed, 2 Jul 2014 02:26:40 +0000
 MIME-Version: 1.0
 Content-Type: message/partial;
-	id="TAN_U_P<1404267997.00007489ed17>";
-	number=3;
-	total=3
+        id="TAN_U_P<1404267997.00007489ed17>";
+        number=3;
+        total=3
 
 6HQ6Hh3CdXj77qEGixerQ6zHx0OnQ/Cf5On4W0Y6vtU2crABZQtD46Hx1EOh8dDz4+OnTr1G
 
@@ -6898,7 +8089,7 @@ Content-Type: message/partial;
 
 test: aethaecohngiexao
 EOM
-. "lalala\n" x 3000000
+. "lalala\n" x 3_000_000
 ),
     'skipmess: 10 match Content-Type: Message/Partial' ) ;
 
@@ -6909,7 +8100,7 @@ From: gilles@lamiral.info (Gilles LAMIRAL)
 
 test: aethaecohngiexao
 EOM
-. "lalala\n" x 3000000
+. "lalala\n" x 3_000_000
 ),
     'skipmess: 11 match Content-Type: Message/Partial' ) ;
 
@@ -6925,69 +8116,75 @@ Content-Type: text/plain; charset=iso-8859-1\r
 Content-Transfer-Encoding: 7bit\r
 \r
 EOM
-. qq{!#"$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefg\r\n } x 32730
+. qq{!#"d%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefg\r\n } x 32_730
 ),
     'skipmess: 12 not match Content-Type: Message/Partial' ) ;
         # Complex regular subexpression recursion limit (32766) exceeded with more lines
         # exit;
-	return ;
+
+	note( 'Leaving  tests_skipmess()' ) ;
+        return ;
 }
 
 sub skipmess {
-	my ( $string ) = @_ ;
-	my $match ;
-	#myprint( "$string\n"  ) ;
-	foreach my $skipmess ( @skipmess ) {
-		$debug and myprint( "eval \$match = \$string =~ $skipmess\n"  ) ;
-		my $ret = eval "\$match = \$string =~ $skipmess ; 1"  ;
-		#myprint( "eval [$ret]\n"  ) ;
-		$debug and myprint( "match [$match]\n"  ) ;
-		if ( ( not $ret ) or $@ ) {
-			myprint( "Error: eval skipmess '$skipmess': $@"  ) ;
-			return( undef ) ;
-		}
-		return( $match ) if ( $match ) ;
-	}
-	return( $match ) ;
+        my ( $string ) = @_ ;
+        my $match ;
+        #myprint( "$string\n"  ) ;
+        foreach my $skipmess ( @skipmess ) {
+                $debug and myprint( "eval \$match = \$string =~ $skipmess\n"  ) ;
+                my $ret = eval "\$match = \$string =~ $skipmess ; 1"  ;
+                #myprint( "eval [$ret]\n"  ) ;
+                $debug and myprint( "match [$match]\n"  ) ;
+                if ( ( not $ret ) or $EVAL_ERROR ) {
+                        myprint( "Error: eval skipmess '$skipmess': $EVAL_ERROR"  ) ;
+                        return( undef ) ;
+                }
+                return( $match ) if ( $match ) ;
+        }
+        return( $match ) ;
 }
 
 
 
 
 sub tests_bytes_display_string {
+	note( 'Entering tests_bytes_display_string()' ) ;
+
 
         is(    'NA', bytes_display_string(       ), 'bytes_display_string: no args => NA' ) ;
         is(    'NA', bytes_display_string( undef ), 'bytes_display_string: undef   => NA' ) ;
         is(    'NA', bytes_display_string( 'blabla' ), 'bytes_display_string: blabla   => NA' ) ;
-        
-	ok(    '0.000 KiB' eq bytes_display_string(       0 ), 'bytes_display_string:       0' ) ;
-	ok(    '0.001 KiB' eq bytes_display_string(       1 ), 'bytes_display_string:       1' ) ;
-	ok(    '0.010 KiB' eq bytes_display_string(      10 ), 'bytes_display_string:      10' ) ;
-	ok(    '1.000 MiB' eq bytes_display_string( 1048575 ), 'bytes_display_string: 1048575' ) ;
-	ok(    '1.000 MiB' eq bytes_display_string( 1048576 ), 'bytes_display_string: 1048576' ) ;
 
-	ok(    '1.000 GiB' eq bytes_display_string( 1073741823 ), 'bytes_display_string: 1073741823 ' ) ;
-	ok(    '1.000 GiB' eq bytes_display_string( 1073741824 ), 'bytes_display_string: 1073741824 ' ) ;
+        ok(    '0.000 KiB' eq bytes_display_string(       0 ), 'bytes_display_string:       0' ) ;
+        ok(    '0.001 KiB' eq bytes_display_string(       1 ), 'bytes_display_string:       1' ) ;
+        ok(    '0.010 KiB' eq bytes_display_string(      10 ), 'bytes_display_string:      10' ) ;
+        ok(    '1.000 MiB' eq bytes_display_string( 1_048_575 ), 'bytes_display_string: 1_048_575' ) ;
+        ok(    '1.000 MiB' eq bytes_display_string( 1_048_576 ), 'bytes_display_string: 1_048_576' ) ;
 
-	ok(    '1.000 TiB' eq bytes_display_string( 1099511627775 ), 'bytes_display_string: 1099511627775' ) ;
-	ok(    '1.000 TiB' eq bytes_display_string( 1099511627776 ), 'bytes_display_string: 1099511627776' ) ;
+        ok(    '1.000 GiB' eq bytes_display_string( 1_073_741_823 ), 'bytes_display_string: 1_073_741_823 ' ) ;
+        ok(    '1.000 GiB' eq bytes_display_string( 1_073_741_824 ), 'bytes_display_string: 1_073_741_824 ' ) ;
 
-	ok(    '1.000 PiB' eq bytes_display_string( 1125899906842623 ), 'bytes_display_string: 1125899906842623' ) ;
-	ok(    '1.000 PiB' eq bytes_display_string( 1125899906842624 ), 'bytes_display_string: 1125899906842624' ) ;
+        ok(    '1.000 TiB' eq bytes_display_string( 1_099_511_627_775 ), 'bytes_display_string: 1_099_511_627_775' ) ;
+        ok(    '1.000 TiB' eq bytes_display_string( 1_099_511_627_776 ), 'bytes_display_string: 1_099_511_627_776' ) ;
 
-	ok( '1024.000 PiB' eq bytes_display_string( 1152921504606846975 ), 'bytes_display_string: 1152921504606846975' ) ;
-	ok( '1024.000 PiB' eq bytes_display_string( 1152921504606846976 ), 'bytes_display_string: 1152921504606846976' ) ;
+        ok(    '1.000 PiB' eq bytes_display_string( 1_125_899_906_842_623 ), 'bytes_display_string: 1_125_899_906_842_623' ) ;
+        ok(    '1.000 PiB' eq bytes_display_string( 1_125_899_906_842_624 ), 'bytes_display_string: 1_125_899_906_842_624' ) ;
 
-	ok( '1048576.000 PiB' eq bytes_display_string( 1180591620717411303424 ), 'bytes_display_string: 1180591620717411303424' ) ;
+        ok( '1024.000 PiB' eq bytes_display_string( 1_152_921_504_606_846_975 ), 'bytes_display_string: 1_152_921_504_606_846_975' ) ;
+        ok( '1024.000 PiB' eq bytes_display_string( 1_152_921_504_606_846_976 ), 'bytes_display_string: 1_152_921_504_606_846_976' ) ;
 
-        #myprint(  bytes_display_string( 1180591620717411303424 ), "\n"  ) ;
-	return ;
+        ok( '1048576.000 PiB' eq bytes_display_string( 1_180_591_620_717_411_303_424 ), 'bytes_display_string: 1_180_591_620_717_411_303_424' ) ;
+
+        #myprint(  bytes_display_string( 1_180_591_620_717_411_303_424 ), "\n"  ) ;
+	note( 'Leaving  tests_bytes_display_string()' ) ;
+
+        return ;
 }
 
 sub bytes_display_string {
-	my ( $bytes ) = @_ ;
+        my ( $bytes ) = @_ ;
 
-	my $readable_value = q{} ;
+        my $readable_value = q{} ;
 
         if ( ! defined( $bytes ) ) {
                 return( 'NA' ) ;
@@ -6997,71 +8194,69 @@ sub bytes_display_string {
                 return( 'NA' ) ;
         }
 
-        
 
-	SWITCH: {
-        	if ( abs( $bytes ) < ( 1000 * $KIBI ) ) {
-        		$readable_value = mysprintf( '%.3f KiB', $bytes / $KIBI) ;
-                	last SWITCH ;
-        	}
-        	if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI ) ) {
-        		$readable_value = mysprintf( '%.3f MiB', $bytes / ($KIBI * $KIBI) ) ;
-        	        last SWITCH ;
-        	}
-        	if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI) ) {
-			$readable_value = mysprintf( '%.3f GiB', $bytes / ($KIBI * $KIBI * $KIBI) ) ;
-        	        last SWITCH ;
-        	}
-        	if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI * $KIBI) ) {
-			$readable_value = mysprintf( '%.3f TiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI) ) ;
-        	        last SWITCH ;
-        	} else {
-			$readable_value = mysprintf( '%.3f PiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI * $KIBI) ) ;
-        	}
-		# if you have exabytes (EiB) of email to transfer, you have too much email!
-	}
+
+        SWITCH: {
+                if ( abs( $bytes ) < ( 1000 * $KIBI ) ) {
+                        $readable_value = mysprintf( '%.3f KiB', $bytes / $KIBI) ;
+                        last SWITCH ;
+                }
+                if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI ) ) {
+                        $readable_value = mysprintf( '%.3f MiB', $bytes / ($KIBI * $KIBI) ) ;
+                        last SWITCH ;
+                }
+                if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI) ) {
+                        $readable_value = mysprintf( '%.3f GiB', $bytes / ($KIBI * $KIBI * $KIBI) ) ;
+                        last SWITCH ;
+                }
+                if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI * $KIBI) ) {
+                        $readable_value = mysprintf( '%.3f TiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI) ) ;
+                        last SWITCH ;
+                } else {
+                        $readable_value = mysprintf( '%.3f PiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI * $KIBI) ) ;
+                }
+                # if you have exabytes (EiB) of email to transfer, you have too much email!
+        }
         #myprint( "$bytes = $readable_value\n"  ) ;
         return( $readable_value ) ;
 }
 
 sub stats {
-        my $sync_loc = shift ;
+        my $mysync = shift ;
 
-        if ( ! $sync_loc->{stats} ) {
+        if ( ! $mysync->{stats} ) {
                 return ;
         }
-        
-	$timeend = time ;
-	my $timediff = $timeend - $sync_loc->{timestart} ;
 
-	my $timeend_str   = localtime $timeend ;
+        my $timeend = time ;
+        my $timediff = $timeend - $mysync->{timestart} ;
 
-	my $memory_consumption = 0 ;
+        my $timeend_str   = localtime $timeend ;
+
+        my $memory_consumption = 0 ;
         $memory_consumption = memory_consumption(  ) || 0 ;
-	my $memory_ratio = ($max_msg_size_in_bytes) ?
-		mysprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : 'NA' ;
+        my $memory_ratio = ($max_msg_size_in_bytes) ?
+                mysprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : 'NA' ;
 
-	my $host1_reconnect_count = $imap1->Reconnect_counter() || 0 ;
-	my $host2_reconnect_count = $imap2->Reconnect_counter() || 0 ;
 
-	myprint(  "++++ Statistics\n"  ) ;
-	myprint(  "Transfer started on               : $timestart_str\n"  ) ;
-	myprint(  "Transfer ended on                 : $timeend_str\n"  ) ;
-	myprintf( "Transfer time                     : %.1f sec\n", $timediff ) ;
-	myprint(  "Folders synced                    : $h1_folders_wanted_ct/$h1_folders_wanted_nb synced\n"  ) ;
-	myprint(  "Messages transferred              : $nb_msg_transferred "  ) ;
-	myprint(  "(could be $nb_msg_skipped_dry_mode without dry mode)" ) if ( $dry ) ;
-	myprint(  "\n" ) ;
-	myprint(  "Messages skipped                  : $nb_msg_skipped\n"  ) ;
-	myprint(  "Messages found duplicate on host1 : $h1_nb_msg_duplicate\n"  ) ;
-	myprint(  "Messages found duplicate on host2 : $h2_nb_msg_duplicate\n"  ) ;
-	myprint(  "Messages void (noheader) on host1 : $h1_nb_msg_noheader\n"  ) ;
-	myprint(  "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n"  ) ;
-	myprint(  "Messages deleted on host1         : $h1_nb_msg_deleted\n"  ) ;
-	myprint(  "Messages deleted on host2         : $h2_nb_msg_deleted\n"  ) ;
+        myprint(  "++++ Statistics\n"  ) ;
+        myprint(  "Transfer started on               : $timestart_str\n"  ) ;
+        myprint(  "Transfer ended on                 : $timeend_str\n"  ) ;
+        myprintf( "Transfer time                     : %.1f sec\n", $timediff ) ;
+        myprint(  "Folders synced                    : $h1_folders_wanted_ct/$h1_folders_wanted_nb synced\n"  ) ;
+        myprint(  "Messages transferred              : $mysync->{nb_msg_transferred} "  ) ;
+        myprint(  "(could be $nb_msg_skipped_dry_mode without dry mode)" ) if ( $mysync->{dry} ) ;
+        myprint(  "\n" ) ;
+        myprint(  "Messages skipped                  : $nb_msg_skipped\n"  ) ;
+        myprint(  "Messages found duplicate on host1 : $h1_nb_msg_duplicate\n"  ) ;
+        myprint(  "Messages found duplicate on host2 : $h2_nb_msg_duplicate\n"  ) ;
+        myprint(  "Messages void (noheader) on host1 : $h1_nb_msg_noheader\n"  ) ;
+        myprint(  "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n"  ) ;
+        myprint(  "Messages deleted on host1         : $h1_nb_msg_deleted\n"  ) ;
+        myprint(  "Messages deleted on host2         : $h2_nb_msg_deleted\n"  ) ;
         myprintf( "Total bytes transferred           : %s (%s)\n",
-                $total_bytes_transferred,
-                bytes_display_string( $total_bytes_transferred ) ) ;
+                $mysync->{total_bytes_transferred},
+                bytes_display_string( $mysync->{total_bytes_transferred} ) ) ;
         myprintf( "Total bytes duplicate host1       : %s (%s)\n",
                 $h1_total_bytes_duplicate,
                 bytes_display_string( $h1_total_bytes_duplicate) ) ;
@@ -7074,62 +8269,62 @@ sub stats {
         myprintf( "Total bytes error                 : %s (%s)\n",
                 $total_bytes_error,
                 bytes_display_string( $total_bytes_error ) ) ;
-	$timediff ||= 1 ; # No division per 0
-	myprintf("Message rate                      : %.1f messages/s\n", $nb_msg_transferred / $timediff ) ;
-	myprintf("Average bandwidth rate            : %.1f KiB/s\n", $total_bytes_transferred / $KIBI / $timediff ) ;
-	#myprint(  "Reconnections to host1            : $host1_reconnect_count\n"  ) ;
-	#myprint(  "Reconnections to host2            : $host2_reconnect_count\n"  ) ;
-	myprintf("Memory consumption                : %.1f MiB\n", $memory_consumption / $KIBI / $KIBI ) ;
+        $timediff ||= 1 ; # No division per 0
+        myprintf("Message rate                      : %.1f messages/s\n", $mysync->{nb_msg_transferred} / $timediff ) ;
+        myprintf("Average bandwidth rate            : %.1f KiB/s\n", $mysync->{total_bytes_transferred} / $KIBI / $timediff ) ;
+        myprint( "Reconnections to host1            : $mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT}\n"  ) ;
+        myprint( "Reconnections to host2            : $mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT}\n"  ) ;
+        myprintf("Memory consumption                : %.1f MiB\n", $memory_consumption / $KIBI / $KIBI ) ;
         myprintf("Biggest message                   : %s bytes (%s)\n",
                 $max_msg_size_in_bytes,
                 bytes_display_string( $max_msg_size_in_bytes) ) ;
-	myprint(  "Memory/biggest message ratio      : $memory_ratio\n"  ) ;
+        myprint(  "Memory/biggest message ratio      : $memory_ratio\n"  ) ;
         if ( $foldersizesatend and $foldersizes ) {
-        
+
 
         my $nb_msg_start_diff = diff_or_NA( $h2_nb_msg_start, $h1_nb_msg_start ) ;
         my $bytes_start_diff  = diff_or_NA( $h2_bytes_start,  $h1_bytes_start  ) ;
-        
-	myprintf("Start difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_start_diff,
+
+        myprintf("Start difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_start_diff,
                                                         $bytes_start_diff,
                                                         bytes_display_string( $bytes_start_diff ) ) ;
 
         my $nb_msg_end_diff = diff_or_NA( $h2_nb_msg_end, $h1_nb_msg_end ) ;
         my $bytes_end_diff  = diff_or_NA( $h2_bytes_end,  $h1_bytes_end  ) ;
-        
-	myprintf("Final difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_end_diff,
+
+        myprintf("Final difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_end_diff,
                                                         $bytes_end_diff,
                                                         bytes_display_string( $bytes_end_diff ) ) ;
         }
-	myprint(  "Detected $sync->{nb_errors} errors\n\n"  ) ;
+        myprint(  "Detected $mysync->{nb_errors} errors\n\n"  ) ;
 
-	myprint(  $warn_release, "\n"  ) ;
-	myprint(  thank_author(  )  ) ;
-	return ;
+        myprint(  $warn_release, "\n"  ) ;
+        myprint(  homepage(  ), "\n"  ) ;
+        return ;
 }
 
 sub diff_or_NA {
         my( $n1, $n2 ) = @ARG ;
-        
+
         if ( not defined $n1 or not defined $n2 ) {
                 return 'NA' ;
         }
-        
-        if ( not match_number( $n1 ) 
+
+        if ( not match_number( $n1 )
           or not match_number( $n2 ) ) {
                  return 'NA' ;
         }
-        
+
         return( $n1 - $n2 ) ;
 }
 
 sub match_number {
         my $n = shift @ARG ;
-        
+
         if ( not defined $n ) {
                 return 0 ;
         }
-        if ( $n =~  /[0-9]+\.?[0-9]?/ ) {
+        if ( $n =~  /[0-9]+\.?[0-9]?/x ) {
                 return 1 ;
         }
         else {
@@ -7139,6 +8334,8 @@ sub match_number {
 
 
 sub tests_match_number {
+	note( 'Entering tests_match_number()' ) ;
+
 
         is( 0, match_number(   ),        'match_number: no parameters => 0' ) ;
         is( 0, match_number( undef ),    'match_number:         undef => 0' ) ;
@@ -7147,12 +8344,16 @@ sub tests_match_number {
         is( 1, match_number( 1 ),        'match_number:             1 => 1' ) ;
         is( 1, match_number( 1.0 ),      'match_number:           1.0 => 1' ) ;
         is( 1, match_number( 0.0 ),      'match_number:           0.0 => 1' ) ;
+
+	note( 'Leaving  tests_match_number()' ) ;
         return ;
 }
 
 
 
 sub tests_diff_or_NA {
+	note( 'Entering tests_diff_or_NA()' ) ;
+
 
         is( 'NA', diff_or_NA(  ),             'diff_or_NA: no parameters => NA' ) ;
         is( 'NA', diff_or_NA( undef ),        'diff_or_NA: undef         => NA' ) ;
@@ -7167,127 +8368,120 @@ sub tests_diff_or_NA {
         is( 0, diff_or_NA( 1.0, 1 ),          'diff_or_NA: 1.0    1      =>  0' ) ;
         is( 1, diff_or_NA( 1.0, 0 ),          'diff_or_NA: 1.0    0      =>  1' ) ;
         is( -1, diff_or_NA( 0, 1.0 ),         'diff_or_NA: 0      1.0    => -1' ) ;
+
+	note( 'Leaving  tests_diff_or_NA()' ) ;
         return ;
 }
 
-sub thank_author {
-	return( "Homepage: http://imapsync.lamiral.info/\n" ) ;
+sub homepage {
+        return( 'Homepage: http://imapsync.lamiral.info/' ) ;
 }
 
 
 sub load_modules {
-
-	if ( $ssl1 or $ssl2 or $tls1 or $tls2) {
-        	# not yet a "use" statement
-        	require IO::Socket::SSL ;
-		if ( $sync->{inet4} ) {
-		        IO::Socket::SSL->import( 'inet4' ) ;
-		}
-		if ( $sync->{inet6} ) {
-		        IO::Socket::SSL->import( 'inet6' ) ;
-		}
+        if ( $sync->{ssl1}
+	  or $sync->{ssl2}
+	  or $sync->{tls1}
+	  or $sync->{tls2}) {
+                if ( $sync->{inet4} ) {
+                        IO::Socket::SSL->import( 'inet4' ) ;
+                }
+                if ( $sync->{inet6} ) {
+                        IO::Socket::SSL->import( 'inet6' ) ;
+                }
         }
-
-       if ( ( ( not( $password1 or $passfile1 ) )
-	   or (not ( $password2 or $passfile2 ) )
-            )
-	and ( not $help ) ) {
-        	# now a "use" statement
-        	#require Term::ReadKey ;
-        }
-
-	return ;
+        return ;
 }
 
 
 
 sub parse_header_msg {
-	my ( $imap, $m_uid, $s_heads, $s_fir, $side, $s_hash ) = @_ ;
+        my ( $imap, $m_uid, $s_heads, $s_fir, $side, $s_hash ) = @_ ;
 
-	my $head = $s_heads->{$m_uid} ;
-	my $headnum =  scalar keys  %{ $head }   ;
-	$debug and myprint( "$side uid $m_uid head nb pass one: ", $headnum, "\n"  ) ;
+        my $head = $s_heads->{$m_uid} ;
+        my $headnum =  scalar keys  %{ $head }   ;
+        $debug and myprint( "$side uid $m_uid head nb pass one: ", $headnum, "\n"  ) ;
 
-	if ( ( ! $headnum ) and ( $wholeheaderifneeded ) ){
-		myprint( "$side uid $m_uid no header by parse_headers so taking whole header with BODY.PEEK[HEADER]\n"  ) ;
-		$imap->fetch($m_uid, 'BODY.PEEK[HEADER]' ) ;
-		my $whole_header = $imap->_transaction_literals ;
+        if ( ( ! $headnum ) and ( $wholeheaderifneeded ) ){
+                myprint( "$side uid $m_uid no header by parse_headers so taking whole header with BODY.PEEK[HEADER]\n"  ) ;
+                $imap->fetch($m_uid, 'BODY.PEEK[HEADER]' ) ;
+                my $whole_header = $imap->_transaction_literals ;
 
                 #myprint( $whole_header ) ;
                 $head = decompose_header( $whole_header ) ;
 
                 $headnum =  scalar  keys  %{ $head }   ;
-	        $debug and myprint( "$side uid $m_uid head nb pass two: ", $headnum, "\n" ) ;
-	}
+                $debug and myprint( "$side uid $m_uid head nb pass two: ", $headnum, "\n" ) ;
+        }
 
         #myprint( Data::Dumper->Dump( [ $head, \%useheader ] )  ) ;
 
-	my $headstr ;
+        my $headstr ;
 
         $headstr = header_construct( $head, $side, $m_uid ) ;
 
-	if ( ( ! $headstr) and ( $addheader ) and ( $side eq 'Host1' ) ) {
-        	my $header = add_header( $m_uid ) ;
-		myprint( "Host1 uid $m_uid no header found so adding our own [$header]\n" ) ;
-		$headstr .= uc  $header  ;
-		$s_fir->{$m_uid}->{NO_HEADER} = 1;
-	}
+        if ( ( ! $headstr) and ( $addheader ) and ( $side eq 'Host1' ) ) {
+                my $header = add_header( $m_uid ) ;
+                myprint( "Host1 uid $m_uid no header found so adding our own [$header]\n" ) ;
+                $headstr .= uc  $header  ;
+                $s_fir->{$m_uid}->{NO_HEADER} = 1;
+        }
 
-	return if ( ! $headstr ) ;
+        return if ( ! $headstr ) ;
 
-	my $size  = $s_fir->{$m_uid}->{'RFC822.SIZE'} ;
-	my $flags = $s_fir->{$m_uid}->{'FLAGS'} ;
-	my $idate = $s_fir->{$m_uid}->{'INTERNALDATE'} ;
-	$size = length $headstr  unless ( $size ) ;
-	my $m_md5 = md5_base64( $headstr ) ;
-	$debug and myprint( "$side uid $m_uid sig $m_md5 size $size idate $idate\n"  ) ;
-	my $key ;
+        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 myprint( "$side uid $m_uid sig $m_md5 size $size idate $idate\n"  ) ;
+        my $key ;
         if ($skipsize) {
                 $key = "$m_md5";
         }
-	else {
+        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;
+        # 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;
 
-	return( 1 ) ;
+        return( 1 ) ;
 }
 
 sub header_construct {
 
-	my( $head, $side, $m_uid ) = @_ ;
+        my( $head, $side, $m_uid ) = @_ ;
 
         my $headstr ;
-	foreach my $h ( sort keys  %{ $head }  ) {
+        foreach my $h ( sort keys  %{ $head }  ) {
                 next if ( not ( exists $useheader{ uc  $h  } )
                       and ( not exists  $useheader{ 'ALL' } )
                 ) ;
-		foreach my $val ( sort @{$head->{$h}} ) {
+                foreach my $val ( sort @{$head->{$h}} ) {
 
                         my $H = header_line_normalize( $h, $val ) ;
 
-			# show stuff in debug mode
-			$debug and myprint( "$side uid $m_uid header [$H]", "\n"  ) ;
+                        # show stuff in debug mode
+                        $debug and myprint( "$side uid $m_uid header [$H]", "\n"  ) ;
 
-			if ($skipheader and $H =~ m/$skipheader/xi) {
-				$debug and myprint( "$side uid $m_uid skipping header [$H]\n"  ) ;
-				next ;
-			}
-			$headstr .= "$H" ;
-		}
-	}
-	return( $headstr ) ;
+                        if ($skipheader and $H =~ m/$skipheader/xi) {
+                                $debug and myprint( "$side uid $m_uid skipping header [$H]\n"  ) ;
+                                next ;
+                        }
+                        $headstr .= "$H" ;
+                }
+        }
+        return( $headstr ) ;
 }
 
 
 sub header_line_normalize {
-	my( $header_key,  $header_val ) = @_ ;
+        my( $header_key,  $header_val ) = @_ ;
 
         # no 8-bit data in headers !
         $header_val =~ s/[\x80-\xff]/X/xog;
@@ -7312,20 +8506,23 @@ sub header_line_normalize {
 
         my $header_line = uc "$header_key: $header_val" ;
 
-	return( $header_line ) ;
+        return( $header_line ) ;
 }
 
 sub tests_header_line_normalize {
+	note( 'Entering tests_header_line_normalize()' ) ;
 
-	ok( ': ' eq header_line_normalize( q{}, q{} ), 'header_line_normalize: empty args' ) ;
-	ok( 'HHH: VVV' eq header_line_normalize( 'hhh', 'vvv' ), 'header_line_normalize: hhh vvv ' ) ;
-	ok( 'HHH: VVV' eq header_line_normalize( 'hhh', '  vvv' ), 'header_line_normalize: remove first blancs' ) ;
-	ok( 'HHH: AA BB CCC D' eq header_line_normalize( 'hhh', 'aa  bb   ccc d' ), 'header_line_normalize: remove succesive blanks' ) ;
-	ok( 'HHH: AA BB CCC' eq header_line_normalize( 'hhh', 'aa  bb   ccc   ' ), 'header_line_normalize: remove last blanks' ) ;
-	ok( 'HHH: VVV XX YY' eq header_line_normalize( 'hhh', "vvv\t\txx\tyy" ), 'header_line_normalize: tabs' ) ;
-	ok( 'HHH: XABX' eq header_line_normalize( 'hhh', "\x80AB\xff" ), 'header_line_normalize: 8bit' ) ;
 
-	return ;
+        ok( ': ' eq header_line_normalize( q{}, q{} ), 'header_line_normalize: empty args' ) ;
+        ok( 'HHH: VVV' eq header_line_normalize( 'hhh', 'vvv' ), 'header_line_normalize: hhh vvv ' ) ;
+        ok( 'HHH: VVV' eq header_line_normalize( 'hhh', '  vvv' ), 'header_line_normalize: remove first blancs' ) ;
+        ok( 'HHH: AA BB CCC D' eq header_line_normalize( 'hhh', 'aa  bb   ccc d' ), 'header_line_normalize: remove succesive blanks' ) ;
+        ok( 'HHH: AA BB CCC' eq header_line_normalize( 'hhh', 'aa  bb   ccc   ' ), 'header_line_normalize: remove last blanks' ) ;
+        ok( 'HHH: VVV XX YY' eq header_line_normalize( 'hhh', "vvv\t\txx\tyy" ), 'header_line_normalize: tabs' ) ;
+        ok( 'HHH: XABX' eq header_line_normalize( 'hhh', "\x80AB\xff" ), 'header_line_normalize: 8bit' ) ;
+
+	note( 'Leaving  tests_header_line_normalize()' ) ;
+        return ;
 }
 
 
@@ -7334,9 +8531,14 @@ sub firstline {
 
         my( $file ) = @_ ;
         my $line  = q{} ;
-        my $FILE ;
-        open $FILE, '<', $file or do {
-                myprint( "Error opening file $file : $!\n" ) ;
+
+	if ( ! -e $file ) {
+                myprint( "Cannot open file $file since it does not exist\n" ) ;
+                return ;
+	}
+
+        open my $FILE, '<', $file or do {
+                myprint( "Error opening file $file : $OS_ERROR\n" ) ;
                 return ;
         } ;
         $line = <$FILE> || q{} ;
@@ -7346,34 +8548,113 @@ sub firstline {
 }
 
 sub tests_firstline {
-        is( 1 , string_to_file( "blabla\n", 'tmp/firstline.txt' ), 'tests_firstline: put blabla in tmp/firstline.txt' ) ;
-        is( 'blabla' , firstline( 'tmp/firstline.txt' ), 'tests_firstline: get blabla from tmp/firstline.txt' ) ;
-        is( undef , firstline( 'tmp/noexist.txt' ), 'tests_firstline: get blabla from tmp/noexist.txt' ) ;
-        is( 1 , string_to_file( q{}, 'tmp/firstline2.txt' ), 'tests_firstline: put empty string in tmp/firstline2.txt' ) ;
-        is( q{} , firstline( 'tmp/firstline2.txt' ), 'tests_firstline: get empty string from tmp/firstline2.txt' ) ;
-        is( 1 , string_to_file( "\n", 'tmp/firstline3.txt' ), 'tests_firstline: put CR in tmp/firstline3.txt' ) ;
-        is( q{} , firstline( 'tmp/firstline3.txt' ), 'tests_firstline: get empty string from tmp/firstline3.txt' ) ;
+	note( 'Entering tests_firstline()' ) ;
 
+        is( undef , firstline( 'W/tmp/tests/noexist.txt' ), 'tests_firstline: not getting blabla from W/tmp/tests/noexist.txt' ) ;
+        is( "blabla\n" , string_to_file( "blabla\n", 'W/tmp/tests/firstline.txt' ), 'tests_firstline: put blabla in W/tmp/tests/firstline.txt' ) ;
+        is( 'blabla' , firstline( 'W/tmp/tests/firstline.txt' ), 'tests_firstline: get blabla from W/tmp/tests/firstline.txt' ) ;
+        is( q{} , string_to_file( q{}, 'W/tmp/tests/firstline2.txt' ), 'tests_firstline: put empty string in W/tmp/tests/firstline2.txt' ) ;
+        is( q{} , firstline( 'W/tmp/tests/firstline2.txt' ), 'tests_firstline: get empty string from W/tmp/tests/firstline2.txt' ) ;
+        is( "\n" , string_to_file( "\n", 'W/tmp/tests/firstline3.txt' ), 'tests_firstline: put CR in W/tmp/tests/firstline3.txt' ) ;
+        is( q{} , firstline( 'W/tmp/tests/firstline3.txt' ), 'tests_firstline: get empty string from W/tmp/tests/firstline3.txt' ) ;
+
+	note( 'Leaving  tests_firstline()' ) ;
         return ;
 }
 
 
-sub file_to_string {
-	my( $file ) = @_ ;
-	my @string ;
-	open my $FILE, '<', $file or die_clean( "Error with file $file : $! " ) ;
-	@string = <$FILE> ;
-	close $FILE ;
-	return( join q{}, @string ) ;
+
+# Should be unit tested and then be used by file_to_string, refactoring file_to_string
+sub file_to_array {
+
+        my( $file ) = shift ;
+        my @string ;
+
+        open my $FILE, '<', $file or do {
+		myprint( "Error reading file $file : $OS_ERROR" ) ;
+		return ;
+	} ;
+        @string = <$FILE> ;
+        close $FILE ;
+        return( @string ) ;
 }
 
 
+sub tests_file_to_string {
+	note( 'Entering tests_file_to_string()' ) ;
+
+	is( undef, file_to_string(  ), 'file_to_string: no args => undef' ) ;
+	is( undef, file_to_string( '/noexist' ), 'file_to_string: /noexist => undef' ) ;
+	is( undef, file_to_string( '/' ), 'file_to_string: reading a directory => undef' ) ;
+	ok( file_to_string( $PROGRAM_NAME ), 'file_to_string: reading myself' ) ;
+
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'file_to_string: mkpath W/tmp/tests/' ) ;
+
+	is( 'lilili', string_to_file( 'lilili', 'W/tmp/tests/canbewritten' ), 'file_to_string: string_to_file filling W/tmp/tests/canbewritten with lilili' ) ;
+	is( 'lilili', file_to_string( 'W/tmp/tests/canbewritten' ), 'file_to_string: reading W/tmp/tests/canbewritten is lilili' ) ;
+
+	is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'file_to_string: string_to_file filling W/tmp/tests/empty with empty string' ) ;
+	is( q{}, file_to_string( 'W/tmp/tests/empty' ), 'file_to_string: reading W/tmp/tests/empty is empty' ) ;
+
+	note( 'Leaving  tests_file_to_string()' ) ;
+	return ;
+}
+
+sub file_to_string {
+        my  $file  = shift ;
+	if ( ! $file ) { return ; }
+	if ( ! -e $file ) { return ; }
+	if ( ! -f $file ) { return ; }
+	if ( ! -r $file ) { return ; }
+        my @string ;
+        if ( open my $FILE, '<', $file ) {
+		@string = <$FILE> ;
+		close $FILE ;
+		return( join q{}, @string ) ;
+	}else{
+		myprint( "Error reading file $file : $OS_ERROR\n" ) ;
+		return ;
+	}
+}
+
+
+sub tests_string_to_file {
+	note( 'Entering tests_string_to_file()' ) ;
+
+	is( undef, string_to_file(  ),         'string_to_file: no args => undef' ) ;
+	is( undef, string_to_file( 'lalala' ), 'string_to_file: one arg => undef' ) ;
+	is( undef, string_to_file( 'lalala', '.' ), 'string_to_file: writing a directory => undef' ) ;
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'string_to_file: mkpath W/tmp/tests/' ) ;
+	is( 'lalala', string_to_file( 'lalala', 'W/tmp/tests/canbewritten' ), 'string_to_file: W/tmp/tests/canbewritten with lalala' ) ;
+	is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'string_to_file: W/tmp/tests/empty with empty string' ) ;
+
+	SKIP: {
+                Readonly my $NB_UNX_tests_string_to_file => 1 ;
+                skip( 'Not on Unix', $NB_UNX_tests_string_to_file ) if ('MSWin32' eq $OSNAME) ;
+		is( undef, string_to_file( 'lalala', '/cantouch' ), 'string_to_file: /cantouch denied => undef' ) ;
+	}
+
+	note( 'Leaving  tests_string_to_file()' ) ;
+	return ;
+}
+
 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 ;
-	return 1 ;
+        my( $string, $file ) = @_ ;
+	if( ! defined $string ) { return ; }
+	if( ! defined $file )   { return ; }
+
+	if ( ! -e $file && ! -w dirname( $file ) ) {
+		myprint( "string_to_file: directory of $file is not writable\n" ) ;
+		return ;
+	}
+
+        if ( ! sysopen( FILE, $file, O_WRONLY|O_TRUNC|O_CREAT, 0600) ) {
+		myprint( "string_to_file: failure writing to $file with error: $OS_ERROR\n" ) ;
+		return ;
+	}
+        print FILE $string ;
+        close FILE ;
+        return $string ;
 }
 
 q^
@@ -7383,18 +8664,18 @@ Based on David Carter discussion, to do:
 * Now always "return( $string, $error )". Descriptions below.
 OK * Still    capture STDOUT via "1> $output_tmpfile" to finish in $string and "return( $string, $error )"
 OK * Now also capture STDERR via "2> $error_tmpfile"  to finish in $error  and "return( $string, $error )"
-OK * in case of CHILD_ERROR, return( undef, $error ) 
+OK * in case of CHILD_ERROR, return( undef, $error )
   and print $error, with folder/UID/maybeSubject context,
   on console and at the end with the final error listing. Count this as a sync error.
 * in case of good command, take final $string as is, unless void. In case $error with value then print it.
 * in case of good command and final $string empty, consider it like CHILD_ERROR =>
   return( undef, $error ) and print $error, with folder/UID/maybeSubject context,
-  on console and at the end with the final error listing. Count this as a sync error. 
+  on console and at the end with the final error listing. Count this as a sync error.
 ^ if 0 ; # End of multiline comment.
 
 sub pipemess {
-	my ( $string, @commands ) = @_ ;
-	my $error = q{} ;
+        my ( $string, @commands ) = @_ ;
+        my $error = q{} ;
         foreach my $command ( @commands ) {
                 my $input_tmpfile  = "$tmpdir/imapsync_tmp_file.$PROCESS_ID.inp.txt" ;
                 my $output_tmpfile = "$tmpdir/imapsync_tmp_file.$PROCESS_ID.out.txt" ;
@@ -7404,22 +8685,22 @@ sub pipemess {
                 my $is_command_ko = $CHILD_ERROR ;
                 my $error_cmd = file_to_string( $error_tmpfile ) ;
                 chomp( $error_cmd ) ;
-		$string = file_to_string( $output_tmpfile ) ;
+                $string = file_to_string( $output_tmpfile ) ;
                 my $string_len = length( $string ) ;
                 unlink $input_tmpfile, $output_tmpfile, $error_tmpfile ;
 
-		if ( $is_command_ko or ( ! $string_len ) ) {
-			my $cmd_exit_value = $CHILD_ERROR >> 8 ;
-			my $cmd_end_signal = $CHILD_ERROR & 127 ;
+                if ( $is_command_ko or ( ! $string_len ) ) {
+                        my $cmd_exit_value = $CHILD_ERROR >> 8 ;
+                        my $cmd_end_signal = $CHILD_ERROR & 127 ;
                         my $signal_log = ( $cmd_end_signal ) ? " signal $cmd_end_signal and" : q{} ;
                         my $error_log = qq{Failure: --pipemess command "$command" ended with$signal_log "$string_len" characters exit value "$cmd_exit_value" and STDERR "$error_cmd"\n} ;
-			myprint( $error_log ) ;
-			if ( wantarray ) {
+                        myprint( $error_log ) ;
+                        if ( wantarray ) {
                                 return @{ [ undef, $error_log ] }
                         }else{
                                 return ;
                         }
-		}
+                }
                 if ( $error_cmd ) {
                         $error .= qq{STDERR of --pipemess "$command": $error_cmd\n} ;
                         myprint(  qq{STDERR of --pipemess "$command": $error_cmd\n} ) ;
@@ -7436,39 +8717,41 @@ sub pipemess {
 
 
 sub tests_pipemess {
+	note( 'Entering tests_pipemess()' ) ;
 
-	SKIP: {
+
+        SKIP: {
                 Readonly my $NB_WIN_tests_pipemess => 3 ;
-		skip( 'Not on MSWin32', $NB_WIN_tests_pipemess ) if ('MSWin32' ne $OSNAME) ;
-		# Windows
-		# "type" command does not accept redirection of STDIN with <
-		# "sort" does
-		ok( "nochange\n" eq pipemess( 'nochange', 'sort' ), 'pipemess: nearly no change by sort' ) ;
-		ok( "nochange2\n" eq pipemess( 'nochange2', qw( sort sort ) ), 'pipemess: nearly no change by sort,sort' ) ;
-		# command not found
-		#diag( 'Warning and failure about cacaprout are on purpose' ) ;
-		ok( ! defined( pipemess( q{}, 'cacaprout' ) ), 'pipemess: command not found' ) ;
+                skip( 'Not on MSWin32', $NB_WIN_tests_pipemess ) if ('MSWin32' ne $OSNAME) ;
+                # Windows
+                # "type" command does not accept redirection of STDIN with <
+                # "sort" does
+                ok( "nochange\n" eq pipemess( 'nochange', 'sort' ), 'pipemess: nearly no change by sort' ) ;
+                ok( "nochange2\n" eq pipemess( 'nochange2', qw( sort sort ) ), 'pipemess: nearly no change by sort,sort' ) ;
+                # command not found
+                #diag( 'Warning and failure about cacaprout are on purpose' ) ;
+                ok( ! defined( pipemess( q{}, 'cacaprout' ) ), 'pipemess: command not found' ) ;
 
-	} ;
+        } ;
 
         my ( $stringT, $errorT ) ;
 
-	SKIP: {
+        SKIP: {
                 Readonly my $NB_UNX_tests_pipemess => 25 ;
-		skip( 'Not on Unix', $NB_UNX_tests_pipemess ) if ('MSWin32' eq $OSNAME) ;
-		# Unix
-		ok( 'nochange' eq pipemess( 'nochange', 'cat' ), 'pipemess: no change by cat' ) ;
+                skip( 'Not on Unix', $NB_UNX_tests_pipemess ) if ('MSWin32' eq $OSNAME) ;
+                # Unix
+                ok( 'nochange' eq pipemess( 'nochange', 'cat' ), 'pipemess: no change by cat' ) ;
 
-		ok( 'nochange2' eq pipemess( 'nochange2', 'cat', 'cat' ), 'pipemess: no change by cat,cat' ) ;
+                ok( 'nochange2' eq pipemess( 'nochange2', 'cat', 'cat' ), 'pipemess: no change by cat,cat' ) ;
 
-		ok( "     1\tnumberize\n" eq pipemess( "numberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
-		ok( "     1\tnumberize\n     2\tnumberize\n" eq pipemess( "numberize\nnumberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
+                ok( "     1\tnumberize\n" eq pipemess( "numberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
+                ok( "     1\tnumberize\n     2\tnumberize\n" eq pipemess( "numberize\nnumberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
 
-		ok( "A\nB\nC\n" eq pipemess( "A\nC\nB\n", 'sort' ), 'pipemess: sort' ) ;
+                ok( "A\nB\nC\n" eq pipemess( "A\nC\nB\n", 'sort' ), 'pipemess: sort' ) ;
 
-		# command not found
-		#diag( 'Warning and failure about cacaprout are on purpose' ) ;
-		is( undef, pipemess( q{}, 'cacaprout' ), 'pipemess: command not found' ) ;
+                # command not found
+                #diag( 'Warning and failure about cacaprout are on purpose' ) ;
+                is( undef, pipemess( q{}, 'cacaprout' ), 'pipemess: command not found' ) ;
 
                 # success with true but no output at all
                 is( undef, pipemess( q{blabla}, 'true' ), 'pipemess: true but no output' ) ;
@@ -7476,376 +8759,714 @@ sub tests_pipemess {
                 # failure with false and no output at all
                 is( undef, pipemess( q{blabla}, 'false' ), 'pipemess: false and no output' ) ;
 
-		# Failure since pipemess is not a real pipe, so first cat wait for standard input
-		is( q{blabla}, pipemess( q{blabla}, '( cat|cat ) ' ), 'pipemess: ok by ( cat|cat )' ) ;
+                # Failure since pipemess is not a real pipe, so first cat wait for standard input
+                is( q{blabla}, pipemess( q{blabla}, '( cat|cat ) ' ), 'pipemess: ok by ( cat|cat )' ) ;
 
 
                 ( $stringT, $errorT ) = pipemess( 'nochange', 'cat' ) ;
                 is( $stringT, 'nochange', 'pipemess: list context, no change by cat, string' ) ;
                 is( $errorT, q{}, 'pipemess: list context, no change by cat, no error' ) ;
-                
+
                 ( $stringT, $errorT ) = pipemess( 'dontcare', 'true' ) ;
                 is( $stringT, undef, 'pipemess: list context, true but no output, string' ) ;
-                like( $errorT, qr{Failure: --pipemess command "true" ended with "0" characters exit value "0" and STDERR ""},  'pipemess: list context, true but no output, error' ) ;
+                like( $errorT, qr{\QFailure: --pipemess command "true" ended with "0" characters exit value "0" and STDERR ""\E}xm,  'pipemess: list context, true but no output, error' ) ;
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', 'false' ) ;
                 is( $stringT, undef, 'pipemess: list context, false and no output, string' ) ;
-                like( $errorT, qr{Failure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""},  'pipemess: list context, false and no output, error' ) ;
+                like( $errorT, qr{\QFailure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""\E}xm,
+		'pipemess: list context, false and no output, error' ) ;
 
-                ( $stringT, $errorT ) = pipemess( 'dontcare', 'echo -n blablabla' ) ;
+                ( $stringT, $errorT ) = pipemess( 'dontcare', '/bin/echo -n blablabla' ) ;
                 is( $stringT, q{blablabla}, 'pipemess: list context, "echo -n blablabla", string' ) ;
                 is( $errorT, q{},  'pipemess: list context, "echo blablabla", error' ) ;
 
-                
+
                 ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo -n blablabla 3>&1 1>&2 2>&3 )' ) ;
                 is( $stringT, undef, 'pipemess: list context, "no output STDERR blablabla", string' ) ;
-                like( $errorT,  qr{blablabla"$},  'pipemess: list context, "no output STDERR blablabla", error' ) ;
+                like( $errorT,  qr{blablabla"}xm,  'pipemess: list context, "no output STDERR blablabla", error' ) ;
 
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo -n blablabla 3>&1 1>&2 2>&3 )', 'false' ) ;
                 is( $stringT, undef, 'pipemess: list context, "no output STDERR blablabla then false", string' ) ;
-                like( $errorT,  qr{blablabla"$},  'pipemess: list context, "no output STDERR blablabla then false", error' ) ;
+                like( $errorT,  qr{blablabla"}xm,  'pipemess: list context, "no output STDERR blablabla then false", error' ) ;
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', 'false', '( echo -n blablabla 3>&1 1>&2 2>&3 )' ) ;
                 is( $stringT, undef, 'pipemess: list context, "false then STDERR blablabla", string' ) ;
-                like( $errorT,  qr{Failure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""},  'pipemess: list context, "false then STDERR blablabla", error' ) ;
+                like( $errorT,  qr{\QFailure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""\E}xm,
+		'pipemess: list context, "false then STDERR blablabla", error' ) ;
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo rrrrr ; echo -n error_blablabla 3>&1 1>&2 2>&3 )' ) ;
-                like( $stringT, qr{rrrrr}, 'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", string' ) ;
-                like( $errorT,  qr{STDERR.*error_blablabla},  'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", error' ) ;
+                like( $stringT, qr{rrrrr}xm, 'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", string' ) ;
+                like( $errorT,  qr{STDERR.*error_blablabla}xm,  'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", error' ) ;
 
-	}
+        }
 
         ( $stringT, $errorT ) = pipemess( 'dontcare', 'cacaprout' ) ;
         is( $stringT, undef, 'pipemess: list context, cacaprout not found, string' ) ;
-        like( $errorT, qr{Failure: --pipemess command "cacaprout" ended with "0" characters exit value.*}, 'pipemess: list context, cacaprout not found, error' ) ;
+        like( $errorT, qr{\QFailure: --pipemess command "cacaprout" ended with "0" characters exit value\E}xm,
+	'pipemess: list context, cacaprout not found, error' ) ;
 
-	return ;
+	note( 'Leaving  tests_pipemess()' ) ;
+        return ;
 }
 
+
+
 sub tests_is_a_release_number {
-	ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_1), 'is_a_release_number 1.351') ;
-	ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_2), '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') ;
-	return ;
+	note( 'Entering tests_is_a_release_number()' ) ;
+
+        ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_1), 'is_a_release_number 1.351') ;
+        ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_2), 'is_a_release_number 42.4242') ;
+        ok(is_a_release_number( imapsync_version( $sync ) ), 'is_a_release_number imapsync_version(  )') ;
+        ok(! is_a_release_number('blabla' ), '! is_a_release_number blabla') ;
+
+	note( 'Leaving  tests_is_a_release_number()' ) ;
+        return ;
 }
 
 sub is_a_release_number {
-	my $number = shift;
-
-	return( $number =~ m{^\d+\.\d+$}xo ) ;
-}
-
-sub check_last_release {
-
-	my $public_release = not_long_imapsync_version_public(  ) ;
-	$debug and myprint( "check_last_release: [$public_release]\n"  ) ;
-	return('unknown') if ($public_release eq 'unknown') ;
-	return('timeout') if ($public_release eq 'timeout') ;
-	return('unknown') if (! is_a_release_number( $public_release ) ) ;
-
-	my $imapsync_here  = imapsync_version();
-
-	if ($public_release > $imapsync_here) {
-		return("New imapsync release $public_release available");
-	}else{
-		return( 'This imapsync is up to date') ;
-	}
-}
-
-sub imapsync_version  {
-	my $rcs_imapsync = '$Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ ' ;
-        my $imapsync_version ;
-
-	if ( $rcs_imapsync =~ m{,v\s+(\d+\.\d+)}xo ) {
-		$imapsync_version = $1
-        } else {
-                $imapsync_version = 'UNKNOWN' ;
-        }
-	return( $imapsync_version ) ;
-}
-
-sub tests_imapsync_basename {
-	ok( imapsync_basename() =~ m/imapsync/, 'imapsync_basename: match imapsync');
-	ok( 'blabla'   ne imapsync_basename(), 'imapsync_basename: do not equal blabla');
-	return ;
-}
-
-sub imapsync_basename {
-
-	return basename($0);
+        my $number = shift;
 
+        return( $number =~ m{^\d+\.\d+$}xo ) ;
 }
 
 sub imapsync_version_public {
 
-	my $local_version = imapsync_version();
-	my $imapsync_basename = imapsync_basename();
-	my $agent_info = "$OSNAME system, perl "
-		. mysprintf( '%vd', $PERL_VERSION)
-		. ", Mail::IMAPClient $Mail::IMAPClient::VERSION"
-		. " $imapsync_basename";
-	my $sock = IO::Socket::INET->new(
-		PeerAddr => 'imapsync.lamiral.info',
-		PeerPort => 80,
-		Proto    => 'tcp',
+        my $local_version = imapsync_version( $sync ) ;
+        my $imapsync_basename = imapsync_basename(  ) ;
+        my $agent_info = "$OSNAME system, perl "
+                . mysprintf( '%vd', $PERL_VERSION)
+                . ", Mail::IMAPClient $Mail::IMAPClient::VERSION"
+                . " $imapsync_basename" ;
+        my $sock = IO::Socket::INET->new(
+                PeerAddr => 'imapsync.lamiral.info',
+                PeerPort => 80,
+                Proto    => 'tcp',
                 ) ;
-	return( 'unknown' ) if not $sock ;
-	print $sock
-		"GET /prj/imapsync/VERSION HTTP/1.0\n",
-		"User-Agent: imapsync/$local_version ($agent_info)\n",
-		"Host: ks.lamiral.info\n\n";
-	my @line = <$sock>;
-	close $sock ;
-	my $last_release = $line[$LAST];
-	chomp $last_release ;
-	return($last_release) ;
+        return( 'unknown' ) if not $sock ;
+        print $sock
+                "GET /prj/imapsync/VERSION HTTP/1.0\r\n",
+                "User-Agent: imapsync/$local_version ($agent_info)\r\n",
+                "Host: ks.lamiral.info\r\n\r\n" ;
+        my @line = <$sock> ;
+        close $sock ;
+        my $last_release = $line[$LAST] ;
+        chomp $last_release ;
+        return( $last_release ) ;
 }
 
-sub not_long_imapsync_version_public {
-	#myprint( "Entering not_long_imapsync_version_public\n" ) ;
+sub not_long_imapsync_version_public  {
+        #myprint( "Entering not_long_imapsync_version_public\n" ) ;
 
-	my $val;
+	my $fake = shift ;
+	if ( $fake ) { return $fake }
 
-	# Doesn't work with gethostbyname (see perlipc)
-	#local $SIG{ALRM} = sub { die "alarm\n" };
+        my $val ;
 
-	if ('MSWin32' eq $OSNAME) {
-		local $SIG{ALRM} = sub { die "alarm\n" };
-	}else{
+        # Doesn't work with gethostbyname (see perlipc)
+        #local $SIG{ALRM} = sub { die "alarm\n" } ;
 
-        	POSIX::sigaction(SIGALRM,
+        if ('MSWin32' eq $OSNAME) {
+                local $SIG{ALRM} = sub { die "alarm\n" } ;
+        }else{
+
+                POSIX::sigaction(SIGALRM,
                          POSIX::SigAction->new(sub { croak 'alarm' } ) )
-        		or myprint( "Error setting SIGALRM handler: $!\n"  ) ;
-	}
+                        or myprint( "Error setting SIGALRM handler: $OS_ERROR\n"  ) ;
+        }
 
-	my $ret = eval {
-		alarm 3 ;
-		{
-			$val = imapsync_version_public(  ) ;
+        my $ret = eval {
+                alarm 3 ;
+                {
+                        $val = imapsync_version_public(  ) ;
                         #sleep 4 ;
-			#myprint( "End of imapsync_version_public\n"  ) ;
-		}
-		alarm 0 ;
+                        #myprint( "End of imapsync_version_public\n"  ) ;
+                }
+                alarm 0 ;
                 1 ;
-	} ;
+        } ;
         #myprint( "eval [$ret]\n"  ) ;
-	if ( ( not $ret ) or $@ ) {
-		#myprint( "$@" ) ;
-		if ($@ =~ /alarm/) {
-		# timed out
-			return('timeout');
-		}else{
-			alarm 0 ;
-			return('unknown'); # propagate unexpected errors
-		}
-	}else {
-	# Good!
-		return($val);
-	}
+        if ( ( not $ret ) or $EVAL_ERROR ) {
+                #myprint( "$EVAL_ERROR" ) ;
+                if ($EVAL_ERROR =~ /alarm/) {
+                # timed out
+                        return('timeout') ;
+                }else{
+                        alarm 0 ;
+                        return( 'unknown' ) ; # propagate unexpected errors
+                }
+        }else {
+        # Good!
+                return( $val ) ;
+        }
 }
 
+sub tests_not_long_imapsync_version_public {
+	note( 'Entering tests_not_long_imapsync_version_public()' ) ;
+
+
+	is( 1, is_a_release_number( not_long_imapsync_version_public(  ) ),
+		'not_long_imapsync_version_public: public release is a number' ) ;
+
+	note( 'Leaving  tests_not_long_imapsync_version_public()' ) ;
+	return ;
+}
+
+sub check_last_release {
+	my $fake = shift ;
+        my $public_release = not_long_imapsync_version_public( $fake ) ;
+        $debug and myprint( "check_last_release: [$public_release]\n"  ) ;
+        return( 'Imapsync public release is unknown' ) if ( $public_release eq 'unknown' ) ;
+        return( 'Imapsync public release is unknown (timeout)' ) if ( $public_release eq 'timeout' ) ;
+        return( "Imapsync public release is unknown ($public_release)" ) if ( ! is_a_release_number( $public_release ) ) ;
+
+        my $imapsync_here  = imapsync_version( $sync ) ;
+
+        if ( $public_release > $imapsync_here ) {
+                return(
+			"New imapsync release $public_release available to replace this $imapsync_here\n"
+			. "Get it at https://imapsync.lamiral.info/dist/") ;
+        }else{
+                return( 'This imapsync is up to date. ' . "( local $imapsync_here >= official $public_release )") ;
+        }
+
+	return('really unknown') ; # Should never arrive here
+}
+
+sub tests_check_last_release {
+	note( 'Entering tests_check_last_release()' ) ;
+
+	diag( check_last_release( 1.1 ) ) ;
+	like( check_last_release( 1.1 ), qr/\Qup to date\E/mxs, 'check_last_release: up to date' ) ;
+	like( check_last_release( 1.1 ), qr/1\.1/mxs, 'check_last_release: up to date, include number' ) ;
+	diag( check_last_release( 999.999 ) ) ;
+	like( check_last_release( 999.999 ), qr/available/mxs, 'check_last_release: update available' ) ;
+	like( check_last_release( 999.999 ), qr/999\.999/mxs, 'check_last_release: update available, include number' ) ;
+	diag( check_last_release(  ) ) ;
+	is( 'Imapsync public release is unknown', check_last_release( 'unknown' ), 'check_last_release: unknown' ) ;
+	is( 'Imapsync public release is unknown (timeout)', check_last_release( 'timeout' ), 'check_last_release: timeout' ) ;
+	is( 'Imapsync public release is unknown (lalala)', check_last_release( 'lalala' ), 'check_last_release: lalala' ) ;
+
+	note( 'Leaving  tests_check_last_release()' ) ;
+	return ;
+}
+
+sub imapsync_version  {
+        my $mysync = shift ;
+        my $rcs = $mysync->{rcs} ;
+        my $imapsync_version ;
+
+        $imapsync_version = version_from_rcs( $rcs ) ;
+        
+        return( $imapsync_version ) ;
+}
+
+
+sub tests_version_from_rcs {
+	note( 'Entering tests_version_from_rcs()' ) ;
+
+	is( undef, version_from_rcs(  ), 'version_from_rcs: no args => UNKNOWN' ) ;
+	is( 1.831, version_from_rcs( q{imapsync,v 1.831 2017/08/27} ), 'version_from_rcs: imapsync,v 1.831 2017/08/27 => 1.831' ) ;
+	is( 'UNKNOWN', version_from_rcs( 1.831 ), 'version_from_rcs:  1.831  => UNKNOWN' ) ;
+
+	note( 'Leaving  tests_version_from_rcs()' ) ;
+	return ;
+}
+
+
+sub version_from_rcs {
+
+        my $rcs = shift ;
+        if ( ! $rcs ) { return ; }
+        
+        my $version = 'UNKNOWN' ;
+
+        if ( $rcs =~ m{,v\s+(\d+\.\d+)}mxso ) {
+                $version = $1
+        }
+        
+        return( $version ) ;
+}
+
+
+sub tests_imapsync_basename {
+	note( 'Entering tests_imapsync_basename()' ) ;
+
+        ok( imapsync_basename() =~ m/imapsync/, 'imapsync_basename: match imapsync');
+        ok( 'blabla'   ne imapsync_basename(), 'imapsync_basename: do not equal blabla');
+
+	note( 'Leaving  tests_imapsync_basename()' ) ;
+        return ;
+}
+
+sub imapsync_basename  {
+
+        return basename( $PROGRAM_NAME ) ;
+
+}
+
+
 sub localhost_info {
 
-	my($infos) = join q{},
-	    "Here is a [$OSNAME] system (",
-	    join(q{ },
-	         uname(),
-	         ),
+        my( $infos ) = join q{},
+            "Here is " . hostname() . ", a " . memory_available(  ) . " [$OSNAME] system (",
+            join(q{ },
+                 uname(),
+                 ),
                  ")\n",
-	         'with Perl ',
-	         mysprintf( '%vd', $PERL_VERSION),
-	         " Mail::IMAPClient $Mail::IMAPClient::VERSION",
+                 'with Perl ',
+                 mysprintf( '%vd ', $PERL_VERSION),
+                 "and Mail::IMAPClient $Mail::IMAPClient::VERSION",
              ;
-	return($infos) ;
+        return( $infos ) ;
 }
 
+sub tests_cpu_number {
+	note( 'Entering tests_cpu_number()' ) ;
+
+	ok( 1 <= cpu_number(  ), "cpu_number: 1 or more" ) ;
+
+	note( 'Leaving  tests_cpu_number()' ) ;
+	return ;
+}
+
+sub cpu_number {
+	my @cpuinfo ;
+
+	# Well, here 1 is better than 0 or undef
+	my $cpu_number = 1 ; # Default value, erased if better found
+
+	if ( $ENV{"NUMBER_OF_PROCESSORS"} ) {
+		# might be under a Windows system
+		$cpu_number = $ENV{"NUMBER_OF_PROCESSORS"} ;
+		$debug and myprint( "Number of processors found by envvar NUMBER_OF_PROCESSORS: $cpu_number\n" ) ;
+		return $cpu_number ;
+	}
+
+	if ( 'darwin' eq $OSNAME ) {
+		$cpu_number = `sysctl -n hw.ncpu` ;
+		chomp( $cpu_number ) ;
+		return $cpu_number ;
+	}
+
+	if ( ! -e '/proc/cpuinfo' ) {
+		$debug and myprint( "Number of processors not found so use: $cpu_number\n" ) ;
+		return $cpu_number ;
+	}
+
+	@cpuinfo = file_to_array( '/proc/cpuinfo' ) ;
+	if ( @cpuinfo ) {
+		$cpu_number = grep { /^processor/mxs } @cpuinfo ;
+	}
+	$debug and myprint( "Number of processors found via /proc/cpuinfo: $cpu_number\n" ) ;
+	return $cpu_number ;
+}
+
+
+
+sub tests_loadavg {
+	note( 'Entering tests_loadavg()' ) ;
+
+
+	SKIP: {
+		skip( 'Tests for darwin', 2 ) if ('darwin' ne $OSNAME) ;
+		is( undef, loadavg( '/noexist' ), 'loadavg: /noexist => undef' ) ;
+		is_deeply( [ '0.11', '0.22', '0.33' ],
+		[ loadavg( 'W/t/loadavg.out' ) ],
+		'loadavg W/t/loadavg.out => 0.11 0.22 0.33' ) ;
+	} ;
+
+	SKIP: {
+		skip( 'Tests for linux', 3 ) if ('linux' ne $OSNAME) ;
+		is( undef, loadavg( '/noexist' ), 'loadavg: /noexist => undef' ) ;
+		ok( loadavg( ), 'loadavg: no args' ) ;
+
+		is_deeply( [ '0.39', '0.30', '0.37', '1/602' ],
+		[ loadavg( '0.39 0.30 0.37 1/602 6073' ) ],
+		'loadavg 0.39 0.30 0.37 1/602 6073 => [0.39, 0.30, 0.37, 1/602]' ) ;
+	} ;
+
+	SKIP: {
+		skip( 'Tests for Windows', 1 ) if ('MSWin32' ne $OSNAME) ;
+		is_deeply( [ 0 ],
+		[ loadavg( ) ],
+		'loadavg on MSWin32 => 0' ) ;
+
+	} ;
+
+	note( 'Leaving  tests_loadavg()' ) ;
+	return ;
+}
+
+
+sub loadavg {
+	if ( 'linux' eq $OSNAME ) {
+		return ( loadavg_linux( @ARG ) ) ;
+	}
+	if ( 'darwin' eq $OSNAME ) {
+		return ( loadavg_darwin( @ARG ) ) ;
+	}
+	if ( 'MSWin32' eq $OSNAME ) {
+		return ( loadavg_windows( @ARG ) ) ;
+	}
+	return( 'unknown' ) ;
+
+}
+
+sub loadavg_linux {
+	my $line = shift ;
+
+	if ( ! $line ) {
+                $line = firstline( '/proc/loadavg'  ) or return ;
+	}
+
+	my ( $avg_1_min, $avg_5_min, $avg_15_min, $current_runs ) = split /\s/mxs, $line ;
+	if ( all_defined( $avg_1_min, $avg_5_min, $avg_15_min ) ) {
+		$debug and print "System load: $avg_1_min $avg_5_min $avg_15_min $current_runs\n" ;
+		return ( $avg_1_min, $avg_5_min, $avg_15_min, $current_runs ) ;
+	}
+	return ;
+}
+
+
+sub loadavg_darwin {
+	my $file = shift ;
+	# Example of output of command "sysctl vm.loadavg":
+	# vm.loadavg: { 0.15 0.08 0.08 }
+	my $loadavg ;
+
+	if ( ! defined $file ) {
+		eval {
+			$loadavg = `/usr/sbin/sysctl vm.loadavg` ;
+			#myprint( "LOADAVG DARWIN: $loadavg\n" ) ;
+		} ;
+		if ( $EVAL_ERROR ) { myprint( "[$EVAL_ERROR]\n" ) ; return ; }
+	}else{
+		$loadavg = firstline( $file ) or return ;
+	}
+
+	my ( $avg_1_min, $avg_5_min, $avg_15_min )
+	= $loadavg =~ /vm\.loadavg\s*[:=]\s*\{?\s*(\d+\.?\d*)\s+(\d+\.?\d*)\s+(\d+\.?\d*)/mxs ;
+	$debug and print "System load: $avg_1_min $avg_5_min $avg_15_min\n" ;
+	return ( $avg_1_min, $avg_5_min, $avg_15_min ) ;
+}
+
+sub loadavg_windows {
+	my $file = shift ;
+	# Example of output of command "wmic cpu get loadpercentage":
+	# LoadPercentage
+        # 12
+	my $loadavg ;
+
+	if ( ! defined $file ) {
+		eval {
+			#$loadavg = `CMD wmic cpu get loadpercentage` ;
+			$loadavg = "LoadPercentage\n0\n" ;
+			#myprint( "LOADAVG WIN: $loadavg\n" ) ;
+		} ;
+		if ( $EVAL_ERROR ) { myprint( "[$EVAL_ERROR]\n" ) ; return ; }
+	}else{
+		$loadavg = file_to_string( $file ) or return ;
+		#myprint( "$loadavg" ) ;
+	}
+	$loadavg =~ /LoadPercentage\n(\d+)/xms ;
+	my $num = $1 ;
+	$num /= 100 ;
+
+	$debug and myprint( "System load: $num\n" ) ;
+	return ( $num ) ;
+}
+
+
+
+
+
+
+sub tests_load_and_delay {
+	note( 'Entering tests_load_and_delay()' ) ;
+
+	is( undef, load_and_delay(  ), 'load_and_delay: no args => undef ' ) ;
+	is( undef, load_and_delay( 1 ), 'load_and_delay: not 4 args => undef ' ) ;
+	is( undef, load_and_delay( 0, 1, 1, 1 ), 'load_and_delay: division per 0 => undef ' ) ;
+	is(  0, load_and_delay( 1, 1, 1, 1 ), 'load_and_delay: one core, loads are all 1 => ok ' ) ;
+	is(  0, load_and_delay( 2, 2, 2, 2 ), 'load_and_delay: two core, loads are all 2 => ok ' ) ;
+	is(  0, load_and_delay( 2, 2, 4, 5 ), 'load_and_delay: two core, load1m     is 2 => ok ' ) ;
+
+	is(  0, load_and_delay( 1, 0, 0, 0 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=0 => 0 ' ) ;
+	is(  0, load_and_delay( 1, 0, 0, 2 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=2 => 0 ' ) ;
+	is(  0, load_and_delay( 1, 0, 2, 0 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=0 => 0 ' ) ;
+	is(  0, load_and_delay( 1, 0, 2, 2 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=2 => 0 ' ) ;
+	is(  1, load_and_delay( 1, 2, 0, 0 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
+	is(  1, load_and_delay( 1, 2, 0, 2 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
+	is(  5, load_and_delay( 1, 2, 2, 0 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
+	is( 15, load_and_delay( 1, 2, 2, 2 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;
+
+	is(  0, load_and_delay( 4, 0, 2, 2 ), 'load_and_delay: four core, load1m=0 load5m=2 load15m=2 => 0 ' ) ;
+	is(  1, load_and_delay( 4, 8, 0, 0 ), 'load_and_delay: four core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
+	is(  1, load_and_delay( 4, 8, 0, 2 ), 'load_and_delay: four core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
+	is(  5, load_and_delay( 4, 8, 8, 0 ), 'load_and_delay: four core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
+	is( 15, load_and_delay( 4, 8, 8, 8 ), 'load_and_delay: four core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;
+	is( 15, load_and_delay( 4, 8, 8, 8, 'lalala' ), 'load_and_delay: five arguments is ok' ) ;
+
+	note( 'Leaving  tests_load_and_delay()' ) ;
+	return ;
+}
+
+sub load_and_delay {
+	# Basically return 0 if load is not heavy, ie <= 1 per processor
+
+	if ( 4 > scalar @ARG ) { return ; }
+
+	my ( $cpu_num, $avg_1_min, $avg_5_min, $avg_15_min ) = @ARG ;
+
+	if ( 0 == $cpu_num ) { return ; }
+
+	# Let divide by number of cores
+	( $avg_1_min, $avg_5_min, $avg_15_min ) = map { $_ / $cpu_num } ( $avg_1_min, $avg_5_min, $avg_15_min ) ;
+	# One of avg ok => ok, for now it is a OR
+	if ( $avg_1_min <= 1 ) { return 0 ; }
+	if ( $avg_5_min <= 1 ) { return 1 ; } # Retry in 1 minute
+	if ( $avg_15_min <= 1 ) { return 5 ; } # Retry in 5 minutes
+	return 15 ; # Retry in 15 minutes
+}
+
+sub memory_available {
+	# / ( 1000 ** 3 )
+	return(
+		sprintf( "%.1f GiB", Sys::MemInfo::get("totalmem") / ( 1024 ** 3 ) )
+	) ;
+}
 sub memory_consumption {
-	# memory consumed by imapsync until now in bytes
-	return( ( memory_consumption_of_pids(  ) )[0] );
+        # memory consumed by imapsync until now in bytes
+        return( ( memory_consumption_of_pids(  ) )[0] );
 }
 
 sub tests_memory_consumption {
+	note( 'Entering tests_memory_consumption()' ) ;
 
-	like( memory_consumption(  ),  qr{\d+},'memory_consumption no args') ;
-	like( memory_consumption( 1 ), qr{\d+},'memory_consumption 1') ;
-	like( memory_consumption( $PROCESS_ID ), qr{\d+},"memory_consumption_of_pids $PROCESS_ID") ;
+        like( memory_consumption(  ),  qr{\d+}xms,'memory_consumption no args') ;
+        like( memory_consumption( 1 ), qr{\d+}xms,'memory_consumption 1') ;
+        like( memory_consumption( $PROCESS_ID ), qr{\d+}xms,"memory_consumption_of_pids $PROCESS_ID") ;
 
-	like( memory_consumption_ratio(), qr{\d+},   'memory_consumption_ratio' ) ;
-	like( memory_consumption_ratio(1), qr{\d+},  'memory_consumption_ratio 1' ) ;
-	like( memory_consumption_ratio(10), qr{\d+}, 'memory_consumption_ratio 10' ) ;
+        like( memory_consumption_ratio(), qr{\d+}xms,   'memory_consumption_ratio' ) ;
+        like( memory_consumption_ratio(1), qr{\d+}xms,  'memory_consumption_ratio 1' ) ;
+        like( memory_consumption_ratio(10), qr{\d+}xms, 'memory_consumption_ratio 10' ) ;
 
-	like( memory_consumption(), qr{\d+}, "memory_consumption\n" ) ;
-	return ;
+        like( memory_consumption(), qr{\d+}xms, "memory_consumption\n" ) ;
+
+	note( 'Leaving  tests_memory_consumption()' ) ;
+        return ;
 }
 
 
 
 sub memory_consumption_of_pids {
 
-	my @pid = @_;
-	@pid = (@pid) ? @pid : ($PROCESS_ID) ;
+        my @pid = @_;
+        @pid = (@pid) ? @pid : ($PROCESS_ID) ;
 
-	#myprint( "PIDs: @pid\n" ) ;
-	my @val;
-	if ('MSWin32' eq $OSNAME) {
-		@val = memory_consumption_of_pids_win32(@pid);
-	}else{
-		# Unix
-		my @ps = qx{ ps -o vsz -p @pid } ;
+        #myprint( "PIDs: @pid\n" ) ;
+        my @val;
+        if ('MSWin32' eq $OSNAME) {
+                @val = memory_consumption_of_pids_win32(@pid);
+        }else{
+                # Unix
+                my @ps = qx{ ps -o vsz -p @pid } ;
                 #myprint( @ps ) ;
                 #my @ps = backtick( "ps -o vsz -p @pid" ) ;
-		shift @ps; # First line is column name "VSZ"
-		chomp @ps;
-		# convert to octets
-                
-		@val = map { $_ * $KIBI } @ps;
-	}
-	return( @val ) ;
+                shift @ps; # First line is column name "VSZ"
+                chomp @ps;
+                # convert to octets
+
+                @val = map { $_ * $KIBI } @ps;
+        }
+        return( @val ) ;
 }
 
 sub memory_consumption_of_pids_win32 {
-	# Windows
-	my @PID = @_;
-	my %PID;
-	# hash of pids as key values
-	map { $PID{$_}++ } @PID;
+        # 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" };
+        # Does not work but should reading the tasklist documentation
+        #@ps = qx{ tasklist /FI "PID eq @PID" };
 
-	my @ps = qx{ tasklist /NH /FO CSV } ;
+        my @ps = qx{ tasklist /NH /FO CSV } ;
         #my @ps = backtick( 'tasklist /NH /FO CSV' ) ;
-	#myprint( "-" x $STD_CHAR_PER_LINE, "\n", @ps, "-" x $STD_CHAR_PER_LINE, "\n" ) ;
-	my @val;
-	foreach my $line (@ps) {
-		my($name, $pid, $mem) = (split ',', $line )[0,1,4];
-		next if (! $pid);
-		#myprint( "[$name][$pid][$mem]" ) ;
-		if ($PID{remove_qq($pid)}) {
-			#myprint( "MATCH !\n" ) ;
-			chomp $mem ;
-			$mem = remove_qq($mem);
-			$mem = remove_Ko($mem);
-			$mem = remove_not_num($mem);
-			#myprint( "[$mem]\n" ) ;
-			push @val, $mem * $KIBI;
-		}
-	}
-	return(@val);
+        #myprint( "-" x $STD_CHAR_PER_LINE, "\n", @ps, "-" x $STD_CHAR_PER_LINE, "\n" ) ;
+        my @val;
+        foreach my $line (@ps) {
+                my($name, $pid, $mem) = (split ',', $line )[0,1,4];
+                next if (! $pid);
+                #myprint( "[$name][$pid][$mem]" ) ;
+                if ($PID{remove_qq($pid)}) {
+                        #myprint( "MATCH !\n" ) ;
+                        chomp $mem ;
+                        $mem = remove_qq($mem);
+                        $mem = remove_Ko($mem);
+                        $mem = remove_not_num($mem);
+                        #myprint( "[$mem]\n" ) ;
+                        push @val, $mem * $KIBI;
+                }
+        }
+        return(@val);
 }
 
 sub backtick {
-	my $command = shift ;
-	my ( $writer, $reader, $err ) ;
+        my $command = shift ;
+
+	if ( ! $command ) { return ; }
+
+        my ( $writer, $reader, $err ) ;
         my @output ;
-        open3( $writer, $reader, $err, $command ) ;
-        @output = <$reader>;  #Output here
+        my $pid ;
+	eval {
+		$pid = open3( $writer, $reader, $err, $command ) ;
+	} ;
+
+	if ( ! $pid  ) { return ; }
+	waitpid( $pid, 0 ) ;
+        @output = <$reader>;  # Output here
+	#
         #my @errors = <$err>;    #Errors here, instead of the console
+	if ( not @output ) { return ; }
         $debugdev and myprint( @output  ) ;
-        return( @output ) ;
+	if ( $output[0] =~ /\Qopen3: exec of $command failed\E/mxs ) { return ; }
+	if ( wantarray ) {
+		return( @output ) ;
+	} else {
+		return( join( q{}, @output) ) ;
+	}
 }
 
 sub tests_backtick {
+	note( 'Entering tests_backtick()' ) ;
+
+	is( undef, backtick( ), 'backtick: no args' ) ;
+	is( undef, backtick( q{} ), 'backtick: empty command' ) ;
 
         SKIP: {
-		skip( 'Tests for MSWin32', 3 ) if ('MSWin32' ne $OSNAME) ;
-		my @output ;
-		@output = backtick( 'echo Hello World!' ) ;
-		# Add \r on Windows.
-		ok( "Hello World!\r\n" eq $output[0], 'backtick: echo Hello World!' ) ;
-		$debug and myprint( "[@output]"  ) ;
-		@output = backtick( 'echo Hello & echo World!' ) ;
-		ok( "Hello \r\n" eq $output[0], 'backtick: echo Hello & echo World!' ) ;
-		ok( "World!\r\n" eq $output[1], 'backtick: echo Hello & echo World!' ) ;
-		$debug and myprint( "[@output][$output[0]][$output[1]]"  ) ;
+                skip( 'test for MSWin32', 5 ) if ('MSWin32' ne $OSNAME) ;
+                my @output ;
+                @output = backtick( 'echo Hello World!' ) ;
+                # Add \r on Windows.
+                ok( "Hello World!\r\n" eq $output[0], 'backtick: echo Hello World!' ) ;
+                $debug and myprint( "[@output]"  ) ;
+                @output = backtick( 'echo Hello & echo World!' ) ;
+                ok( "Hello \r\n" eq $output[0], 'backtick: echo Hello & echo World! line 1' ) ;
+                ok( "World!\r\n" eq $output[1], 'backtick: echo Hello & echo World! line 2' ) ;
+                $debug and myprint( "[@output][$output[0]][$output[1]]"  ) ;
+		# Scalar context
+		ok( "Hello World!\r\n" eq backtick( 'echo Hello World!' ),
+		'backtick: echo Hello World! scalar' ) ;
+		ok( "Hello \r\nWorld!\r\n" eq backtick( 'echo Hello & echo World!' ),
+		'backtick: echo Hello & echo World! scalar 2 lines' ) ;
         } ;
-	SKIP: {
-		skip( 'Tests for Unix', 3 ) if ('MSWin32' eq $OSNAME) ;
-		my @output ;
-		@output = backtick( 'echo Hello World!' ) ;
-		ok( "Hello World!\n" eq $output[0], 'backtick: echo Hello World!' ) ;
-		$debug and myprint( "[@output]"  ) ;
-		@output = backtick( "echo Hello\necho World!" ) ;
-		ok( "Hello\n" eq $output[0], 'backtick: echo Hello; echo World!' ) ;
-		ok( "World!\n" eq $output[1], 'backtick: echo Hello; echo World!' ) ;
-		$debug and myprint( "[@output]"  ) ;
-	}
+        SKIP: {
+                skip( 'test for Unix', 7 ) if ('MSWin32' eq $OSNAME) ;
+		is( undef, backtick( 'aaaarrrg' ), 'backtick: aaaarrrg command not found' ) ;
+		# Array context
+                my @output ;
+                @output = backtick( 'echo Hello World!' ) ;
+                ok( "Hello World!\n" eq $output[0], 'backtick: echo Hello World!' ) ;
+                $debug and myprint( "[@output]"  ) ;
+                @output = backtick( "echo Hello\necho World!" ) ;
+                ok( "Hello\n" eq $output[0], 'backtick: echo Hello; echo World! line 1' ) ;
+                ok( "World!\n" eq $output[1], 'backtick: echo Hello; echo World! line 2' ) ;
+                $debug and myprint( "[@output]"  ) ;
+		# Scalar context
+		ok( "Hello World!\n" eq backtick( 'echo Hello World!' ),
+		'backtick: echo Hello World! scalar' ) ;
+		ok( "Hello\nWorld!\n" eq backtick( "echo Hello\necho World!" ),
+		'backtick: echo Hello; echo World! scalar 2 lines' ) ;
+		# Return error positive value, that's ok
+		is( undef, backtick( 'false' ), 'backtick: false returns no output' ) ;
+        }
+
+	note( 'Leaving  tests_backtick()' ) ;
         return ;
 }
 
 sub remove_not_num {
 
-	my $string = shift;
-	$string =~ tr/0-9//cd;
-	#myprint( "tr [$string]\n" ) ;
-	return($string);
+        my $string = shift ;
+        $string =~ tr/0-9//cd ;
+        #myprint( "tr [$string]\n" ) ;
+        return( $string ) ;
 }
 
 sub tests_remove_not_num {
+	note( 'Entering tests_remove_not_num()' ) ;
 
-	ok('123' eq remove_not_num(123), 'remove_not_num( 123 )' ) ;
-	ok('123' eq remove_not_num('123'), q{remove_not_num( '123' )} ) ;
-	ok('123' eq remove_not_num('12 3'), q{remove_not_num( '12 3' )} ) ;
-	ok('123' eq remove_not_num('a 12 3 Ko'), q{remove_not_num( 'a 12 3 Ko' )} ) ;
-	return ;
+        ok( '123' eq remove_not_num( 123 ), 'remove_not_num( 123 )' ) ;
+        ok( '123' eq remove_not_num( '123' ), q{remove_not_num( '123' )} ) ;
+        ok( '123' eq remove_not_num( '12 3' ), q{remove_not_num( '12 3' )} ) ;
+        ok( '123' eq remove_not_num( 'a 12 3 Ko' ), q{remove_not_num( 'a 12 3 Ko' )} ) ;
+
+	note( 'Leaving  tests_remove_not_num()' ) ;
+        return ;
 }
 
 sub remove_Ko {
-	my $string = shift;
-	if ($string =~ /^(.*)\sKo$/xo) {
-		return($1);
-	}else{
-		return($string);
-	}
+        my $string = shift;
+        if ($string =~ /^(.*)\sKo$/xo) {
+                return($1);
+        }else{
+                return($string);
+        }
 }
 
 sub remove_qq {
-	my $string = shift;
-	if ($string =~ /^"(.*)"$/xo) {
-		return($1);
-	}else{
-		return($string);
-	}
+        my $string = shift;
+        if ($string =~ /^"(.*)"$/xo) {
+                return($1);
+        }else{
+                return($string);
+        }
 }
 
 sub memory_consumption_ratio {
 
-	my ($base) = @_;
-	$base ||= 1;
-	my $consu = memory_consumption();
-	return($consu / $base);
+        my ($base) = @_;
+        $base ||= 1;
+        my $consu = memory_consumption();
+        return($consu / $base);
 }
 
 
 sub date_from_rcs {
-	my $d = shift ;
+        my $d = shift ;
 
-	my %num2mon = qw( 01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec ) ;
+        my %num2mon = qw( 01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec ) ;
         if ($d =~ m{(\d{4})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                 # Handles the following format
                 # 2015/07/10 11:05:59 -- Generated by RCS Date tag.
-		#myprint( "$d\n"  ) ;
+                #myprint( "$d\n"  ) ;
                 #myprint( "header: [$1][$2][$3][$4][$5][$6]\n"  ) ;
                 my ($year, $month, $day, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6) ;
                 $month = $num2mon{$month} ;
                 $d = "$day-$month-$year $hour:$min:$sec +0000" ;
-		#myprint( "$d\n"  ) ;
-	}
-	return( $d ) ;
+                #myprint( "$d\n"  ) ;
+        }
+        return( $d ) ;
 }
 
 sub tests_date_from_rcs {
-	ok('19-Sep-2015 16:11:07 +0000'
-	eq date_from_rcs('Date: 2015/09/19 16:11:07 '), 'date_from_rcs from RCS date' ) ;
-	return ;
+	note( 'Entering tests_date_from_rcs()' ) ;
+
+        ok('19-Sep-2015 16:11:07 +0000'
+        eq date_from_rcs('Date: 2015/09/19 16:11:07 '), 'date_from_rcs from RCS date' ) ;
+
+	note( 'Leaving  tests_date_from_rcs()' ) ;
+        return ;
 }
 
 sub good_date {
         # two incoming formats:
         # header    Tue, 24 Aug 2010 16:00:00 +0200
-	# internal       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
@@ -7853,18 +9474,18 @@ sub good_date {
     my $d = shift ;
     return(q{}) if not defined $d;
 
-	SWITCH: {
-    	if ( $d =~ m{(\d?)(\d-...-\d{4})(\s\d{2}:\d{2}:\d{2})(\s(?:\+|-)\d{4})?}xo ) {
-		#myprint( "internal: [$1][$2][$3][$4]\n"  ) ;
-		my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4) ;
-		$day_1 = '0' if ($day_1 eq q{}) ;
-		$zone  = ' +0000'  if not defined $zone ;
-		$d = $day_1 . $date_rest . $hour . $zone ;
+        SWITCH: {
+        if ( $d =~ m{(\d?)(\d-...-\d{4})(\s\d{2}:\d{2}:\d{2})(\s(?:\+|-)\d{4})?}xo ) {
+                #myprint( "internal: [$1][$2][$3][$4]\n"  ) ;
+                my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4) ;
+                $day_1 = '0' if ($day_1 eq q{}) ;
+                $zone  = ' +0000'  if not defined $zone ;
+                $d = $day_1 . $date_rest . $hour . $zone ;
                 last SWITCH ;
         }
 
-	if ($d =~ m{(?:\w{3,},\s)?(\d{1,2}),?\s+(\w{3,})\s+(\d{2,4})\s+(\d{1,2})(?::|\.)(\d{1,2})(?:(?::|\.)(\d{1,2}))?\s*((?:\+|-)\d{4})?}xo ) {
-        	# Handles any combination of following formats
+        if ($d =~ m{(?:\w{3,},\s)?(\d{1,2}),?\s+(\w{3,})\s+(\d{2,4})\s+(\d{1,2})(?::|\.)(\d{1,2})(?:(?::|\.)(\d{1,2}))?\s*((?:\+|-)\d{4})?}xo ) {
+                # Handles any combination of following formats
                 # Tue, 24 Aug 2010 16:00:00 +0200 -- Standard
                 # 24 Aug 2010 16:00:00 +0200 -- Missing Day of Week
                 # Tue, 24 Aug 97 16:00:00 +0200 -- Two digit year
@@ -7886,11 +9507,11 @@ sub good_date {
                 $sec  = mysprintf( '%02d', $sec ) ;
                 $zone = '+0000' if not defined  $zone  ;
                 $d    = "$day-$month-$year $hour:$min:$sec $zone" ;
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
 
-	if ($d =~ m{(?:.{3})\s(...)\s+(\d{1,2})\s(\d{1,2}):(\d{1,2}):(\d{1,2})\s(?:\w{3})?\s?(\d{4})}xo ) {
-        	# Handles any combination of following formats
+        if ($d =~ m{(?:.{3})\s(...)\s+(\d{1,2})\s(\d{1,2}):(\d{1,2}):(\d{1,2})\s(?:\w{3})?\s?(\d{4})}xo ) {
+                # Handles any combination of following formats
                 # Sun Aug 20 11:55:09 2006
                 # Wed Jan 24 11:58:38 MST 2007
                 # Wed Jan  2 08:40:57 2008
@@ -7902,21 +9523,21 @@ sub good_date {
                 $min  = mysprintf( '%02d', $min  ) ;
                 $sec  = mysprintf( '%02d', $sec  ) ;
                 $d    = "$day-$month-$year $hour:$min:$sec +0000" ;
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
         my %num2mon = qw( 01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec ) ;
 
         if ($d =~ m{(\d{4})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                 # Handles the following format
                 # 2015/07/10 11:05:59 -- Generated by RCS Date tag.
-		#myprint( "$d\n"  ) ;
+                #myprint( "$d\n"  ) ;
                 #myprint( "header: [$1][$2][$3][$4][$5][$6]\n"  ) ;
                 my ($year, $month, $day, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6) ;
                 $month = $num2mon{$month} ;
                 $d = "$day-$month-$year $hour:$min:$sec +0000" ;
-		#myprint( "$d\n"  ) ;
-		last SWITCH ;
-	}
+                #myprint( "$d\n"  ) ;
+                last SWITCH ;
+        }
 
         if ($d =~ m{(\d{2})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                 # Handles the following format
@@ -7927,11 +9548,11 @@ sub good_date {
                 $year = '20' . $year;
                 $month = $num2mon{$month};
                 $d = "$day-$month-$year $hour:$min:$sec +0000";
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
 
-	if ($d =~ m{\w{6,},\s(\w{3})\w+\s+(\d{1,2}),\s(\d{4})\s(\d{2}):(\d{2})\s(AM|PM)}xo ) {
-        	# Handles the following format
+        if ($d =~ m{\w{6,},\s(\w{3})\w+\s+(\d{1,2}),\s(\d{4})\s(\d{2}):(\d{2})\s(AM|PM)}xo ) {
+                # Handles the following format
                 # Saturday, December 14, 2002 05:00 PM - KBtoys.com order confirmations
 
                 my ($month, $day, $year, $hour, $min, $apm) = ($1,$2,$3,$4,$5,$6);
@@ -7940,10 +9561,10 @@ sub good_date {
                 $day = mysprintf( '%02d', $day ) ;
                 $d = "$day-$month-$year $hour:$min:00 +0000" ;
                 last SWITCH ;
-	}
+        }
 
-	if ($d =~ m{(\w{3})\s(\d{1,2})\s(\d{4})\s(\d{2}):(\d{2}):(\d{2})\s((?:\+|-)\d{4})}xo ) {
-        	# Handles the following format
+        if ($d =~ m{(\w{3})\s(\d{1,2})\s(\d{4})\s(\d{2}):(\d{2}):(\d{2})\s((?:\+|-)\d{4})}xo ) {
+                # Handles the following format
                 # Saturday, December 14, 2002 05:00 PM - jr.com order confirmations
 
                 my ($month, $day, $year, $hour, $min, $sec, $zone) = ($1,$2,$3,$4,$5,$6,$7);
@@ -7951,20 +9572,20 @@ sub good_date {
                 $day = mysprintf( '%02d', $day ) ;
                 $d = "$day-$month-$year $hour:$min:$sec $zone";
                 last SWITCH ;
-	}
+        }
 
-	if ($d =~ m{(\d{1,2})-(\w{3})-(\d{4})}xo ) {
-        	# Handles the following format
+        if ($d =~ m{(\d{1,2})-(\w{3})-(\d{4})}xo ) {
+                # Handles the following format
                 # 21-Jun-2001 - register.com domain transfer email circa 2001
 
                 my ($day, $month, $year) = ($1,$2,$3);
                 $day = mysprintf( '%02d', $day);
                 $d = "$day-$month-$year 11:11:11 +0000";
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
 
-    	# unknown or unmatch => return same string
-    	return($d);
+        # unknown or unmatch => return same string
+        return($d);
     }
 
     $d = qq("$d") ;
@@ -7973,15 +9594,16 @@ sub good_date {
 
 
 sub tests_good_date {
+	note( 'Entering tests_good_date()' ) ;
 
-	ok(q{} eq good_date(), 'good_date no arg');
-	ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24-Aug-2010 16:00:00 +0200'), 'good_date internal 2digit zone');
-	ok('"24-Aug-2010 16:00:00 +0000"' eq good_date('24-Aug-2010 16:00:00'), 'good_date internal 2digit no zone');
-	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date( '1-Sep-2010 16:00:00 +0200'), 'good_date internal SP 1digit');
-	ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('Tue, 24 Aug 2010 16:00:00 +0200'), 'good_date header 2digit zone');
-	ok('"01-Sep-2010 16:00:00 +0000"' eq good_date('Wed, 1 Sep 2010 16:00:00'), 'good_date header SP 1digit zone');
-	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200'), 'good_date header SP 1digit zone');
-	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200 (CEST)'), 'good_date header SP 1digit zone');
+        ok(q{} eq good_date(), 'good_date no arg');
+        ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24-Aug-2010 16:00:00 +0200'), 'good_date internal 2digit zone');
+        ok('"24-Aug-2010 16:00:00 +0000"' eq good_date('24-Aug-2010 16:00:00'), 'good_date internal 2digit no zone');
+        ok('"01-Sep-2010 16:00:00 +0200"' eq good_date( '1-Sep-2010 16:00:00 +0200'), 'good_date internal SP 1digit');
+        ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('Tue, 24 Aug 2010 16:00:00 +0200'), 'good_date header 2digit zone');
+        ok('"01-Sep-2010 16:00:00 +0000"' eq good_date('Wed, 1 Sep 2010 16:00:00'), 'good_date header SP 1digit zone');
+        ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200'), 'good_date header SP 1digit zone');
+        ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200 (CEST)'), 'good_date header SP 1digit zone');
         ok('"06-Feb-2009 22:18:08 +0000"' eq good_date('02/06/09 22:18:08'), 'good_date header TemPageR');
         ok('"02-Jan-2008 08:40:57 +0000"' eq good_date('Wed Jan  2 08:40:57 2008'), 'good_date header dice.com support 1digit day');
         ok('"20-Aug-2006 11:55:09 +0000"' eq good_date('Sun Aug 20 11:55:09 2006'), 'good_date header dice.com support 2digit day');
@@ -8002,104 +9624,220 @@ sub tests_good_date {
         ok('"16-Dec-2004 02:01:49 -0500"' eq good_date('Dec 16 2004 02:01:49 -0500'), 'good_date jr.com orders');
         ok('"21-Jun-2001 11:11:11 +0000"' eq good_date('21-Jun-2001'), 'good_date register.com domain transfer');
         ok('"18-Nov-2012 18:34:38 +0100"' eq good_date('Sun, 18 Nov 2012 18:34:38 +0100'), 'good_date pop2imap bug (Westeuropäische Normalzeit)');
-	ok('"19-Sep-2015 16:11:07 +0000"' eq good_date('Date: 2015/09/19 16:11:07 '), 'good_date from RCS date' ) ;
-	return ;
+        ok('"19-Sep-2015 16:11:07 +0000"' eq good_date('Date: 2015/09/19 16:11:07 '), 'good_date from RCS date' ) ;
+
+	note( 'Leaving  tests_good_date()' ) ;
+        return ;
 }
 
 
 sub tests_list_keys_in_2_not_in_1 {
+	note( 'Entering 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}');
 
-	return ;
+        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}');
+
+	note( 'Leaving  tests_list_keys_in_2_not_in_1()' ) ;
+        return ;
 }
 
 sub list_keys_in_2_not_in_1 {
 
-	my $folders1_ref = shift;
-	my $folders2_ref = shift;
-	my @list;
+        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);
+        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_h1, %h2_folders_not_in_h1) ;
-	@h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h1_folders_all, \%h2_folders_all) ;
-	map { $h2_folders_not_in_h1{$_} = 1} @h2_folders_not_in_h1 ;
-	@h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h2_folders_from_1_all, \%h2_folders_not_in_h1) ;
+        my (@h2_folders_not_in_h1, %h2_folders_not_in_h1) ;
+        @h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h1_folders_all, \%h2_folders_all) ;
+        map { $h2_folders_not_in_h1{$_} = 1} @h2_folders_not_in_h1 ;
+        @h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h2_folders_from_1_all, \%h2_folders_not_in_h1) ;
 
-	return( reverse @h2_folders_not_in_h1 );
+        return( reverse @h2_folders_not_in_h1 );
 }
 
-sub delete_folders_in_2_not_in_1 {
 
-	foreach my $folder (@h2_folders_not_in_1) {
-		if ( defined  $delete2foldersonly  and eval "\$folder !~ $delete2foldersonly" ) {
-			myprint( "Not deleting $folder because of --delete2foldersonly $delete2foldersonly\n"  ) ;
-			next ;
-		}
-		if ( defined  $delete2foldersbutnot  and eval "\$folder =~ $delete2foldersbutnot" ) {
-			myprint( "Not deleting $folder because of --delete2foldersbutnot $delete2foldersbutnot\n"  ) ;
-			next ;
-		}
-		my $res = $dry ; # always success in dry mode!
-		$imap2->unsubscribe( $folder ) if ( ! $dry ) ;
-		$res = $imap2->delete( $folder ) if ( ! $dry ) ;
-		if ( $res ) {
-			myprint( "Deleted $folder", "$dry_message", "\n"  ) ;
-		}else{
-			myprint( "Deleting $folder failed", "\n"  ) ;
-		}
+sub tests_match {
+	note( 'Entering tests_match()' ) ;
+
+	# undef serie
+	is( undef, match(  ), 'match: no args => undef' ) ;
+	is( undef, match( 'lalala' ), 'match: one args => undef' ) ;
+
+	# This one gives 0 under a binary made by pp
+	# but 1 under "normal" Perl interpreter. So a PAR bug?
+	#is( 1, match( q{}, q{} ),                'match: q{}      =~ q{}      => 1' ) ;
+	
+	is( 1, match( 'lalala', 'lalala' ),      'match: lalala   =~ lalala => 1' ) ;
+	is( 1, match( 'lalala', '^lalala' ),     'match: lalala   =~ ^lalala  => 1' ) ;
+	is( 1, match( 'lalala',  'lalala$' ),    'match: lalala   =~ lalala$  => 1' ) ;
+	is( 1, match( 'lalala', '^lalala$' ),    'match: lalala   =~ ^lalala$ => 1' ) ;
+	is( 1, match( '_lalala_', 'lalala' ),    'match: _lalala_ =~ lalala   => 1' ) ;
+	is( 1, match( 'lalala', '.*' ),          'match: lalala   =~ .*       => 1' ) ;
+	is( 1, match( 'lalala', '.' ),           'match: lalala   =~ .        => 1' ) ;
+	is( 1, match( '/lalala/', '/lalala/' ),  'match: /lalala/ =~ /lalala/ => 1' ) ;
+
+
+	is( 0, match( 'lalala', 'ooo' ),         'match: lalala   =~ ooo      => 0' ) ;
+	is( 0, match( 'lalala', 'lal_ala' ),     'match: lalala   =~ lal_ala  => 0' ) ;
+	is( 0, match( 'lalala', '\.' ),          'match: lalala   =~ \.       => 0' ) ;
+	is( 0, match( 'lalalaX', '^lalala$' ),   'match: lalalaX  =~ ^lalala$ => 0' ) ;
+	is( 0, match( 'lalala', '/lalala/' ),    'match: lalala   =~ /lalala/ => 1' ) ;
+
+	is( 1, match( 'LALALA', '(?i:lalala)' ),           'match: LALALA   =~ (?i:lalala) => 1' ) ;
+
+	is( undef, match( 'LALALA', '(?{`ls /`})' ),       'match: LALALA   =~ (?{`ls /`})       => undef' ) ;
+	is( undef, match( 'LALALA', '(?{print "CACA"})' ), 'match: LALALA   =~ (?{print "CACA"})  => undef' ) ;
+	is( undef, match( 'CACA', '(??{print "CACA"})' ),  'match: CACA     =~ (??{print "CACA"}) => undef' ) ;
+
+	note( 'Leaving  tests_match()' ) ;
+
+	return ;
+}
+
+sub match {
+	my( $var, $regex ) = @ARG ;
+
+	# undef cases
+	if ( ( ! defined $var ) or ( ! defined $regex ) ) { return ; }
+
+	# normal cases
+	if ( eval { $var =~ $regex } ) {
+		return 1 ;
+	}elsif ( $EVAL_ERROR ) {
+		print "Fatal regex $regex\n" ;
+		return ;
+	} else {
+		return 0 ;
 	}
 	return ;
 }
 
+
+sub tests_notmatch {
+	note( 'Entering tests_notmatch()' ) ;
+
+	# undef serie
+	is( undef, notmatch(  ), 'notmatch: no args => undef' ) ;
+	is( undef, notmatch( 'lalala' ), 'notmatch: one args => undef' ) ;
+
+	is( 1, notmatch( 'lalala', '/lalala/' ),   'notmatch: lalala   !~ /lalala/ => 1' ) ;
+	is( 0, notmatch( '/lalala/', '/lalala/' ), 'notmatch: /lalala/ !~ /lalala/ => 0' ) ;
+	is( 1, notmatch( 'lalala', '/ooo/' ),      'notmatch: lalala   !~ /ooo/    => 1' ) ;
+
+	# This one gives 1 under a binary made by pp
+	# but 0 under "normal" Perl interpreter. So a PAR bug, same in tests_match .
+	#is( 0, notmatch( q{}, q{} ),             'notmatch: q{}      !~ q{}      => 0' ) ;
+
+	is( 0, notmatch( 'lalala', 'lalala' ),   'notmatch: lalala   !~ lalala   => 0' ) ;	
+	is( 0, notmatch( 'lalala', '^lalala' ),  'notmatch: lalala   !~ ^lalala  => 0' ) ;
+	is( 0, notmatch( 'lalala',  'lalala$' ), 'notmatch: lalala   !~ lalala$  => 0' ) ;
+	is( 0, notmatch( 'lalala', '^lalala$' ), 'notmatch: lalala   !~ ^lalala$ => 0' ) ;
+	is( 0, notmatch( '_lalala_', 'lalala' ), 'notmatch: _lalala_ !~ lalala   => 0' ) ;
+	is( 0, notmatch( 'lalala', '.*' ),       'notmatch: lalala   !~ .*       => 0' ) ;
+	is( 0, notmatch( 'lalala', '.' ),        'notmatch: lalala   !~ .        => 0' ) ;
+
+
+	is( 1, notmatch( 'lalala', 'ooo' ), 'notmatch: does not match regex => 1' ) ;
+	is( 1, notmatch( 'lalala', 'lal_ala' ), 'notmatch: does not match regex => 1' ) ;
+	is( 1, notmatch( 'lalala', '\.' ), 'notmatch: matches regex => 0' ) ;
+	is( 1, notmatch( 'lalalaX', '^lalala$' ), 'notmatch: does not match regex => 1' ) ;
+
+	note( 'Leaving  tests_notmatch()' ) ;
+
+	return ;
+}
+
+sub notmatch {
+	my( $var, $regex ) = @ARG ;
+
+	# undef cases
+	if ( ( ! defined $var ) or ( ! defined $regex ) ) { return ; }
+
+	# normal cases
+	if ( eval { $var !~ $regex } ) {
+		return 1 ;
+	}elsif ( $EVAL_ERROR ) {
+		print "Fatal regex $regex\n" ;
+		return ;
+	}else{
+		return 0 ;
+	}
+	return ;
+}
+
+
+sub delete_folders_in_2_not_in_1 {
+
+        foreach my $folder (@h2_folders_not_in_1) {
+                if ( defined  $delete2foldersonly  and eval "\$folder !~ $delete2foldersonly" ) {
+                        myprint( "Not deleting $folder because of --delete2foldersonly $delete2foldersonly\n"  ) ;
+                        next ;
+                }
+                if ( defined  $delete2foldersbutnot  and eval "\$folder =~ $delete2foldersbutnot" ) {
+                        myprint( "Not deleting $folder because of --delete2foldersbutnot $delete2foldersbutnot\n"  ) ;
+                        next ;
+                }
+                my $res = $sync->{dry} ; # always success in dry mode!
+                $imap2->unsubscribe( $folder ) if ( ! $sync->{dry} ) ;
+                $res = $imap2->delete( $folder ) if ( ! $sync->{dry} ) ;
+                if ( $res ) {
+                        myprint( "Deleted $folder", "$sync->{dry_message}", "\n"  ) ;
+                }else{
+                        myprint( "Deleting $folder failed", "\n"  ) ;
+                }
+        }
+        return ;
+}
+
 sub delete_folder {
-        my ( $sync, $imap, $folder, $Side ) = @_ ;
-        if ( ! $sync )   { return ; }
+        my ( $mysync, $imap, $folder, $Side ) = @_ ;
+        if ( ! $mysync )   { return ; }
         if ( ! $imap )   { return ; }
         if ( ! $folder ) { return ; }
         $Side ||= 'HostX' ;
-        
-        my $res = $sync->{dry} ; # always success in dry mode!
-        if ( ! $sync->{dry} ) {
+
+        my $res = $mysync->{dry} ; # always success in dry mode!
+        if ( ! $mysync->{dry} ) {
                 $imap->unsubscribe( $folder ) ;
                 $res = $imap->delete( $folder ) ;
         }
         if ( $res ) {
-        	myprint( "$Side deleted $folder", $sync->{dry_message}, "\n"  ) ;
+                myprint( "$Side deleted $folder", $mysync->{dry_message}, "\n"  ) ;
                 return 1 ;
         }else{
-        	myprint( "$Side deleting $folder failed", "\n"  ) ;
+                myprint( "$Side deleting $folder failed", "\n"  ) ;
                 return ;
         }
 }
 
 sub delete1emptyfolders {
-        my $sync = shift ;
-        if ( ! $sync ) { return ; } # abort if no parameter
-        if ( ! $sync->{delete1emptyfolders} ) { return ; } # abort if --delete1emptyfolders off
-        my $imap = $sync->{imap1} ;
+        my $mysync = shift ;
+        if ( ! $mysync ) { return ; } # abort if no parameter
+        if ( ! $mysync->{delete1emptyfolders} ) { return ; } # abort if --delete1emptyfolders off
+        my $imap = $mysync->{imap1} ;
         if ( ! $imap ) { return ; } # abort if no imap
         if ( $imap->IsUnconnected(  ) ) { return ; } # abort if diesconnected
-        
+
         my %folders_kept ;
         myprint( qq{Host1 deleting empty folders\n} ) ;
-        foreach my $folder ( reverse sort @{ $sync->{h1_folders_wanted} } ) {
+        foreach my $folder ( reverse sort @{ $mysync->{h1_folders_wanted} } ) {
                 my $parenthood = $imap->is_parent( $folder ) ;
                 if ( defined $parenthood and $parenthood ) {
                         myprint( "Host1 folder $folder has subfolders\n" ) ;
@@ -8123,42 +9861,42 @@ sub delete1emptyfolders {
                 if ( uc $folder eq 'INBOX' ) {
                         myprint( "Host1 Not deleting $folder\n" ) ;
                         $folders_kept{ $folder }++ ;
-                        next ; 
+                        next ;
                 }
                 myprint( "Host1 deleting empty folder $folder\n" ) ;
                 # can not delete a SELECTed or EXAMINEd folder so closing it
                 # could changed be SELECT INBOX
-                $imap->close(  ) ; # close after examine does not expunge; anyway expunging an empty folder... 
-                if ( delete_folder( $sync, $imap, $folder, 'Host1' ) ) {
+                $imap->close(  ) ; # close after examine does not expunge; anyway expunging an empty folder...
+                if ( delete_folder( $mysync, $imap, $folder, 'Host1' ) ) {
                         next ; # Deleted, good!
                 }else{
                         $folders_kept{ $folder }++ ;
                         next ; # Not deleted, bad!
                 }
         }
-        remove_deleted_folders_from_wanted_list( $sync, %folders_kept ) ;
+        remove_deleted_folders_from_wanted_list( $mysync, %folders_kept ) ;
         myprint( qq{Host1 ended deleting empty folders\n} ) ;
         return ;
 }
 
 sub remove_deleted_folders_from_wanted_list {
-        my ( $sync, %folders_kept ) = @ARG ;
-        
-        my @h1_folders_wanted_init = @{ $sync->{h1_folders_wanted} } ;
+        my ( $mysync, %folders_kept ) = @ARG ;
+
+        my @h1_folders_wanted_init = @{ $mysync->{h1_folders_wanted} } ;
         my @h1_folders_wanted_last ;
         foreach my $folder ( @h1_folders_wanted_init ) {
                 if ( $folders_kept{ $folder } ) {
                         push @h1_folders_wanted_last, $folder ;
                 }
         }
-        @{ $sync->{h1_folders_wanted} } = @h1_folders_wanted_last ;
+        @{ $mysync->{h1_folders_wanted} } = @h1_folders_wanted_last ;
         return ;
 }
 
 sub examine_folder_and_count {
         my ( $imap, $folder, $Side ) = @_ ;
         $Side ||= 'HostX' ;
-        
+
         if ( ! examine_folder( $imap, $folder, $Side ) ) {
                 return ;
         }
@@ -8168,6 +9906,8 @@ sub examine_folder_and_count {
 
 
 sub tests_delete1emptyfolders {
+	note( 'Entering tests_delete1emptyfolders()' ) ;
+
 
         is( undef, delete1emptyfolders(  ), q{delete1emptyfolders: undef} ) ;
         my $syncT ;
@@ -8175,7 +9915,7 @@ sub tests_delete1emptyfolders {
         my $imapT ;
         $syncT->{imap1} = $imapT ;
         is( undef, delete1emptyfolders( $syncT ), q{delete1emptyfolders: undef imap} ) ;
-        
+
         require Test::MockObject ;
         $imapT = Test::MockObject->new(  ) ;
         $syncT->{imap1} = $imapT ;
@@ -8186,7 +9926,7 @@ sub tests_delete1emptyfolders {
         # Now connected tests
         $imapT->set_false( 'IsUnconnected' ) ;
         $imapT->mock( 'LastError', sub { q{LastError mocked} } ) ;
-        
+
         $syncT->{delete1emptyfolders} = 0 ;
         tests_delete1emptyfolders_unit(
                 $syncT,
@@ -8207,7 +9947,7 @@ sub tests_delete1emptyfolders {
 
         # No parents but examine false for all => skip all
         $imapT->set_false( 'is_parent', 'examine' ) ;
-        
+
         tests_delete1emptyfolders_unit(
                 $syncT,
                 [ qw{ INBOX DELME1 DELME2 } ],
@@ -8267,26 +10007,28 @@ sub tests_delete1emptyfolders {
                 q{tests_delete1emptyfolders: 0 EXISTS 0 by messages() delete folders, keep INBOX}
         ) ;
 
-
-
-
+	note( 'Leaving  tests_delete1emptyfolders()' ) ;
         return ;
 }
 
 sub tests_delete1emptyfolders_unit {
+	note( 'Entering tests_delete1emptyfolders_unit()' ) ;
+
         my $syncT  = shift ;
         my $folders1wanted_init_ref = shift ;
         my $folders1wanted_after_ref = shift ;
         my $comment = shift || q{delete1emptyfolders:} ;
-        
+
         my @folders1wanted_init  = @{ $folders1wanted_init_ref } ;
         my @folders1wanted_after = @{ $folders1wanted_after_ref } ;
 
         @{ $syncT->{h1_folders_wanted} } = @folders1wanted_init ;
-        
+
         is_deeply( $syncT->{h1_folders_wanted}, \@folders1wanted_init, qq{$comment, init check} ) ;
         delete1emptyfolders( $syncT ) ;
         is_deeply( $syncT->{h1_folders_wanted}, \@folders1wanted_after, qq{$comment, after check} ) ;
+
+	note( 'Leaving  tests_delete1emptyfolders_unit()' ) ;
         return ;
 }
 
@@ -8300,6 +10042,8 @@ sub extract_header {
 }
 
 sub tests_extract_header {
+	note( 'Entering tests_extract_header()' ) ;
+
 
 
 my $h = <<'EOM';
@@ -8321,7 +10065,8 @@ EOM
 
 
 
-	return ;
+	note( 'Leaving  tests_extract_header()' ) ;
+        return ;
 }
 
 sub decompose_header{
@@ -8361,6 +10106,8 @@ sub decompose_header{
 
 
 sub tests_decompose_header{
+	note( 'Entering tests_decompose_header()' ) ;
+
 
         my $header_dec ;
 
@@ -8373,7 +10120,7 @@ KEY_2: VAL_2
 KEY_3: VAL_3
 KEY_1: VAL_1_other
 KEY_4: VAL_4
-	VAL_4_+
+        VAL_4_+
 KEY_5 BLANC:  VAL_5
 
 KEY_6_BAD_BODY: VAL_6
@@ -8462,12 +10209,32 @@ EOH
         ok( 'VAL_2 VAL_2_+ VAL_2_++'
         eq $header_dec->{ 'KEY_2' }[0], 'decompose_header: Bad header VAL_2 VAL_2_+ VAL_2_++' ) ;
 
-	return ;
+	note( 'Leaving  tests_decompose_header()' ) ;
+        return ;
+}
+
+sub tests_epoch {
+	note( 'Entering tests_epoch()' ) ;
+
+        ok( '1282658400' eq epoch( '24-Aug-2010 16:00:00 +0200' ), 'epoch 24-Aug-2010 16:00:00 +0200 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 14:00:00 +0000' ), 'epoch 24-Aug-2010 14:00:00 +0000 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 12:00:00 -0200' ), 'epoch 24-Aug-2010 12:00:00 -0200 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 16:01:00 +0201' ), 'epoch 24-Aug-2010 16:01:00 +0201 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 14:01:00 +0001' ), 'epoch 24-Aug-2010 14:01:00 +0001 -> 1282658400' ) ;
+
+        ok( '1280671200' eq epoch( '1-Aug-2010 16:00:00 +0200' ), 'epoch 1-Aug-2010 16:00:00 +0200 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 14:00:00 +0000' ), 'epoch 1-Aug-2010 14:00:00 +0000 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 12:00:00 -0200' ), 'epoch 1-Aug-2010 12:00:00 -0200 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 16:01:00 +0201' ), 'epoch 1-Aug-2010 16:01:00 +0201 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 14:01:00 +0001' ), 'epoch 1-Aug-2010 14:01:00 +0001 -> 1280671200' ) ;
+
+	note( 'Leaving  tests_epoch()' ) ;
+        return ;
 }
 
 sub epoch {
         # incoming format:
-	# internal date 24-Aug-2010 16:00:00 +0200
+        # internal date 24-Aug-2010 16:00:00 +0200
 
         # outgoing format: epoch
 
@@ -8495,210 +10262,256 @@ sub epoch {
         return( $time ) ;
 }
 
-sub tests_epoch {
-        ok( '1282658400' eq epoch( '24-Aug-2010 16:00:00 +0200' ), 'epoch 24-Aug-2010 16:00:00 +0200 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 14:00:00 +0000' ), 'epoch 24-Aug-2010 14:00:00 +0000 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 12:00:00 -0200' ), 'epoch 24-Aug-2010 12:00:00 -0200 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 16:01:00 +0201' ), 'epoch 24-Aug-2010 16:01:00 +0201 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 14:01:00 +0001' ), 'epoch 24-Aug-2010 14:01:00 +0001 -> 1282658400' ) ;
+sub tests_add_header {
+	note( 'Entering tests_add_header()' ) ;
 
-        ok( '1280671200' eq epoch( '1-Aug-2010 16:00:00 +0200' ), 'epoch 1-Aug-2010 16:00:00 +0200 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 14:00:00 +0000' ), 'epoch 1-Aug-2010 14:00:00 +0000 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 12:00:00 -0200' ), 'epoch 1-Aug-2010 12:00:00 -0200 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 16:01:00 +0201' ), 'epoch 1-Aug-2010 16:01:00 +0201 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 14:01:00 +0001' ), 'epoch 1-Aug-2010 14:01:00 +0001 -> 1280671200' ) ;
-	return ;
+        ok( 'Message-Id: ' eq add_header(), 'add_header no arg' ) ;
+        ok( 'Message-Id: <123456789@imapsync>' eq add_header( '123456789' ), 'add_header 123456789' ) ;
+
+	note( 'Leaving  tests_add_header()' ) ;
+        return ;
 }
 
 sub add_header {
-	my $header_uid = shift || 'mistake' ;
-	my $header_Message_Id = 'Message-Id: <' . $header_uid . '@imapsync>' ;
+        my $header_uid = shift || 'mistake' ;
+        my $header_Message_Id = 'Message-Id: <' . $header_uid . '@imapsync>' ;
         return( $header_Message_Id ) ;
 }
 
-sub tests_add_header {
-	ok( 'Message-Id: ' eq add_header(), 'add_header no arg' ) ;
-	ok( 'Message-Id: <123456789@imapsync>' eq add_header(123456789), 'add_header 123456789' ) ;
 
-	return ;
+
+
+sub tests_max_line_length {
+	note( 'Entering tests_max_line_length()' ) ;
+
+        ok( 0 == max_line_length( q{} ), 'max_line_length: 0 == null string' ) ;
+        ok( 1 == max_line_length( "\n" ), 'max_line_length: 1 == \n' ) ;
+        ok( 1 == max_line_length( "\n\n" ), 'max_line_length: 1 == \n\n' ) ;
+        ok( 1 == max_line_length( "\n" x 500 ), 'max_line_length: 1 == 500 \n' ) ;
+        ok( 1 == max_line_length( 'a' ), 'max_line_length: 1 == a' ) ;
+        ok( 2 == max_line_length( "a\na" ), 'max_line_length: 2 == a\na' ) ;
+        ok( 2 == max_line_length( "a\na\n" ), 'max_line_length: 2 == a\na\n' ) ;
+        ok( 3 == max_line_length( "a\nab\n" ), 'max_line_length: 3 == a\nab\n' ) ;
+        ok( 3 == max_line_length( "a\nab\n" x 10_000 ), 'max_line_length: 3 == 10_000 a\nab\n' ) ;
+        ok( 3 == max_line_length( "a\nab\nabc" ), 'max_line_length: 3 == a\nab\nabc' ) ;
+
+        ok( 4 == max_line_length( "a\nab\nabc\n" ), 'max_line_length: 4 == a\nab\nabc\n' ) ;
+        ok( 5 == max_line_length( "a\nabcd\nabc\n" ), 'max_line_length: 5 == a\nabcd\nabc\n' ) ;
+        ok( 5 == max_line_length( "a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd" ), 'max_line_length: 5 == a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd' ) ;
+
+	note( 'Leaving  tests_max_line_length()' ) ;
+        return ;
 }
 
-sub tests_Banner{
-
-	my $imap = Mail::IMAPClient->new(  ) ;
-        ok( 'lalala' eq $imap->Banner('lalala'), 'Banner set lalala' ) ;
-        ok( 'lalala' eq $imap->Banner(), 'Banner returns lalala' ) ;
-	return ;
-}
-
-
-
-
 sub max_line_length {
-	my $string = shift ;
+        my $string = shift ;
         my $max = 0 ;
 
         while ( $string =~ m/([^\n]*\n?)/msxg ) {
-        	$max = max( $max, length $1 ) ;
+                $max = max( $max, length $1 ) ;
         }
-	return( $max ) ;
+        return( $max ) ;
 }
 
-sub tests_max_line_length {
-	ok( 0 == max_line_length( q{} ), 'max_line_length: 0 == null string' ) ;
-	ok( 1 == max_line_length( "\n" ), 'max_line_length: 1 == \n' ) ;
-	ok( 1 == max_line_length( "\n\n" ), 'max_line_length: 1 == \n\n' ) ;
-	ok( 1 == max_line_length( "\n" x 500 ), 'max_line_length: 1 == 500 \n' ) ;
-	ok( 1 == max_line_length( 'a' ), 'max_line_length: 1 == a' ) ;
-	ok( 2 == max_line_length( "a\na" ), 'max_line_length: 2 == a\na' ) ;
-	ok( 2 == max_line_length( "a\na\n" ), 'max_line_length: 2 == a\na\n' ) ;
-	ok( 3 == max_line_length( "a\nab\n" ), 'max_line_length: 3 == a\nab\n' ) ;
-	ok( 3 == max_line_length( "a\nab\n" x 10000 ), 'max_line_length: 3 == 10000 a\nab\n' ) ;
-	ok( 3 == max_line_length( "a\nab\nabc" ), 'max_line_length: 3 == a\nab\nabc' ) ;
 
-	ok( 4 == max_line_length( "a\nab\nabc\n" ), 'max_line_length: 4 == a\nab\nabc\n' ) ;
-	ok( 5 == max_line_length( "a\nabcd\nabc\n" ), 'max_line_length: 5 == a\nabcd\nabc\n' ) ;
-	ok( 5 == max_line_length( "a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd" ), 'max_line_length: 5 == a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd' ) ;
+sub tests_setlogfile {
+	note( 'Entering tests_setlogfile()' ) ;
+
+	my $mysync = {} ;
+        $mysync->{logdir}  = 'vallogdir' ;
+        $mysync->{logfile} = 'vallogfile.txt' ;
+        is( 'vallogdir/vallogfile.txt', setlogfile( $mysync ),
+                'setlogfile: logdir vallogdir, logfile vallogfile.txt, vallogdir/vallogfile.txt' ) ;
+
+	SKIP: {
+	skip( 'Too hard to have a well known timezone on Windows', 6 ) if ( 'MSWin32' eq $OSNAME ) ;
+
+        local $ENV{TZ} = 'GMT' ;
+
+	$mysync = {
+                timestart => 2,
+	} ;
+
+        is( 'LOG_imapsync/1970_01_01_00_00_02_000__.txt', setlogfile( $mysync ),
+                'setlogfile: default is like LOG_imapsync/1970_01_01_00_00_02_000__.txt' ) ;
+
+        $mysync = {
+                timestart => 2,
+                user1     => 'user1',
+                user2     => 'user2',
+        } ;
+
+        is( 'LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: default is like LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync->{logdir}  = undef ;
+        $mysync->{logfile} = undef ;
+        is( 'LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: logdir undef, LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync->{logdir} = q{} ;
+        $mysync->{logfile} = undef ;
+        is( '1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: logdir empty, 1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync->{logdir} = 'vallogdir' ;
+        $mysync->{logfile} = undef ;
+        is( 'vallogdir/1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: logdir vallogdir, vallogdir/1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync = {
+                user1     => 'us/er1a*|?:"<>b',
+                user2     => 'u/ser2a*|?:"<>b',
+        } ;
+
+        is( 'LOG_imapsync/1970_01_01_00_00_00_000_us_er1a_______b_u_ser2a_______b.txt', setlogfile( $mysync ),
+                'setlogfile: logdir undef, LOG_imapsync/1970_01_01_00_00_00_000_us_er1a_______b_u_ser2a_______b.txt' ) ;
+
+
+	} ;
+
+	note( 'Leaving  tests_setlogfile()' ) ;
+        return ;
+}
+
+
+sub tests_move_slash {
+	note( 'Entering tests_move_slash()' ) ;
+
+	is( undef, move_slash(  ), 'move_slash: no parameters => undef' ) ;
+	is( '_', move_slash( '/' ), 'move_slash: / => _' ) ;
+	is( '_abc_def_', move_slash( '/abc/def/' ), 'move_slash: /abc/def/ => _abc_def_' ) ;
+	note( 'Leaving  tests_move_slash()' ) ;
 	return ;
 }
 
+sub move_slash {
+	my $string = shift ;
+
+	if ( ! defined $string ) { return ; }
+
+	$string =~ tr{/}{_} ;
+
+	return(  $string ) ;
+}
+
 sub setlogfile {
         my( $mysync ) = shift ;
+	my $suffix = ( filter_forbidden_characters( move_slash( $mysync->{user1} ) ) || q{} )
+			. '_' .
+			( filter_forbidden_characters( move_slash( $mysync->{user2} ) ) || q{} ) ;
+
         $mysync->{logdir}  = defined $mysync->{logdir}  ? $mysync->{logdir}  : 'LOG_imapsync' ;
         $mysync->{logfile} = defined $mysync->{logfile} ? "$mysync->{logdir}/$mysync->{logfile}" :
-                logfile( $mysync->{timestart}, $mysync->{user2}, $mysync->{logdir} ) ;
+                logfile( $mysync->{timestart}, $suffix, $mysync->{logdir} ) ;
         #myprint( "logdir  = $mysync->{logdir}\n"  ) ;
         #myprint( "logfile = $mysync->{logfile}\n"  ) ;
         return( $mysync->{logfile} ) ;
 }
 
-sub tests_setlogfile {
-        my $mysync = {
-                timestart => 2,
-                user2     => 'user2',
+
+sub tests_logfile {
+	note( 'Entering tests_logfile()' ) ;
+
+        SKIP: {
+                # Too hard to have a well known timezone on Windows
+                skip( 'Too hard to have a well known timezone on Windows', 8 ) if ( 'MSWin32' eq $OSNAME ) ;
+
+                local $ENV{TZ} = 'GMT' ;
+                { POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
+                        is( '1970_01_01_00_00_00_000.txt', logfile(  ),           'logfile: no args    => 1970_01_01_00_00_00.txt' ) ;
+                        is( '1970_01_01_00_00_00_000.txt', logfile( 0 ),          'logfile: 0          => 1970_01_01_00_00_00.txt' ) ;
+                        is( '1970_01_01_00_01_01_000.txt', logfile( 61 ),         'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
+                        is( '1970_01_01_00_01_01_234.txt', logfile( 61.234 ),     'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
+                        is( '2010_08_24_14_00_00_000.txt', logfile( 1_282_658_400 ), 'logfile: 1_282_658_400 => 2010_08_24_14_00_00.txt' ) ;
+                        is( '2010_08_24_14_01_01_000.txt', logfile( 1_282_658_461 ), 'logfile: 1_282_658_461 => 2010_08_24_14_01_01.txt' ) ;
+                        is( '2010_08_24_14_01_01_000_poupinette.txt', logfile( 1_282_658_461, 'poupinette' ), 'logfile: 1_282_658_461 poupinette => 2010_08_24_14_01_01_poupinette.txt' ) ;
+                        is( '2010_08_24_14_01_01_000_removeblanks.txt', logfile( 1_282_658_461, '   remove blanks  ' ), 'logfile: 1_282_658_461   remove blanks   => 2010_08_24_14_01_01_000_removeblanks' ) ;
+                }
+                POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
         } ;
 
-        ok( 'LOG_imapsync/1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: default is like LOG_imapsync/1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir}  = undef ;
-        $mysync->{logfile} = undef ;
-        ok( 'LOG_imapsync/1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir undef, LOG_imapsync/1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir} = q{} ;
-        $mysync->{logfile} = undef ;
-        ok( '1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir empty, 1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir} = 'vallogdir' ;
-        $mysync->{logfile} = undef ;
-        ok( 'vallogdir/1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir vallogdir, vallogdir/1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir}  = 'vallogdir' ;
-        $mysync->{logfile} = 'vallogfile.txt' ;
-        ok( 'vallogdir/vallogfile.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir vallogdir, logfile vallogfile.txt, vallogdir/vallogfile.txt' ) ;
-
+	note( 'Leaving  tests_logfile()' ) ;
         return ;
 }
 
 
-sub logfile {
-	my ( $time, $suffix, $dir ) = @_ ;
 
-	$time   ||= 0 ;
-	$suffix ||= q{} ;
-	my $sep_suffix = ( $suffix ) ? '_' : q{} ;
+sub logfile  {
+        my ( $time, $suffix, $dir ) = @_ ;
+
+        $time   ||= 0 ;
+        $suffix ||= q{} ;
+	$suffix =~ tr/ //ds ;
+        my $sep_suffix = ( $suffix ) ? '_' : q{} ;
         $dir    ||= q{} ;
-	my $sep_dir = ( $dir ) ? '/' : q{} ;
+        my $sep_dir = ( $dir ) ? '/' : q{} ;
 
-	my $date_str = POSIX::strftime( '%Y_%m_%d_%H_%M_%S', localtime $time ) ;
+        my $date_str = POSIX::strftime( '%Y_%m_%d_%H_%M_%S', localtime $time ) ;
+	# Because of ab tests or web access, more than one sync withing one second is possible
+	# so we add millisecons
+	$date_str .= sprintf "_%03d", ($time - int( $time ) ) * 1000 ; # without rounding
         my $logfile = "${dir}${sep_dir}${date_str}${sep_suffix}${suffix}.txt" ;
-	$debug and myprint( "date_str: $date_str\n"  ) ;
-	$debug and myprint( "logfile : $logfile\n"  ) ;
-	return( $logfile ) ;
+        $debug and myprint( "date_str: $date_str\n"  ) ;
+        $debug and myprint( "logfile : $logfile\n"  ) ;
+        return( $logfile ) ;
 }
 
-sub tests_logfile {
-	SKIP: {
-		# Too hard to have a well known timezone on Windows
-		skip( 'Too hard to have a well known timezone on Windows', 6 ) if ( 'MSWin32' eq $OSNAME ) ;
-
-		local $ENV{TZ} = 'GMT' ;
-		{ POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
-			ok( '1970_01_01_00_00_00.txt' eq logfile(  ),           'logfile: no args    => 1970_01_01_00_00_00.txt' ) ;
-			ok( '1970_01_01_00_00_00.txt' eq logfile( 0 ),          'logfile: 0          => 1970_01_01_00_00_00.txt' ) ;
-			ok( '1970_01_01_00_01_01.txt' eq logfile( 61 ),         'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
-			ok( '2010_08_24_14_00_00.txt' eq logfile( 1282658400 ), 'logfile: 1282658400 => 2010_08_24_14_00_00.txt' ) ;
-			ok( '2010_08_24_14_01_01.txt' eq logfile( 1282658461 ), 'logfile: 1282658461 => 2010_08_24_14_01_01.txt' ) ;
-			ok( '2010_08_24_14_01_01_poupinette.txt' eq logfile( 1282658461, 'poupinette' ), 'logfile: 1282658461 poupinette => 2010_08_24_14_01_01_poupinette.txt' ) ;
-                }
-		POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
-	} ;
-	return ;
-}
-
-
-
-
-
-
-
-
-
-
-
-
 
 
 sub tests_million_folders_baby_2 {
-	my %long ;
-	@long{ 1 .. 900_000 } = (1) x 900_000 ;
-	#myprint( %long, "\n"  ) ;
-	my $pasglop = 0 ;
-	foreach my $elem (  1 .. 900_000 ) {
-		#$debug and myprint( "$elem "  ) ;
-		if ( not exists  $long{ $elem }  ) {
-			$pasglop++ ;
-		}
-	}
+	note( 'Entering tests_million_folders_baby_2()' ) ;
+
+        my %long ;
+        @long{ 1 .. 900_000 } = (1) x 900_000 ;
+        #myprint( %long, "\n"  ) ;
+        my $pasglop = 0 ;
+        foreach my $elem (  1 .. 900_000 ) {
+                #$debug and myprint( "$elem "  ) ;
+                if ( not exists  $long{ $elem }  ) {
+                        $pasglop++ ;
+                }
+        }
         ok( 0 == $pasglop, 'tests_million_folders_baby_2: search among 900_000' ) ;
-	# myprint( "$pasglop\n"  ) ;
+        # myprint( "$pasglop\n"  ) ;
+
+	note( 'Leaving  tests_million_folders_baby_2()' ) ;
         return ;
 }
 
 
 
 sub tests_always_fail {
-	ok( 0 == 1, '0 == 1' ) ;
-	ok( 1 == 1, '1 == 1' ) ;
+	note( 'Entering tests_always_fail()' ) ;
+
+        is( 0, 1, 'always_fail: 0 is 1' ) ;
+
+	note( 'Leaving  tests_always_fail()' ) ;
         return ;
 }
 
 sub logfileprepa {
-	my $logfile = shift ;
+        my $logfile = shift ;
 
-	my $dirname = dirname( $logfile ) ;
-	is_valid_directory( $dirname ) || return( 0 ) ;
-	return( 1 ) ;
+        my $dirname = dirname( $logfile ) ;
+        do_valid_directory( $dirname ) || return( 0 ) ;
+        return( 1 ) ;
 }
 
 sub teelaunch {
         my $mysync = shift ;
-	my $logfile = $mysync->{logfile} ;
-	logfileprepa( $logfile ) || croak "Error no valid directory to write log file $logfile : $!" ;
-	my $logfile_handle ;
-	open $logfile_handle, '>', $logfile
-	  or croak( "Can not open $logfile for write: $!" ) ;
-	my $tee = IO::Tee->new( $logfile_handle, \*STDOUT ) ;
-	*STDERR = *$tee{IO} ;
-	select $tee ;
+        my $logfile = $mysync->{logfile} ;
+        logfileprepa( $logfile ) || croak "Error no valid directory to write log file $logfile : $OS_ERROR" ;
+
+        open my $logfile_handle, '>', $logfile
+          or croak( "Can not open $logfile for write: $OS_ERROR" ) ;
+        my $tee = IO::Tee->new( $logfile_handle, \*STDOUT ) ;
+        *STDERR = *$tee{IO} ;
+        select $tee ;
         $tee->autoflush( 1 ) ;
         $mysync->{logfile_handle} = $logfile_handle ;
         $mysync->{tee} = $tee ;
-	return $logfile_handle ;
+        return $logfile_handle ;
 }
 
 sub getpwuid_any_os {
@@ -8706,311 +10519,641 @@ sub getpwuid_any_os {
 
         return( scalar  getlogin ) if ( 'MSWin32' eq $OSNAME ) ; # Windows system
         return( scalar  getpwuid $uid ) ; # Unix system
+
+
+}
+
+sub simulong {
+	my $max_seconds = shift ;
+	my $division = 5 ;
+	my $last = $division * $max_seconds ;
+	foreach my $i ( 1 .. ( $last ) ) {
+		myprint( "Are you still here $i/$last\n" ) ;
+		#myprint( "Are you still here $i/$last\n" . ( "Ah" x 40 . "\n") x 4000 ) ;
+		sleep( 1 / $division ) ;
+	}
+
+	return ;
 }
 
 
 
+sub printenv {
+        myprint( "Environment variables listing:\n",
+		( map { "$_ => $ENV{$_}\n" } sort keys  %ENV),
+		"Environment variables listing end\n"   ) ;
+	return ;
+}
+
+sub testsexit {
+	my $mysync = shift ;
+        if ( ! ( $mysync->{ tests }  or $mysync->{ testsdebug } or $mysync->{ testsunit } ) ) {
+		return ;
+	}
+        my $test_builder = Test::More->builder ;
+        tests( $mysync ) ; 
+        testsdebug( $mysync ) ;
+	testunitsession( $mysync ) ;
+
+	my @summary = $test_builder->summary() ;
+	my @details = $test_builder->details() ;
+	my $nb_tests_run = scalar( @summary ) ;
+	my $nb_tests_expected = $test_builder->expected_tests() ;
+	my $nb_tests_failed = count_0s( @summary ) ;
+	my $tests_failed = report_failures( @details ) ;
+	if ( $nb_tests_failed or ( $nb_tests_run != $nb_tests_expected ) ) {
+		#$test_builder->reset(  ) ;
+		myprint( "Summary of tests: failed $nb_tests_failed tests, run $nb_tests_run tests, expected to run $nb_tests_expected tests.\n",
+                "List of failed tests:\n", $tests_failed ) ;
+		exit $EXIT_TESTS_FAILED ;
+	}
+        exit ;
+	#return ;
+}
+
+sub after_get_options {
+	my $numopt = shift ;
+
+
+        # exit with --help option or no option at all
+        $debug and myprint( "numopt:$numopt\n"  ) ;
+        myprint( usage( $sync ) ) and exit  if ( $help or not $numopt ) ;
+
+        return ;
+}
+
+sub easyany {
+	my $mysync = shift ;
+
+	# Gmail
+	if ( $mysync->{gmail1} and $mysync->{gmail2} ) {
+		$debug and myprint( "gmail1 gmail2\n") ;
+		gmail12( $mysync ) ;
+		return ;
+	}
+	if ( $mysync->{gmail1}  ) {
+		$debug and myprint( "gmail1\n" ) ;
+		gmail1( $mysync ) ;
+	}
+	if ( $mysync->{gmail2} ) {
+		$debug and myprint( "gmail2\n" ) ;
+		gmail2( $mysync ) ;
+	}
+	# Office 365
+	if ( $mysync->{office1} ) {
+		office1( $mysync ) ;
+	}
+
+	if ( $mysync->{office2} ) {
+		office2( $mysync ) ;
+	}
+
+	# Domino
+	if ( $mysync->{domino1} ) {
+		domino1( $mysync ) ;
+	}
+
+	if ( $mysync->{domino2} ) {
+		domino2( $mysync ) ;
+	}
+
+
+	return ;
+}
+
+# From https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt
+sub gmail12  {
+	my $mysync = shift ;
+	# Gmail at host1 and host2
+	$mysync->{host1} ||= 'imap.gmail.com' ;
+	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
+	$mysync->{host2} ||= 'imap.gmail.com' ;
+	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
+	$mysync->{maxbytespersecond} ||= 20_000 ; # should be 10_000 computed from by Gmail documentation
+	$mysync->{maxbytesafter} ||= 1_000_000_000 ;
+	$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
+	$mysync->{maxsleep} = $MAX_SLEEP ;
+	
+	push @exclude, '\[Gmail\]$' ;
+	return ;
+}
+
+sub gmail1  {
+	my $mysync = shift ;
+	# Gmail at host2
+	$mysync->{host1} ||= 'imap.gmail.com' ;
+	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
+	$mysync->{maxbytespersecond} ||= 40_000 ; # should be 20_000 computed from by Gmail documentation
+	$mysync->{maxbytesafter} ||= 2_500_000_000 ;
+	$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
+	$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;
+	$mysync->{maxsleep} = $MAX_SLEEP ;
+	
+	push @useheader, 'X-Gmail-Received', 'Message-Id' ;
+	push @regextrans2, 's,\[Gmail\].,,' ;
+	push @folderlast, '[Gmail]/All Mail' ;
+	return ;
+}
+
+sub gmail2  {
+	my $mysync = shift ;
+	# Gmail at host2
+	$mysync->{host2} ||= 'imap.gmail.com' ;
+	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
+	$mysync->{maxbytespersecond} ||= 20_000 ; # should be 10_000 computed from by Gmail documentation
+	$mysync->{maxbytesafter} ||= 1_000_000_000 ; # In fact it is documented as half: 500_000_000
+	$maxsize ||= 25_000_000 ;
+	$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
+	$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;
+	$expunge1            = ( defined $expunge1 )  ? $expunge1  : 1 ;
+	$addheader           = ( defined $addheader ) ? $addheader : 1 ;
+	$mysync->{maxsleep} = $MAX_SLEEP ;
+	
+	push @exclude, '\[Gmail\]$' ;
+	push @useheader, 'X-Gmail-Received', 'Message-Id' ;
+	push @regextrans2, 's,\[Gmail\].,,' ;
+	push @regextrans2, 's/[ ]+/_/g' ;
+	push @regextrans2, q{s/['\\^"]/_/g} ; # Verified this
+	push @folderlast, "[Gmail]/All Mail" ;
+	return ;
+}
+
+
+# From https://imapsync.lamiral.info/FAQ.d/FAQ.Exchange.txt
+sub office1 {
+	# Office 365 at host1
+	my $mysync = shift ;
+
+	$debug and myprint( "office1 configuration\n" ) ;
+	$mysync->{host1} ||= 'outlook.office365.com' ;
+	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
+	return ;
+}
+
+sub office2 {
+	# Office 365 at host1
+	my $mysync = shift ;
+	$mysync->{host2} ||= 'outlook.office365.com' ;
+	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
+	$maxsize ||= 45_000_000 ;
+	$mysync->{maxmessagespersecond} ||= 4 ;
+	push @regexflag, 's/\\Flagged//g' ;
+	$disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
+	push @regexmess, 's,(.{10500}),$1\r\n,g' ;
+	return ;
+}
+
+sub exchange1 {
+	# Exchange 2010/2013 at host1
+
+	# Well nothing to do so far
+	return ;
+}
+
+sub exchange2 {
+	# Exchange 2010/2013 at host2
+	my $mysync = shift ;
+	$maxsize ||= 10_000_000 ;
+	$mysync->{maxmessagespersecond} ||= 4 ;
+	push @regexflag, 's/\\Flagged//g' ;
+	$disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
+	push @regexmess, 's,(.{10500}),$1\r\n,g' ;
+	return ;
+}
+
+sub domino1 {
+	# Domino at host1
+	my $mysync = shift ;
+
+	$sep1    = q{\\} ;
+	$prefix1 = q{} ;
+	$messageidnodomain = ( defined $messageidnodomain ) ? $messageidnodomain : 1 ;
+	return ;
+}
+
+sub domino2 {
+	# Domino at host1
+	my $mysync = shift ;
+
+	$sep2    = q{\\} ;
+	$prefix2 = q{} ;
+	$messageidnodomain = ( defined $messageidnodomain ) ? $messageidnodomain : 1 ;
+	push @regextrans2, 's,^Inbox\\\\(.*),$1,i' ;
+	return ;
+}
+
+
+sub tests_resolv {
+	note( 'Entering tests_resolv()' ) ;
+	
+	# is( , resolv(  ), 'resolv:  => ' ) ;
+	is( undef, resolv(  ), 'resolv: no args => undef' ) ;
+	is( undef, resolv( '' ), 'resolv: empty string => undef' ) ;
+	is( undef, resolv( 'hostnotexist' ), 'resolv: hostnotexist => undef' ) ;
+	is( '127.0.0.1', resolv( '127.0.0.1' ), 'resolv: 127.0.0.1 => 127.0.0.1' ) ;
+	is( '127.0.0.1', resolv( 'localhost' ), 'resolv: localhost => 127.0.0.1' ) ;
+	is( '5.135.158.182', resolv( 'imapsync.lamiral.info' ), 'resolv: imapsync.lamiral.info => 5.135.158.182' ) ;
+	
+	# ip6-localhost ( in /etc/hosts )
+	is( '::1', resolv( 'ip6-localhost' ), 'resolv: ip6-localhost => ::1' ) ;
+	is( '::1', resolv( '::1' ), 'resolv: ::1 => ::1' ) ;
+	# ks2
+	is( '2001:41d0:8:d8b6::1', resolv( '2001:41d0:8:d8b6::1' ),  'resolv:  2001:41d0:8:d8b6::1 => 2001:41d0:8:d8b6::1' ) ;
+	is( '2001:41d0:8:d8b6::1', resolv( 'ks2ipv6.lamiral.info' ), 'resolv: ks2ipv6.lamiral.info => 2001:41d0:8:d8b6::1' ) ;
+	# ks3
+	is( '2001:41d0:8:bebd::1', resolv( '2001:41d0:8:bebd::1' ),  'resolv:  2001:41d0:8:bebd::1 => 2001:41d0:8:bebd::1' ) ;
+	is( '2001:41d0:8:bebd::1', resolv( 'ks3ipv6.lamiral.info' ), 'resolv: ks3ipv6.lamiral.info => 2001:41d0:8:bebd::1' ) ;
+	
+	
+	note( 'Leaving  tests_resolv()' ) ;
+        return ;
+}
+
+
+
+sub resolv {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+        my $addr ;
+	if ( defined &Socket::getaddrinfo ) {
+		$addr = resolv_with_getaddrinfo( $host ) ;
+		return( $addr ) ;
+	}
+        
+        
+        
+        my $iaddr = inet_aton( $host ) ;
+        if ( ! $iaddr ) { return ; }
+        $addr = inet_ntoa( $iaddr ) ;
+	
+	return $addr ;
+}
+
+sub resolv_with_getaddrinfo {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+
+	my ( $err, @res ) = Socket::getaddrinfo( $host, "", { socktype => Socket::SOCK_RAW } ) ;
+	if (  $err ) {
+		myprint( "Cannot getaddrinfo of $host: $err\n" ) ;
+		return ;
+	}
+
+	my @addr ;
+	while( my $ai = shift @res ) {
+		my ( $err, $ipaddr ) = Socket::getnameinfo( $ai->{addr}, Socket::NI_NUMERICHOST(), Socket::NIx_NOSERV() ) ;
+		if ( $err ) {
+			myprint( "Cannot getnameinfo of $host: $err\n" ) ;
+			return ;
+		}
+		$debug and myprint "$host => $ipaddr\n" ;
+		push @addr, $ipaddr ;
+
+		my ( $err_r, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
+		$debug and myprint "$host => $ipaddr => $reverse\n" ;
+	}
+	
+        return $addr[0] ;
+}
+
+sub tests_resolvrev {
+	note( 'Entering tests_resolvrev()' ) ;
+	
+	# is( , resolvrev(  ), 'resolvrev:  => ' ) ;
+	is( undef, resolvrev(  ), 'resolvrev: no args => undef' ) ;
+	is( undef, resolvrev( '' ), 'resolvrev: empty string => undef' ) ;
+	is( undef, resolvrev( 'hostnotexist' ), 'resolvrev: hostnotexist => undef' ) ;
+	is( 'localhost', resolvrev( '127.0.0.1' ), 'resolvrev: 127.0.0.1 => localhost' ) ;
+	is( 'localhost', resolvrev( 'localhost' ), 'resolvrev: localhost => localhost' ) ;
+	is( 'ks.lamiral.info', resolvrev( 'imapsync.lamiral.info' ), 'resolvrev: imapsync.lamiral.info => ks.lamiral.info' ) ;
+	
+	# ip6-localhost ( in /etc/hosts )
+	is( 'ip6-localhost', resolvrev( 'ip6-localhost' ), 'resolvrev: ip6-localhost => ip6-localhost' ) ;
+	is( 'ip6-localhost', resolvrev( '::1' ), 'resolvrev: ::1 => ip6-localhost' ) ;
+	# ks2
+	is( 'ks2ipv6.lamiral.info', resolvrev( '2001:41d0:8:d8b6::1' ),  'resolvrev:  2001:41d0:8:d8b6::1 => ks2ipv6.lamiral.info' ) ;
+	is( 'ks2ipv6.lamiral.info', resolvrev( 'ks2ipv6.lamiral.info' ), 'resolvrev: ks2ipv6.lamiral.info => ks2ipv6.lamiral.info' ) ;
+	# ks3
+	is( 'ks3ipv6.lamiral.info', resolvrev( '2001:41d0:8:bebd::1' ),  'resolvrev:  2001:41d0:8:bebd::1 => ks3ipv6.lamiral.info' ) ;
+	is( 'ks3ipv6.lamiral.info', resolvrev( 'ks3ipv6.lamiral.info' ), 'resolvrev: ks3ipv6.lamiral.info => ks3ipv6.lamiral.info' ) ;
+	
+	
+	note( 'Leaving  tests_resolvrev()' ) ;
+        return ;
+}
+
+sub resolvrev {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+
+	if ( defined &Socket::getaddrinfo ) {
+		my $name = resolvrev_with_getaddrinfo( $host ) ;
+		return( $name ) ;
+	}
+	
+	return ;
+}
+
+sub resolvrev_with_getaddrinfo {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+
+	my ( $err, @res ) = Socket::getaddrinfo( $host, "", { socktype => Socket::SOCK_RAW } ) ;
+	if (  $err ) {
+		myprint( "Cannot getaddrinfo of $host: $err\n" ) ;
+		return ;
+	}
+
+	my @name ;
+	while( my $ai = shift @res ) {
+		my ( $err, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
+		if ( $err ) {
+			myprint( "Cannot getnameinfo of $host: $err\n" ) ;
+			return ;
+		}
+		$debug and myprint "$host => $reverse\n" ;
+		push @name, $reverse ;
+	}
+	
+    return $name[0] ;
+}
+
+
+
+sub tests_imapsping {
+	note( 'Entering tests_imapsping()' ) ;
+
+	is( undef, imapsping(  ), 'imapsping: no args => undef' ) ;
+	is( undef, imapsping( 'hostnotexist' ), 'imapsping: hostnotexist => undef' ) ;
+	is( 1, imapsping( 'imapsync.lamiral.info' ), 'imapsping: imapsync.lamiral.info => 1' ) ;
+        is( 1, imapsping( 'ks2ipv6.lamiral.info' ), 'imapsping: ks2ipv6.lamiral.info => 1' ) ;
+	note( 'Leaving  tests_imapsping()' ) ;
+	return ;
+}
+
+sub imapsping {
+	my $host = shift ;
+	return tcpping( $host, $IMAP_SSL_PORT ) ;
+}
+
+sub tests_tcpping {
+	note( 'Entering tests_tcpping()' ) ;
+
+	is( undef, tcpping(  ), 'tcpping: no args => undef' ) ;
+	is( undef, tcpping( 'hostnotexist' ), 'tcpping: one arg => undef' ) ;
+	is( undef, tcpping( undef, 888 ), 'tcpping: arg undef, port => undef' ) ;
+	is( undef, tcpping( 'hostnotexist', 993 ), 'tcpping: hostnotexist 993 => undef' ) ;
+	is( undef, tcpping( 'hostnotexist', 888 ), 'tcpping: hostnotexist 888 => undef' ) ;
+	is( 1, tcpping( 'imapsync.lamiral.info', 993 ), 'tcpping: imapsync.lamiral.info 993 => 1' ) ;
+	is( 0, tcpping( 'imapsync.lamiral.info', 888 ), 'tcpping: imapsync.lamiral.info 888 => 0' ) ;
+	is( 1, tcpping( '5.135.158.182', 993 ), 'tcpping: 5.135.158.182 993 => 1' ) ;
+	is( 0, tcpping( '5.135.158.182', 888 ), 'tcpping: 5.135.158.182 888 => 0' ) ;
+
+	# Net::Ping supports ipv6 only after release 1.50
+	# http://cpansearch.perl.org/src/RURBAN/Net-Ping-2.59/Changes
+	# Anyway I plan to avoid Net-Ping for that too long standing feature
+	# Net-Ping is integrated in Perl itself, who knows ipv6 for a long time
+	is( 1, tcpping( '2001:41d0:8:d8b6::1', 993 ), 'tcpping: 2001:41d0:8:d8b6::1 993 => 1' ) ;
+	is( 0, tcpping( '2001:41d0:8:d8b6::1', 888 ), 'tcpping: 2001:41d0:8:d8b6::1 888 => 0' ) ;
+
+	note( 'Leaving  tests_tcpping()' ) ;
+	return ;
+}
+
+sub tcpping {
+	if ( 2 != scalar( @ARG ) ) {
+		return ;
+	}
+	my ( $host, $port ) = @ARG ;
+	if ( ! $host ) { return ; }
+	if ( ! $port ) { return ; }
+
+	my $mytimeout = $TCP_PING_TIMEOUT ;
+        require Net::Ping ;
+	#my $p = Net::Ping->new( 'tcp' ) ;
+	my $p = Net::Ping->new(  ) ;
+	$p->{port_num} = $port ;
+	$p->service_check( 1 ) ;
+	$p->hires( 1 ) ;
+	my ($ping_ok, $rtt, $ip ) = $p->ping( $host, $mytimeout ) ;
+	if ( ! defined $ping_ok ) { return ; }
+	my $rtt_approx = sprintf( "%.3f", $rtt ) ;	
+	$debug and myprint( "Host $host timeout $mytimeout port $port ok $ping_ok ip $ip acked in $rtt_approx s\n" ) ;
+	$p->close(  ) ;
+	if( $ping_ok ) {
+		return 1 ;
+	}else{
+		return 0 ;
+	}
+}
+
+sub tests_sslcheck {
+	note( 'Entering tests_sslcheck()' ) ;
+
+	my $mysync ;
+
+	is( undef, sslcheck( $mysync ), 'sslcheck: no sslcheck => undef' ) ;
+
+	$mysync = {
+		sslcheck => 1,
+	} ;
+
+	is( 0, sslcheck( $mysync ), 'sslcheck: no host => 0' ) ;
+
+	$mysync = {
+		sslcheck => 1,
+		host1 => 'imapsync.lamiral.info',
+		tls1 => 1,
+	} ;
+
+	is( 0, sslcheck( $mysync ), 'sslcheck: tls1 => 0' ) ;
+
+	$mysync = {
+		sslcheck => 1,
+		host1 => 'imapsync.lamiral.info',
+	} ;
+
+
+	is( 1, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info => 1' ) ;
+	is( 1, $mysync->{ssl1}, 'sslcheck: imapsync.lamiral.info => ssl1 1' ) ;
+
+	$mysync->{sslcheck} = 0 ;
+	is( undef, sslcheck( $mysync ), 'sslcheck: sslcheck off => undef' ) ;
+
+	note( 'Leaving  tests_sslcheck()' ) ;
+	return ;
+}
+
+sub sslcheck {
+	my $mysync = shift ;
+
+	if ( ! $mysync->{sslcheck} ) {
+		return ;
+	}
+	my $nb_on = 0 ;
+	$debug and myprint( "sslcheck\n" ) ;
+	if (
+		( ! defined $mysync->{port1} )
+		and
+		( ! defined $mysync->{tls1} )
+		and
+		( ! defined $mysync->{ssl1} )
+		and
+		( defined $mysync->{host1} )
+		and
+		( probe_imapssl( $mysync->{host1} ) )
+	) {
+		$mysync->{ssl1} = 1 ;
+		myprint( "Host1: sslcheck detected open ssl port $IMAP_SSL_PORT so turning ssl on (use --nossl1 --notls1 to turn off SSL and TLS wizardry)\n" ) ;
+		$nb_on++ ;
+	}
+
+	if (
+		( ! defined $mysync->{port2} )
+		and
+		( ! defined $mysync->{tls2} )
+		and
+		( ! defined $mysync->{ssl2} )
+		and
+		( defined $mysync->{host2} )
+		and
+		( probe_imapssl( $mysync->{host2} ) )
+	) {
+		$mysync->{ssl2} = 1 ;
+		myprint( "Host2: sslcheck detected open ssl port $IMAP_SSL_PORT so turning ssl on (use --nossl2 --notls2 to turn off SSL and TLS wizardry)\n" ) ;
+		$nb_on++ ;
+	}
+	return $nb_on ;
+}
+
+
+sub testslive {
+        my $mysync = shift ;
+        $mysync->{host1} = 'test1.lamiral.info' ;
+        $mysync->{user1} = 'test1' ;
+        $mysync->{password1} = 'secret1' ;
+        $mysync->{host2} = 'test2.lamiral.info' ;
+        $mysync->{user2} = 'test2' ;
+        $mysync->{password2} ='secret2' ;
+        return ;
+}
+
+sub testslive6 {
+        my $mysync = shift ;
+        $mysync->{host1} = 'ks2ipv6.lamiral.info' ;
+        $mysync->{user1} = 'test1' ;
+        $mysync->{password1} = 'secret1' ;
+        $mysync->{host2} = 'ks2ipv6.lamiral.info' ;
+        $mysync->{user2} = 'test2' ;
+        $mysync->{password2} ='secret2' ;
+        return ;
+}
+
+
+sub tests_backslash_caret {
+        note( 'Entering tests_backslash_caret()' ) ;
+
+        is( "lalala", backslash_caret( "lalala" ), 'backslash_caret: lalala => lalala' ) ;
+        is( "lalala\n", backslash_caret( "lalala\n" ), 'backslash_caret: lalala => lalala 2nd' ) ;
+        is( '^', backslash_caret( '\\' ), 'backslash_caret: \\ => ^' ) ;
+        is( "^\n", backslash_caret( "\\\n" ), 'backslash_caret: \\ => ^' ) ;
+        is( "\\lalala", backslash_caret( "\\lalala" ), 'backslash_caret: \\lalala => \\lalala' ) ;
+        is( "\\lal\\ala", backslash_caret( "\\lal\\ala" ), 'backslash_caret: \\lal\\ala => \\lal\\ala' ) ;
+        is( "\\lalala\n", backslash_caret( "\\lalala\n" ), 'backslash_caret: \\lalala => \\lalala 2nd' ) ;
+        is( "lalala^\n", backslash_caret( "lalala\\\n" ), 'backslash_caret: lalala\\\n => lalala^\n' ) ;
+        is( "lalala^\nlalala^\n", backslash_caret( "lalala\\\nlalala\\\n" ), 'backslash_caret: lalala\\\nlalala\\\n => lalala^\nlalala^\n' ) ;
+        is( "lal\\ala^\nlalala^\n", backslash_caret( "lal\\ala\\\nlalala\\\n" ), 'backslash_caret: lal\\ala\\\nlalala\\\n => lal\\ala^\nlalala^\n' ) ;
+
+        note( 'Leaving  tests_backslash_caret()' ) ;
+        return ;
+}
+
+sub backslash_caret {
+        my $string = shift ;
+        
+        $string =~ s{\\ $ }{^}gxms ;
+
+        return $string ;
+}
+
 sub usage {
-	my $localhost_info = localhost_info();
-	my $thank = thank_author();
-	my $imapsync_release = q{};
-	$imapsync_release = check_last_release() if (not defined $releasecheck);
-        my $escape_char = ( 'MSWin32' eq $OSNAME ) ? '^' : '\\';
-        myprint( <<"EOF" ) ;
+	my $mysync = shift ;
+        
+        my $usage = q{} ;
+        my $usage_from_pod ;
+        my $usage_footer = usage_footer( $mysync ) ;
 
- usage: $0 [options]
+        # pod2usage writes on a filehandle only and I want a variable
+        open my $fh_pod2usage, ">", \$usage_from_pod or do { 
+                warn $OS_ERROR ;
+                return ;
+        } ;
+        
+        pod2usage( 
+                -exitval   => 'NOEXIT',
+                -noperldoc => 1,
+                -verbose => 99,
+                -sections => [ qw(NAME VERSION USAGE OPTIONS) ],
+                -indent => 1,
+                -loose => 1,
+                -output => $fh_pod2usage,
+        ) ;
+        close $fh_pod2usage ;
+        
+        if ( 'MSWin32' eq $OSNAME ) {
+                $usage_from_pod = backslash_caret( $usage_from_pod ) ;
+        }
+        $usage = join( q{}, $usage_from_pod, $usage_footer ) ;
 
- Several options are mandatory.
- str means string
- int means integer
- reg means regular expression
- cmd means command
+        return( $usage ) ;
+}
 
- --dry               : Makes imapsync doing nothing, just print what would
-                       be done without --dry.
+sub tests_usage {
+        my $usage ;
+        like( $usage = usage( $sync ), qr/Name:/, 'usage2: contains Name:' ) ;
+        myprint( $usage ) ;
+        like( $usage, qr/Version:/, 'usage2: contains Version:' ) ;
+        like( $usage, qr/Usage:/, 'usage2: contains Usage:' ) ;
+        like( $usage, qr/imapsync/, 'usage2: contains imapsync' ) ;
+        return ;
+}
 
- --host1        str  : Source or "from" imap server. Mandatory.
- --port1        int  : Port to connect on host1. Default is 143, 993 if --ssl1
- --user1        str  : User to login on host1. Mandatory.
- --showpasswords     : Shows passwords on output instead of "MASKED".
-                       Useful to restart a complete run by just reading the log.
- --password1    str  : Password for the user1.
- --host2        str  : "destination" imap server. Mandatory.
- --port2        int  : Port to connect on host2. Default is 143, 993 if --ssl2
- --user2        str  : User to login on host2. Mandatory.
- --password2    str  : Password for the user2.
+sub usage_footer {
+	my $mysync = shift ;
+        
+        my $footer = q{} ;
 
- --passfile1    str  : Password file for the user1. It must contain the
-                       password on the first line. This option avoids to show
-                       the password on the command line like --password1 does.
- --passfile2    str  : Password file for the user2. Contains the password.
+        my $localhost_info = localhost_info(  ) ;
+        my $rcs = $mysync->{rcs} ;
+        my $homepage = homepage(  ) ;
+        my $imapsync_release = q{} ;
+        $imapsync_release = check_last_release(  ) if ( not defined $releasecheck ) ;
 
- --ssl1              : Use a SSL connection on host1.
- --ssl2              : Use a SSL connection on host2.
- --tls1              : Use a TLS connection on host1.
- --tls2              : Use a TLS connection on host2.
- --debugssl     int  : SSL debug mode from 0 to 4.
- --sslargs1     str  : Pass any ssl parameter for host1 ssl or tls connection. Example:
-                       --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3
-                       See all possibilities in the new() method of IO::Socket::SSL
-                       http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods
- --sslargs2     str  : Pass any ssl parameter for host2 ssl or tls connection.
-                       See --sslargs1
-
- --timeout1     int  : Connection timeout in seconds for host1.
-                       Default is 120 and 0 means no timeout at all.
- --timeout2     int  : Connection timeout in seconds for host2.
-                       Default is 120 and 0 means no timeout at all.
-
- --authmech1    str  : Auth mechanism to use with host1:
-                       PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
- --authmech2    str  : Auth mechanism to use with host2. See --authmech1
-
- --authuser1    str  : User to auth with on host1 (admin user).
-                       Avoid using --authmech1 SOMETHING with --authuser1.
- --authuser2    str  : User to auth with on host2 (admin user).
- --proxyauth1        : Use proxyauth on host1. Requires --authuser1.
-                       Required by Sun/iPlanet/Netscape IMAP servers to
-                       be able to use an administrative user.
- --proxyauth2        : Use proxyauth on host2. Requires --authuser2.
-
- --authmd51          : Use MD5 authentification for host1.
- --authmd52          : Use MD5 authentification for host2.
- --domain1      str  : Domain on host1 (NTLM authentication).
- --domain2      str  : Domain on host2 (NTLM authentication).
-
-
- --folder       str  : Sync this folder.
- --folder       str  : and this one, etc.
- --folderrec    str  : Sync this folder recursively.
- --folderrec    str  : and this one, etc.
-
- --folderfirst  str  : Sync this folder first. --folderfirst "Work"
- --folderfirst  str  : then this one, etc.
- --folderlast   str  : Sync this folder last. --folderlast "[Gmail]/All Mail"
- --folderlast   str  : then this one, etc.
-
- --nomixfolders      : Do not merge folders when host1 is case sensitive
-                       while host2 is not (like Exchange). Only the first
-                       similar folder is synced (ex: Sent SENT sent -> Sent).
-
- --skipemptyfolders  : Empty host1 folders are not created on host2.
-
- --include      reg  : Sync folders matching this regular expression
- --include      reg  : or this one, etc.
-                       in case both --include --exclude options are
-                       use, include is done before.
- --exclude      reg  : Skips folders matching this regular expression
-                       Several folders to avoid:
-                        --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
- --exclude      reg  : or this one, etc.
-
- --subfolder2   str  : Move whole host1 folders hierarchy under this
-                       host2 folder  str    .
-                       It does it by adding two --regextrans2 options before
-                       all others. Add --debug to see what's really going on.
-
- --automap           : guesses folders mapping, for folders like
-                       "Sent", "Junk", "Drafts", "All", "Archive", "Flagged".
- --f1f2    str1=str2 : Force folder str1 to be synced to str2,
-                       --f1f2 overrides --automap and --regextrans2.
- --regextrans2  reg  : Apply the whole regex to each destination folders.
- --regextrans2  reg  : 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.
-                       Have in mind that --regextrans2 is applied after prefix
-                       and separator inversion. For examples see
-                       http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt
-
- --tmpdir       str  : Where to store temporary files and subdirectories.
-                       Will be created if it doesn't exist.
-                       Default is system specific, Unix is /tmp but
-                       it's often small and deleted at reboot.
-                       --tmpdir /var/tmp should be better.
- --pidfile      str  : The file where imapsync pid is written.
- --pidfilelocking    : Abort if pidfile already exists. Usefull to avoid
-                       concurrent transfers on the same mailbox.
-
- --nolog             : Turn off logging on file
- --logfile      str  : Change the default log filename (can be dirname/filename).
- --logdir       str  : Change the default log directory. Default is LOG_imapsync
-
- --prefix1      str  : Remove prefix to all destination folders
-                       (usually INBOX. or INBOX/ or an empty string "")
-                       you have to use --prefix1 if host1 imap server
-                       does not have NAMESPACE capability, so imapsync
-                       suggests to use it. All other cases are bad.
- --prefix2      str  : Add prefix to all host2 folders. See --prefix1
- --sep1         str  : Host1 separator in case NAMESPACE is not supported.
- --sep2         str  : Host2 separator in case NAMESPACE is not supported.
-
- --skipmess     reg  : Skips messages maching the regex.
-                       Example: 'm/[\\x80-ff]/' # to avoid 8bits messages.
-                       --skipmess is applied before --regexmess
- --skipmess     reg  : or this one, etc.
-
- --pipemess     cmd  : Apply this cmd command to each message content
-                       before the copy.
- --pipemess     cmd  : and this one, etc.
-
- --disarmreadreceipts : Disarms read receipts (host2 Exchange issue)
-
- --regexmess    reg  : Apply the whole regex to each message before transfer.
-                       Example: 's/\\000/ /g' # to replace null by space.
- --regexmess    reg  : and this one, etc.
-
- --regexflag    reg  : Apply the whole regex to each flags list.
-                       Example: 's/\"Junk"//g' # to remove "Junk" flag.
- --regexflag    reg  : and this one, etc.
-
- --delete            : Deletes messages on host1 server after a successful
-                       transfer. Option --delete has the following behavior:
-                       it marks messages as deleted with the IMAP flag
-                       \\Deleted, then messages are really deleted with an
-                       EXPUNGE IMAP command.
-
- --delete2           : Delete messages in host2 that are not in
-                       host1 server. Useful for backup or pre-sync.
- --delete2duplicates : Delete messages in host2 that are duplicates.
-                       Works only without --useuid since duplicates are
-                       detected with an header part of each message.
-
- --delete2folders    : Delete folders in host2 that are not in host1 server.
-                       For safety, first try it like this (it is safe):
-                       --delete2folders --dry --justfolders --nofoldersizes
- --delete2foldersonly   reg : Deleted only folders matching regex.
-                              Example: --delete2foldersonly "/^Junk\$|^INBOX.Junk\$/"
- --delete2foldersbutnot reg : Do not delete folders matching regex.
-                              Example: --delete2foldersbutnot "/Tasks\$|Contacts\$|Foo\$/"
- --noexpunge         : Do not expunge messages on host1.
-                       Expunge really deletes messages marked deleted.
-                       Expunge is made at the beginning, on host1 only.
-                       Newly transferred messages are also expunged if
-                       option --delete is given.
-                       No expunge is done on host2 account (unless --expunge2)
- --expunge1          : Expunge messages on host1 after messages transfer.
- --expunge2          : Expunge messages on host2 after messages transfer.
- --uidexpunge2       : uidexpunge messages on the host2 account
-                       that are not on the host1 account, requires --delete2
- --nomixfolders      : Avoid merging folders that are considered different on
-                       host1 but the same on destination host2 because of
-                       case sensitivities and insensitivities.
-
- --syncinternaldates : Sets the internal dates on host2 same as host1.
-                       Turned on by default. Internal date is the date
-                       a message arrived on a host (mtime).
- --idatefromheader   : Sets the internal dates on host2 same as the
-                       "Date:" headers.
-
- --maxsize      int  : Skip messages larger  (or equal) than  int  bytes
- --minsize      int  : Skip messages smaller (or equal) than  int  bytes
- --maxage       int  : Skip messages older than  int  days.
-                       final stats (skipped) don't count older messages
-                       see also --minage
- --minage       int  : Skip messages newer than  int  days.
-                       final stats (skipped) don't count newer messages
-                       You can do (+ are the messages selected):
-                       past|----maxage+++++++++++++++>now
-                       past|+++++++++++++++minage---->now
-                       past|----maxage+++++minage---->now (intersection)
-                       past|++++minage-----maxage++++>now (union)
-
- --search       str  : Selects only messages returned by this IMAP SEARCH
-                       command. Applied on both sides.
- --search1      str  : Same as --search for selecting host1 messages only.
- --search2      str  : Same as --search for selecting host2 messages only.
-                       --search CRIT equals --search1 CRIT --search2 CRIT
-
- --exitwhenover int  : Stop syncing when total bytes transferred reached.
-                       Gmail per day allows
-                       2500000000 = 2.5 GB downloaded from Gmail as host2
-                        500000000 = 500 MB uploaded to Gmail as host1.
-
- --maxlinelength int : skip messages with a line length longer than  int  bytes.
-                       RFC 2822 says it must be no more than 1000 bytes.
-
- --useheader    str  : Use this header to compare messages on both sides.
-                       Ex: Message-ID or Subject or Date.
- --useheader    str    and this one, etc.
-
- --subscribed        : Transfers subscribed folders.
- --subscribe         : Subscribe to the folders transferred on the
-                       host2 that are subscribed on host1. On by default.
- --subscribeall      : Subscribe to the folders transferred on the
-                       host2 even if they are not subscribed on host1.
-
- --nofoldersizes     : Do not calculate the size of each folder in bytes
-                       and message counts. Default is to calculate them.
- --nofoldersizesatend: Do not calculate the size of each folder in bytes
-                       and message counts at the end. Default is on.
- --justfoldersizes   : Exit after having printed the folder sizes.
-
- --syncacls          : Synchronises acls (Access Control Lists).
- --nosyncacls        : Does not synchronize acls. This is the default.
-                       Acls in IMAP are not standardized, be careful.
-
- --usecache          : Use cache to speedup.
- --nousecache        : Do not use cache. Caveat: --useuid --nousecache creates
-                       duplicates on multiple runs.
- --useuid            : Use uid instead of header as a criterium to recognize
-                       messages. Option --usecache is then implied unless
-                       --nousecache is used.
-
- --debug             : Debug mode.
- --debugfolders      : Debug mode for the folders part only.
- --debugcontent      : Debug content of the messages transfered. Huge ouput.
- --debugflags        : Debug mode for flags.
- --debugimap1        : IMAP debug mode for host1. Very verbose.
- --debugimap2        : IMAP debug mode for host2. Very verbose.
- --debugimap         : IMAP debug mode for host1 and host2.
- --debugmemory       : Debug mode showing memory consumption after each copy.
-
- --errorsmax     int : Exit when int number of errors is reached. Default is 50.
-
- --tests             : Run local non-regression tests. Exit code 0 means all ok.
- --testslive         : Run a live test with test1.lamiral.info imap server.
-                       Useful to check the basics. Needs internet connexion.
-
- --version           : Print only software version.
- --noreleasecheck    : Do not check for new imapsync release (a http request).
- --releasecheck      : Check for new imapsync release (a http request).
- --noid              : Do not send/receive ID command to imap servers.
- --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       : Do only things about folders (ignore messages).
-
- --help              : print this help.
-
- Example: to synchronize imap account "test1" on "test1.lamiral.info"
-                     to  imap account "test2" on "test2.lamiral.info"
-                     with test1 password "secret1"
-                     and  test2 password "secret2"
-
- $0 $escape_char
-    --host1 test1.lamiral.info --user1 test1 --password1 secret1 $escape_char
-    --host2 test2.lamiral.info --user2 test2 --password2 secret2
-
-$localhost_info
+        $footer = 
+        qq{$localhost_info
 $rcs
 $imapsync_release
 
-$thank
-EOF
-	return( 1 ) ;
+$homepage
+} ;
+        return( $footer ) ;
 }
 
 
+
 sub usage_complete {
-	myprint( <<'EOF'  ) ;
+        # Unused, I guess this function could be deleted
+        my $usage = <<'EOF' ;
 --skipheader   reg     : Don't take into account header keyword
                          matching  reg    ex: --skipheader 'X.*'
 
 --skipsize             : Don't take message size into account to compare
                          messages on both sides. On by default.
-			 Use --no-skipsize for using size comparaison.
+                         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
@@ -9024,48 +11167,283 @@ sub usage_complete {
 --split2      int      : same thing on host2.
 --nofixInboxINBOX      : Don't fix Inbox INBOX mapping.
 EOF
+        return( $usage ) ;
+}
+
+
+sub myGetOptions {
+# Started as a copy of Luke Ross Getopt::Long::CGI
+# https://metacpan.org/release/Getopt-Long-CGI
+# So this sub function is under the same license as Getopt-Long-CGI Luke Ross wants it,
+# which was Perl 5.6 or later licenses at the date of the copy.
+
+    my $mycgi = shift @ARG ;
+    my $arguments_ref = shift @ARG ;
+    my %options = @ARG ;
+
+    if ( not under_cgi_context(  ) ) {
+        # Not CGI - pass upstream for normal command line handling
+        return Getopt::Long::GetOptionsFromArray( $arguments_ref, %options ) ;
+    }
+    my $b_ref = $options{'debugbasket=s'} ;
+
+    my $badthings = 0 ;
+    foreach my $key (sort keys %options) {
+        my $val = $options{$key};
+        #push( @{$b_ref}, "opt:[$key] val:[$val]" . ( ('SCALAR' eq ref($val) and defined  $$val  ) ? " [$$val]" : q{} ) . "\n" ) ;
+
+        if ( $key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/mxs ) {
+                push  @{$b_ref}, "Unknown option type: [$key]\n"  ;
+		$badthings++ ;
+            next ; # Unknown item
+        }
+
+        my $name = [split '|', $1, 1 ]->[0];
+
+        if (($3 || q{}) eq '+') {
+            ${ $val } = $mycgi->param($name); # "Incremental" integer
+        } elsif ($2) {
+            my @values = $mycgi->multi_param($name);
+            my $type = $2;
+	    #myprint( "[$type][@values][", $3 || q{}, "][$val][", ref($val), "]\n" ) ;
+            if (($3 || q{}) eq '%' or ref($val) eq 'HASH') {
+                my %values = map { split /=/mxs, $_ } @values;
+
+                if ($type =~ m/i$/mxs) {
+                    foreach my $k (keys %values) {
+                        $values{$k} = int $values{$k} ;
+                    }
+                } elsif ($type =~ m/f$/mxs) {
+                    foreach my $k (keys %values) {
+                        $values{$k} = 0 + $values{$k}
+                    }
+                }
+                if ( 'REF' eq ref $val ) {
+                        #push( @{$b_ref}, "refref($$val): " . ref($$val) . " %values= ", %values, "\n\n" ) ;
+                        %{ ${ $val } } = %values;
+                } else {
+                        #push( @{$b_ref}, "ref($val): " . ref($val) . " %values= ", %values, "\n\n" ) ;
+                        %{ $val } = %values;
+                }
+            } else {
+                if ($type =~ m/i$/mxs) {
+                    @values = map { int $_ } @values;
+                } elsif ($type =~ m/f$/mxs) {
+                    @values = map { 0 + $_ } @values;
+                }
+                if (($3 || q{}) eq '@' or ref($val) eq 'ARRAY') {
+                    @{ $val } = @values ;
+                } else {
+                    ${ $val } = $values[0] ;
+                }
+            }
+        } else {
+            # Checkbox
+	    # Considers only --name
+	    # Should consider also --no-name and --noname
+            ${ $val } = $mycgi->param($name) ? 1 : undef ;
+            #push( @{$b_ref}, "param($name) ref($val): " . ref($val) . " val=[$$val]\n\n" ) ;
+	    #myprint( "param($name) ref($val): " . ref($val) . " val=[$$val]\n\n" ) ;
+	    #myprint( "param($name) ref($val): " . ref($val) . " \n\n" ) ;
+        }
+    }
+    if ( $badthings ) {
+		return ; # undef or ()
+    } else {
+		return( 1 ) ;
+    }
+}
+
+
+sub tests_get_options  {
+	note( 'Entering tests_get_options()' ) ;
+
+	# CAVEAT: still setting global variables, be carefull
+	# with tests, the context increases! $debug stays on for example.
+	# API:
+	# * input arguments: two ways, command line or CGI
+	#    * the program arguments
+	#    * QUERY_STRING env variable
+	# * return
+	#   * undef if bad things happened like
+	#     * options not known
+	#     * --delete 2 input
+	#   * number of arguments or QUERY_STRING length
+	my $mysync ;
+	is( undef, get_options( $mysync, qw( --noexist ) ),                   'get_options: --noexist  => undef' ) ;
+	is( undef, get_options( $mysync, qw( --lalala --noexist --version ) ), 'get_options: --lalala --noexist --version  => undef' ) ;
+	is( undef, get_options( $mysync, qw( --delete 2 ) ), 'get_options: --delete 2 => undef' ) ;
+	is( 1,     get_options( $mysync, "--version" ), 'get_options: --version => 1' ) ;
+	is( 1,     get_options( $mysync, "--help" ), 'get_options: --help => 1' ) ;
+	is( undef, get_options( $mysync, qw( --debug --noexist --version ) ), 'get_options: --debug --noexist --version  => undef' ) ;
+
+	note( 'Leaving  tests_get_options()' ) ;
+	return ;
+}
+
+sub tests_get_options_cgi  {
+	note( 'Entering tests_get_options_cgi()' ) ;
+
+# Temporary, have to think harder about testing CGI context in command line --tests
+	# API:
+	# * input arguments: two ways, command line or CGI
+	#    * the program arguments
+	#    * QUERY_STRING env variable
+	# * return
+	#   * QUERY_STRING length
+
+	# CGI context
+	local $ENV{SERVER_SOFTWARE} = 'Votre serviteur' ;
+
+	# Real full test
+	# = 'host1=test1.lamiral.info&user1=test1&password1=secret1&host2=test2.lamiral.info&user2=test2&password2=secret2&debugenv=on'
+	my $mysync ;
+	require CGI ;
+	CGI->import( qw( -no_debug ) ) ;
+
+	# Testing boolean
+	$mysync->{cgi} = CGI->new( 'version=on&debugenv=on' ) ;
+	local $ENV{'QUERY_STRING'} = 'version=on&debugenv=on' ;
+	is( 22,   get_options_cgi( $mysync ), 'get_options: QUERY_STRING => 22' ) ;
+	is(  1,   $version,        'get_options: $version => 1' ) ;
+	# debugenv is not allowed in cgi context
+	is(  undef,   $mysync->{debugenv},        'get_options: $mysync->{debugenv} => undef' ) ;
+
+	# QUERY_STRING in this test is only for return value of get_options_cgi
+	# Have to think harder, GET/POST context, is this return value a good thing?
+	local $ENV{'QUERY_STRING'} = 'host1=test1.lamiral.info&user1=test1' ;
+	$mysync->{cgi} = CGI->new( 'host1=test1.lamiral.info&user1=test1' ) ;
+	is( 36,      get_options_cgi( $mysync,  ), 'get_options: QUERY_STRING => 36' ) ;
+	is( 'test1',  $mysync->{user1},    'get_options: $mysync->{user1} => test1' ) ;
+
+	# Testing @
+	$mysync->{cgi} = CGI->new( 'folder=fd1' ) ;
+	get_options_cgi( $mysync ) ;
+	is_deeply( [ 'fd1' ],  [ @folder ],    'get_options: @folder => fd1' ) ;
+	$mysync->{cgi} = CGI->new( 'folder=fd1&folder=fd2' ) ;
+	get_options_cgi( $mysync ) ;
+	is_deeply( [ 'fd1', 'fd2' ],  [ @folder ],    'get_options: @folder => fd1' ) ;
+
+	# Testing %
+	$mysync->{cgi} = CGI->new( 'f1f2=s1=d1&f1f2=s2=d2&f1f2=s3=d3' ) ;
+	get_options_cgi( $mysync ) ;
+	#$mysync->{f1f2} = { 's1' => 'd1', 's2' => 'd2' } ;
+	is_deeply( { 's1' => 'd1', 's2' => 'd2', 's3' => 'd3' },
+	$mysync->{f1f2}, 'get_options: f1f2 => s1=d1 s2=d2 s3=d3' ) ;
+
+	# Testing boolean ! with --noxxx, doesnot work
+	$mysync->{cgi} = CGI->new( 'nodry=on' ) ;
+	is( undef,  $mysync->{dry},    'get_options: --nodry => $mysync->{dry} => 0' ) ;
+
+	note( 'Leaving  tests_get_options_cgi()' ) ;
 	return ;
 }
 
 
 
-sub get_options {
-	# In CGI context arguments are not in @ARGV but in QUERY_STRING variable (with GET).
-	my $numopt = scalar  @ARGV  || length $ENV{'QUERY_STRING'} ;
-	my $argv   = join "\x00", @ARGV ;
+sub get_options_cgi {
+        # In CGI context arguments are not in @ARGV but in QUERY_STRING variable (with GET).
+	my $mysync = shift @ARG ;
+	my $mycgi = $mysync->{cgi} || return ;
+	my @arguments = @ARG ;
+	# final 0 is used to print usage when no option is given
+        my $numopt = length $ENV{'QUERY_STRING'} || 1 ;
+	$mysync->{f1f2} = {} ;
+        my $opt_ret = myGetOptions(
+	$mycgi,
+	\@arguments,
+	'abort'            => \$mysync->{abort},
+        'host1=s'          => \$mysync->{host1},
+        'host2=s'          => \$mysync->{host2},
+        'user1=s'          => \$mysync->{user1},
+        'user2=s'          => \$mysync->{user2},
+        'password1=s'      => \$mysync->{password1},
+        'password2=s'      => \$mysync->{password2},
+        'dry!'             => \$mysync->{dry},
+        'version'          => \$version,
+        'ssl1!'            => \$mysync->{ssl1},
+        'ssl2!'            => \$mysync->{ssl2},
+        'tls1!'            => \$mysync->{tls1},
+        'tls2!'            => \$mysync->{tls2},
+        'justlogin!'       => \$justlogin,
+        'addheader!'       => \$addheader,
+        'automap!'         => \$mysync->{automap},
+        'justautomap!'     => \$mysync->{justautomap},
+	'gmail1'           => \$mysync->{gmail1},
+	'gmail2'           => \$mysync->{gmail2},
+	'office1'          => \$mysync->{office1},
+	'office2'          => \$mysync->{office2},
+	'exchange1'        => \$mysync->{exchange1},
+	'exchange2'        => \$mysync->{exchange2},
+	'domino1'          => \$mysync->{domino1},
+	'domino2'          => \$mysync->{domino2},
+        'f1f2=s%'          => \$mysync->{f1f2},
+        'folder=s'         => \@folder,
+        'testslive!'       => \$mysync->{testslive},
+        'testslive6!'      => \$mysync->{testslive6},
+        ) ;
 
-	if ( $argv =~ m/-delete\x002/x ) {
-		myprint( "May be you mean --delete2 instead of --delete 2\n"  ) ;
-		exit 1 ;
+        $debug and output( $mysync, "get options: [$opt_ret][$numopt]\n"  ) ;
+
+	if ( ! $opt_ret ) {
+		return ;
 	}
-	$sync->{f1f2} = {} ;
-        my $opt_ret = Imapsync::Getopt::Long::GetOptions(
+	return $numopt ;
+}
+
+sub get_options_cmd {
+	my $mysync = shift @ARG ;
+	my @arguments = @ARG ;
+	my $mycgi = $mysync->{cgi} ;
+	# final 0 is used to print usage when no option is given on command line
+        my $numopt = scalar  @arguments || 0 ;
+        my $argv   = join "\x00", @arguments ;
+
+        if ( $argv =~ m/-delete\x002/x ) {
+                output( $mysync, "May be you mean --delete2 instead of --delete 2\n"  ) ;
+                return ;
+        }
+        $mysync->{f1f2} = {} ;
+        my $opt_ret = myGetOptions(
+	$mycgi,
+	\@arguments,
         'debug!'        => \$debug,
         'debuglist!'    => \$debuglist,
         'debugcontent!' => \$debugcontent,
-        'debugsleep=f'  => \$sync->{debugsleep},
+        'debugsleep=f'  => \$mysync->{debugsleep},
         'debugflags!'   => \$debugflags,
         'debugimap!'    => \$debugimap,
         'debugimap1!'   => \$debugimap1,
         'debugimap2!'   => \$debugimap2,
         'debugdev!'     => \$debugdev,
-        'debugmemory!'  => \$sync->{debugmemory},
-        'debugfolders!' => \$sync->{debugfolders},
-        'debugssl=i'    => \$sync->{debugssl},
-	'debugbasket=s' => \@debugbasket,
-	'debugcgi!'     => \$debugcgi,
-        'host1=s'     => \$host1,
-        'host2=s'     => \$host2,
-        'port1=i'     => \$port1,
-        'port2=i'     => \$port2,
-	'inet4'       => \$sync->{inet4},
-	'inet6'       => \$sync->{inet6},
-        'user1=s'     => \$user1,
-        'user2=s'     => \$user2,
+        'debugmemory!'  => \$mysync->{debugmemory},
+        'debugfolders!' => \$mysync->{debugfolders},
+        'debugssl=i'    => \$mysync->{debugssl},
+        'debugbasket=s' => \@debugbasket,
+        'debugcgi!'     => \$debugcgi,
+	'debugenv'      => \$mysync->{debugenv},
+        'simulong=i'    => \$mysync->{simulong},
+	'abort'         => \$mysync->{abort},
+        'host1=s'     => \$mysync->{host1},
+        'host2=s'     => \$mysync->{host2},
+        'port1=i'     => \$mysync->{port1},
+        'port2=i'     => \$mysync->{port2},
+        'inet4|ipv4'    => \$mysync->{inet4},
+        'inet6|ipv6'    => \$mysync->{inet6},
+        'user1=s'     => \$mysync->{user1},
+        'user2=s'     => \$mysync->{user2},
+	'gmail1'      => \$mysync->{gmail1},
+	'gmail2'      => \$mysync->{gmail2},
+	'office1'     => \$mysync->{office1},
+	'office2'     => \$mysync->{office2},
+	'exchange1'   => \$mysync->{exchange1},
+	'exchange2'   => \$mysync->{exchange2},
+	'domino1'     => \$mysync->{domino1},
+	'domino2'     => \$mysync->{domino2},
         'domain1=s'   => \$domain1,
         'domain2=s'   => \$domain2,
-        'password1=s' => \$password1,
-        'password2=s' => \$password2,
+        'password1=s' => \$mysync->{password1},
+        'password2=s' => \$mysync->{password2},
         'passfile1=s' => \$passfile1,
         'passfile2=s' => \$passfile2,
         'authmd5!'    => \$authmd5,
@@ -9073,34 +11451,34 @@ sub get_options {
         'authmd52!'   => \$authmd52,
         'sep1=s'      => \$sep1,
         'sep2=s'      => \$sep2,
-        'folder=s'    => \@folder,
-        'folderrec=s' => \@folderrec,
-        'include=s'   => \@include,
-        'exclude=s'   => \@exclude,
-        'folderfirst=s' => \@folderfirst,
-        'folderlast=s' => \@folderlast,
-        'prefix1=s'   => \$prefix1,
-        'prefix2=s'   => \$prefix2,
-	'subfolder2=s' => \$subfolder2,
-        'fixslash2!'   => \$fixslash2,
-        'fixInboxINBOX!' => \$fixInboxINBOX,
-        'regextrans2=s' => \@regextrans2,
-        'mixfolders!' => \$mixfolders,
+        'folder=s'          => \@folder,
+        'folderrec=s'       => \@folderrec,
+        'include=s'         => \@include,
+        'exclude=s'         => \@exclude,
+        'folderfirst=s'     => \@folderfirst,
+        'folderlast=s'      => \@folderlast,
+        'prefix1=s'         => \$prefix1,
+        'prefix2=s'         => \$prefix2,
+        'subfolder2=s'      => \$subfolder2,
+        'fixslash2!'        => \$fixslash2,
+        'fixInboxINBOX!'    => \$fixInboxINBOX,
+        'regextrans2=s'     => \@regextrans2,
+        'mixfolders!'       => \$mixfolders,
         'skipemptyfolders!' => \$skipemptyfolders,
-        'regexmess=s' => \@regexmess,
-        'skipmess=s' => \@skipmess,
-        'pipemess=s' => \@pipemess,
-	'pipemesscheck!' => \$pipemesscheck,
+        'regexmess=s'       => \@regexmess,
+        'skipmess=s'        => \@skipmess,
+        'pipemess=s'        => \@pipemess,
+        'pipemesscheck!'    => \$pipemesscheck,
         'disarmreadreceipts!' => \$disarmreadreceipts,
-        'regexflag=s' => \@regexflag,
-        'filterflags!' => \$filterflags,
-        'flagscase!'  => \$flagscase,
+        'regexflag=s'         => \@regexflag,
+        'filterflags!'        => \$filterflags,
+        'flagscase!'          => \$flagscase,
         'syncflagsaftercopy!' => \$syncflagsaftercopy,
-        'delete|delete1!' => \$delete,
-        'delete2!'    => \$delete2,
-        'delete2duplicates!' => \$delete2duplicates,
-        'delete2folders!'    => \$delete2folders,
-        'delete2foldersonly=s' => \$delete2foldersonly,
+        'delete|delete1!'     => \$delete1,
+        'delete2!'            => \$delete2,
+        'delete2duplicates!'  => \$delete2duplicates,
+        'delete2folders!'     => \$delete2folders,
+        'delete2foldersonly=s'   => \$delete2foldersonly,
         'delete2foldersbutnot=s' => \$delete2foldersbutnot,
         'syncinternaldates!' => \$syncinternaldates,
         'idatefromheader!'   => \$idatefromheader,
@@ -9114,11 +11492,10 @@ sub get_options {
         'search2=s'   => \$search2,
         'foldersizes!' => \$foldersizes,
         'foldersizesatend!' => \$foldersizesatend,
-        'dry!'        => \$dry,
-        'expunge!'    => \$expunge,
-        'expunge1!'    => \$expunge1,
-        'expunge2!'    => \$expunge2,
-        'uidexpunge2!' => \$uidexpunge2,
+        'dry!'              => \$mysync->{dry},
+        'expunge1|expunge!' => \$expunge1,
+        'expunge2!'         => \$expunge2,
+        'uidexpunge2!'      => \$uidexpunge2,
         'subscribed!' => \$subscribed,
         'subscribe!'  => \$subscribe,
         'subscribeall|subscribe_all!'  => \$subscribeall,
@@ -9130,8 +11507,8 @@ sub get_options {
         'version'     => \$version,
         'help'        => \$help,
         'timeout=i'   => \$timeout,
-        'timeout1=i'   => \$sync->{h1}->{timeout},
-        'timeout2=i'   => \$sync->{h2}->{timeout},
+        'timeout1=i'   => \$mysync->{h1}->{timeout},
+        'timeout2=i'   => \$mysync->{h2}->{timeout},
         'skipheader=s' => \$skipheader,
         'useheader=s' => \@useheader,
         'wholeheaderifneeded!'   => \$wholeheaderifneeded,
@@ -9140,14 +11517,15 @@ sub get_options {
         'allowsizemismatch!' => \$allowsizemismatch,
         'fastio1!'     => \$fastio1,
         'fastio2!'     => \$fastio2,
-        'ssl1!'        => \$ssl1,
-        'ssl2!'        => \$ssl2,
-        'ssl1_ssl_version=s' => \$sync->{h1}->{sslargs}->{SSL_version},
-        'ssl2_ssl_version=s' => \$sync->{h2}->{sslargs}->{SSL_version},
-        'sslargs1=s%'        => \$sync->{h1}->{sslargs},
-        'sslargs2=s%'        => \$sync->{h2}->{sslargs},
-        'tls1!'        => \$tls1,
-        'tls2!'        => \$tls2,
+	'sslcheck!'    => \$mysync->{sslcheck},
+        'ssl1!'        => \$mysync->{ssl1},
+        'ssl2!'        => \$mysync->{ssl2},
+        'ssl1_ssl_version=s' => \$mysync->{h1}->{sslargs}->{SSL_version},
+        'ssl2_ssl_version=s' => \$mysync->{h2}->{sslargs}->{SSL_version},
+        'sslargs1=s%'        => \$mysync->{h1}->{sslargs},
+        'sslargs2=s%'        => \$mysync->{h2}->{sslargs},
+        'tls1!'        => \$mysync->{tls1},
+        'tls2!'        => \$mysync->{tls2},
         'uid1!'        => \$uid1,
         'uid2!'        => \$uid2,
         'authmech1=s' => \$authmech1,
@@ -9161,13 +11539,15 @@ sub get_options {
         'buffersize=i' => \$buffersize,
         'reconnectretry1=i' => \$reconnectretry1,
         'reconnectretry2=i' => \$reconnectretry2,
-        'tests!'       => \$tests,
-        'testsdebug|tests_debug!' => \$testsdebug,
-        'testslive!'   => \$testslive,
-        'justlogin!'  => \$justlogin,
-        'tmpdir=s'    => \$tmpdir,
-        'pidfile=s'    => \$sync->{pidfile},
-        'pidfilelocking!' => \$sync->{pidfilelocking},
+        'tests!'          => \$mysync->{ tests },
+        'testsdebug|tests_debug!' => \$mysync->{ testsdebug },
+	'testsunit=s@'    => \$mysync->{testsunit},
+        'testslive!'      => \$mysync->{testslive},
+        'testslive6!'     => \$mysync->{testslive6},
+        'justlogin!'      => \$justlogin,
+        'tmpdir=s'        => \$tmpdir,
+        'pidfile=s'       => \$mysync->{pidfile},
+        'pidfilelocking!' => \$mysync->{pidfilelocking},
         'releasecheck!' => \$releasecheck,
         'modulesversion|modules_version!' => \$modulesversion,
         'usecache!'    => \$usecache,
@@ -9179,119 +11559,278 @@ sub get_options {
         'checkselectable!' => \$checkselectable,
         'checkmessageexists!' => \$checkmessageexists,
         'expungeaftereach!' => \$expungeaftereach,
-        'abletosearch!' => \$abletosearch,
-        'showpasswords!' => \$showpasswords,
-        'maxlinelength=i' => \$maxlinelength,
-        'maxlinelengthcmd=s' => \$maxlinelengthcmd,
-        'minmaxlinelength=i' => \$minmaxlinelength,
-        'debugmaxlinelength!' => \$debugmaxlinelength,
+        'abletosearch!'  => \$mysync->{abletosearch},
+        'abletosearch1!' => \$mysync->{abletosearch1},
+        'abletosearch2!' => \$mysync->{abletosearch2},
+        'showpasswords!' => \$mysync->{showpasswords},
+        'maxlinelength=i'        => \$maxlinelength,
+        'maxlinelengthcmd=s'     => \$maxlinelengthcmd,
+        'minmaxlinelength=i'     => \$minmaxlinelength,
+        'debugmaxlinelength!'    => \$debugmaxlinelength,
         'fixcolonbug!'           => \$fixcolonbug,
         'create_folder_old!'     => \$create_folder_old,
-        'maxmessagespersecond=f' => \$maxmessagespersecond,
-        'maxbytespersecond=i'    => \$maxbytespersecond,
+        'maxmessagespersecond=f' => \$mysync->{maxmessagespersecond},
+        'maxbytespersecond=i'    => \$mysync->{maxbytespersecond},
+	'maxbytesafter=i'        => \$mysync->{maxbytesafter},
+	'maxsleep=f'             => \$mysync->{maxsleep},
         'skipcrossduplicates!'   => \$skipcrossduplicates,
         'debugcrossduplicates!'  => \$debugcrossduplicates,
-        'log!'                   => \$sync->{log},
-        'logfile=s'        => \$sync->{logfile},
-        'logdir=s'         => \$sync->{logdir},
-        'errorsmax=i'      => \$sync->{errorsmax},
-        'errorsdump!'      => \$sync->{errorsdump},
+        'log!'                   => \$mysync->{log},
+        'logfile=s'        => \$mysync->{logfile},
+        'logdir=s'         => \$mysync->{logdir},
+        'errorsmax=i'      => \$mysync->{errorsmax},
+        'errorsdump!'      => \$mysync->{errorsdump},
         'fetch_hash_set=s' => \$fetch_hash_set,
-        'automap!'         => \$sync->{automap},
-        'justautomap!'     => \$sync->{justautomap},
-        'id!'              => \$sync->{id},
-        'f1f2=s%'          => \$sync->{f1f2},
-        'justfolderlists!' => \$sync->{justfolderlists},
-        'delete1emptyfolders' => \$sync->{delete1emptyfolders},
+        'automap!'         => \$mysync->{automap},
+        'justautomap!'     => \$mysync->{justautomap},
+        'id!'              => \$mysync->{id},
+        'f1f2=s%'          => \$mysync->{f1f2},
+        'justfolderlists!' => \$mysync->{justfolderlists},
+        'delete1emptyfolders' => \$mysync->{delete1emptyfolders},
         ) ;
 
+        $debug and output( $mysync, "get options: [$opt_ret][$numopt]\n"  ) ;
 
-	$debugcgi and myprint( map { "$_ => $ENV{$_}\n" } sort keys  %ENV   ) ;
-	$debugcgi and myprint( "@debugbasket\n"  ) ;
-        $debug and myprint( "get options: [$opt_ret]\n"  ) ;
-
-        # just the version
-        myprint( imapsync_version(  ), "\n" ) and exit 0 if ( $version ) ;
-        # $tmpdir is used in tests_pipemess()
-	$tmpdir ||= File::Spec->tmpdir(  ) ;
-	if ( $tests or $testsdebug ) {
-		$test_builder = Test::More->builder ;
-		if ( $tests ) { tests(  ) ; }
-		if ( $testsdebug ) { testsdebug(  ) ; }
-		#$test_builder->reset(  ) ;
-		exit ;
+	if ( ! $opt_ret ) {
+		return ;
 	}
+	return $numopt ;
+}
 
-	#$help = 1 if ! $numopt;
-	load_modules(  );
-
-	# exit with --help option or no option at all
-	$debug and myprint( "numopt:$numopt\n"  ) ;
-        usage(  ) and exit  if ( $help or not $numopt ) ;
-
-	# don't go on if options are not all known.
-        exit $EX_USAGE unless ( $opt_ret ) ;
-
-	# init live varaiables
-	testslive(  ) if ( $testslive ) ;
+sub get_options  {
+	my $mysync = shift @ARG ;
+	my @arguments = @ARG ;
+	my $mycgi = $mysync->{cgi} ;
 
+	if ( under_cgi_context(  ) ) {
+		# CGI context
+		return get_options_cgi( $mysync, @arguments )  ;
+	}else{
+		# Command line context ;
+		return get_options_cmd( $mysync, @arguments )  ;
+	}
 	return ;
 }
 
-sub testslive {
-	$host1 = 'test1.lamiral.info' ;
-	$user1 = 'test1' ;
-	$password1 = 'secret1' ;
-	$host2 = 'test2.lamiral.info' ;
-	$user2 = 'test2' ;
-	$password2 ='secret2' ;
+sub testunitsession {
+	my $mysync = shift ;
+	
+	if ( ! $mysync ) { return ; }
+	if ( ! $mysync->{ testsunit } ) { return ; }
+
+	my @functions = @{ $mysync->{ testsunit } } ;
+	
+	if ( ! @functions ) { return ; }
+
+	SKIP: {
+		if ( ! @functions ) { skip 'No test in normal run' ; }
+		testsunit( @functions ) ;
+                done_testing(  ) ;
+	}
+	return ;
+}
+
+sub tests_count_0s {
+	note( 'Entering tests_count_zeros()' ) ;
+	is( 0, count_0s(  ), 'count_0s: no parameters => undef' ) ;
+	is( 1, count_0s( 0 ), 'count_0s: 0 => 1' ) ;
+	is( 0, count_0s( 1 ), 'count_0s: 1 => 0' ) ;
+	is( 1, count_0s( 1, 0, 1 ), 'count_0s: 1, 0, 1 => 1' ) ;
+	is( 2, count_0s( 1, 0, 1, 0 ), 'count_0s: 1, 0, 1, 0 => 2' ) ;
+	note( 'Leaving  tests_count_zeros()' ) ;
+	return ;
+}
+sub count_0s {
+	my @array = @ARG ;
+	
+	if ( ! @array ) { return 0 ; }
+	my $nb_zeros = 0 ;
+	map { $_ == 0 and $nb_zeros += 1 } @array ;
+	return $nb_zeros ;
+}
+
+sub tests_report_failures {
+        note( 'Entering tests_report_failures()' ) ;
+	is( undef, report_failures(  ), 'report_failures: no parameters => undef' ) ;
+	is( "n° 1 - first\n", report_failures( ({'ok' => 0, name => 'first'}) ), 'report_failures: "first" failed => n° 1 - first' ) ;
+	is( q{}, report_failures( ( {'ok' => 1, name => 'first'} ) ), 'report_failures: "first" success =>' ) ;
+	is( "n° 2 - second\n", report_failures( ( {'ok' => 1, name => 'second'}, {'ok' => 0, name => 'second'} ) ), 'report_failures: "second" failed => n° 2 - second' ) ;
+	is( "n° 1 - first\nn° 2 - second\n", report_failures( ( {'ok' => 0, name => 'first'}, {'ok' => 0, name => 'second'} ) ), 'report_failures: both failed => n° 1 - first n° 2 - second' ) ;
+	note( 'Leaving  tests_report_failures()' ) ;
+	return ;
+}
+
+sub report_failures {
+	my @details = @ARG ;
+	
+	if ( ! @details ) { return ; }
+	
+	my $counter = 1 ;
+	my $report  = q{} ;
+	foreach my $details ( @details ) {
+		if ( ! $details->{ 'ok' } ) {
+			my $name = $details->{ 'name' } || 'NONAME' ;
+			$report .= "n° $counter - $name\n" ;
+		}
+		$counter += 1 ;
+	}
+	return $report ;
+
+}
+
+sub tests_true {
+	note( 'Entering tests_true()' ) ;
+	is( 1, 1, 'true: 1 is 1' ) ;
+	note( 'Leaving  tests_true()' ) ;
+	return ;
+}
+
+sub tests_testsunit {
+	note( 'Entering tests_testunit()' ) ;
+	is( undef, testsunit(  ), 'testsunit: no parameters => undef' ) ;
+	is( undef, testsunit( undef ), 'testsunit: an undef parameter => undef' ) ;
+	is( undef, testsunit( q{} ), 'testsunit: an empty parameter => undef' ) ;
+	is( undef, testsunit( 'idonotexist' ), 'testsunit: a do not exist function as parameter => undef' ) ;
+	is( undef, testsunit( 'tests_true' ), 'testsunit: tests_true => undef' ) ;
+	note( 'Leaving  tests_testunit()' ) ;
+	return ;
+}
+
+sub testsunit {
+	my @functions = @ARG ;
+	
+	if ( ! @functions ) { #
+                myprint( "testsunit warning: no argument given\n" ) ;
+                return ; 
+        }
+			
+	foreach my $function ( @functions ) {
+		if ( ! $function ) {
+                        myprint( "testsunit warning: argument is empty\n" ) ;
+                        next ; 
+                }
+		if ( ! exists &$function ) {
+                        myprint( "testsunit warning: function $function does not exist\n" ) ;
+                        next ; 
+                }
+		if ( ! defined &$function ) {
+                        myprint( "testsunit warning: function $function is not defined\n" ) ;
+                        next ; 
+                }
+		my $function_ref = \&{ $function } ;
+		&$function_ref() ; 
+	}
 	return ;
 }
 
 sub testsdebug {
-      SKIP: {
-                skip 'No test in normal run' if ( not $testsdebug ) ;
+	my $mysync = shift ;
+	if ( ! $mysync->{ testsdebug } ) { return ; }
+	SKIP: {
+                if ( ! $mysync->{ testsdebug } ) { 
+			skip 'No test in normal run' ;
+		}
+		
+		note( 'Entering testsdebug()' ) ;
+		ok( ( ( not -d 'W/tmp/tests' ) or rmtree( 'W/tmp/tests/' ) ), 'testsdebug: rmtree W/tmp/tests' ) ;
                 #tests_bytes_display_string(  ) ;
                 #tests_ucsecond(  ) ;
                 #tests_mkpath(  ) ;
-                #eval { tests_mkpath(  ) ; } or ok( 0 == 1,  'tests_mkpath fail badly?' ) ;
                 #tests_format_for_imap_arg(  ) ;
                 #tests_is_a_release_number(  ) ;
                 #tests_delete1emptyfolders(  ) ;
                 #tests_memory_consumption(  ) ;
                 #tests_imap2_folder_name() ;
                 #tests_length_ref(  ) ;
-		#tests_is_valid_directory(  ) ;
-                #tests_firstline(  ) ;
                 #tests_diff_or_NA(  ) ;
                 #tests_match_number(  ) ;
                 #tests_all_defined(  ) ;
                 #tests_guess_separator(  ) ;
-                tests_pipemess(  ) ;
                 #tests_message_for_host2(  ) ;
+                #tests_special_from_folders_hash(  ) ;
+                #tests_do_valid_directory(  ) ;
+		#tests_notmatch(  ) ;
+		#tests_match(  ) ;
+		#tests_get_options(  ) ;
+		#tests_rand32(  ) ;
+		#tests_string_to_file(  ) ;
+		#tests_hashsynclocal(  ) ;
+		#tests_output(  ) ;
+		#tests_output_reset_with(  ) ;
+		#tests_output_start(  ) ;
+		#tests_hashsync(  ) ;
+		#tests_check_last_release(  ) ;
+		#tests_cpu_number(  ) ;
+		#tests_load_and_delay(  ) ;
+		#tests_loadavg(  ) ;
+                #tests_backtick(  ) ;
+                #tests_firstline(  ) ;
+                #tests_pipemess(  ) ;
+		#tests_not_long_imapsync_version_public(  ) ;
+		#tests_get_options_cgi(  ) ;
+                #tests_guess_special(  ) ;
+####tests_reconnect_if_needed(  ) ;
+		#tests_reconnect_12_if_needed(  ) ;
+                #tests_sleep_max_bytes(  ) ;
+		#tests_file_to_string(  ) ;
+		#tests_under_cgi_context(  ) ;
+		#tests_umask(  ) ;
+		#tests_umask_str(  ) ;
+		#tests_set_umask(  ) ;
+		#tests_createhashfileifneeded(  ) ;
+                #tests_filter_forbidden_characters(  ) ;
+                #tests_logfile(  ) ;
+                #tests_setlogfile(  ) ;
+		#tests_move_slash(  ) ;
+		#tests_testsunit(  ) ;
+		#tests_always_fail(  ) ;
+		#tests_count_0s(  ) ;
+		#tests_report_failures(  ) ;
+		#tests_max(  ) ;
+		#tests_min(  ) ;
+		#tests_sleep_if_needed(  ) ;
+		#tests_imapsping(  ) ;
+		#tests_tcpping(  ) ;
+		#tests_sslcheck(  ) ;
+		#tests_resolv(  ) ;
+		#tests_resolvrev(  ) ;
+		#tests_connect_socket(  ) ;
+                #tests_probe_imapssl(  ) ;
+                #tests_mailimapclient_connect(  ) ;
+                #tests_guess_prefix(  ) ;
+                #tests_usage(  ) ;
+                #tests_version_from_rcs(  ) ;
+                #tests_mailimapclient_connect_bug(  ) ; # it fails with Mail-IMAPClient <= 3.39
+                tests_backslash_caret(  ) ;
+
+		note( 'Leaving  testsdebug()' ) ;
                 done_testing(  ) ;
-                note('End of imapsync --tests_debug') ;
         }
         return ;
 }
 
-sub tests {
 
-      SKIP: {
-                skip 'No test in normal run' if ( not $tests ) ;
+
+sub tests {
+	my $mysync = shift ;
+	if ( ! $mysync->{ tests } ) { return ; }
+
+	SKIP: {
+                skip 'No test in normal run' if ( ! $mysync->{ tests } ) ;
+		note( 'Entering tests()' ) ;
                 tests_folder_routines(  ) ;
                 tests_compare_lists(  ) ;
-                tests_regexmess();
+                tests_regexmess(  ) ;
                 tests_skipmess(  ) ;
                 tests_flags_regex();
                 tests_ucsecond(  ) ;
                 tests_permanentflags();
                 tests_flags_filter(  ) ;
                 tests_separator_invert(  ) ;
-                tests_imap2_folder_name() ;
-                tests_command_line_nopassword();
+                tests_imap2_folder_name(  ) ;
+                tests_command_line_nopassword(  ) ;
                 tests_good_date(  ) ;
-                tests_max();
+                tests_max(  ) ;
                 tests_remove_not_num();
                 tests_memory_consumption( ) ;
                 tests_is_a_release_number();
@@ -9305,7 +11844,7 @@ sub tests {
                 tests_clean_cache_2(  ) ;
                 tests_touch(  ) ;
                 tests_flagscase(  ) ;
-                eval { tests_mkpath(  ) ; } or ok( 0 == 1,  'tests_mkpath fail badly?' ) ;
+                tests_mkpath(  ) ;
                 tests_extract_header(  ) ;
                 tests_decompose_header(  ) ;
                 tests_epoch(  ) ;
@@ -9316,7 +11855,6 @@ sub tests {
                 tests_cache_folder(  ) ;
                 tests_time_remaining(  ) ;
                 tests_decompose_regex(  ) ;
-                tests_Banner(  ) ;
                 tests_backtick(  ) ;
                 tests_bytes_display_string(  ) ;
                 tests_header_line_normalize(  ) ;
@@ -9340,149 +11878,63 @@ sub tests {
                 tests_quota_extract_storage_limit_in_bytes(  ) ;
                 tests_quota_extract_storage_current_in_bytes(  ) ;
                 tests_guess_special(  ) ;
-		tests_is_valid_directory(  ) ;
+                tests_do_valid_directory(  ) ;
                 tests_delete1emptyfolders(  ) ;
                 tests_message_for_host2(  ) ;
                 tests_length_ref(  ) ;
-                tests_firstline(  ) ;               
+                tests_firstline(  ) ;
                 tests_diff_or_NA(  ) ;
-                #tests_always_fail(  ) ;
                 tests_match_number(  ) ;
                 tests_all_defined(  ) ;
-                done_testing( 693 ) ;
-                note('End of imapsync --tests') ;
+                tests_special_from_folders_hash(  ) ;
+		tests_notmatch(  ) ;
+		tests_match(  ) ;
+		tests_get_options(  ) ;
+		tests_get_options_cgi(  ) ;
+		tests_rand32(  ) ;
+		tests_hashsynclocal(  ) ;
+		tests_hashsync(  ) ;
+		tests_output(  ) ;
+		tests_output_reset_with(  ) ;
+		tests_output_start(  ) ;
+		tests_check_last_release(  ) ;
+		tests_loadavg(  ) ;
+		tests_cpu_number(  ) ;
+		tests_load_and_delay(  ) ;
+		#tests_imapsping(  ) ;
+		#tests_tcpping(  ) ;
+		tests_sslcheck(  ) ;
+		tests_not_long_imapsync_version_public(  ) ;
+		tests_reconnect_if_needed(  ) ;
+		tests_reconnect_12_if_needed(  ) ;
+		tests_sleep_if_needed(  ) ;
+		tests_string_to_file(  ) ;
+		tests_file_to_string(  ) ;
+		tests_under_cgi_context(  ) ;
+		tests_umask(  ) ;
+		tests_umask_str(  ) ;
+		tests_set_umask(  ) ;
+		tests_createhashfileifneeded(  ) ;
+		tests_move_slash(  ) ;
+		tests_testsunit(  ) ;
+		tests_count_0s(  ) ;
+		tests_report_failures(  ) ;
+		tests_min(  ) ;
+		#tests_resolv(  ) ;
+		#tests_resolvrev(  ) ;
+		tests_connect_socket(  ) ;
+                tests_probe_imapssl(  ) ;
+                tests_mailimapclient_connect(  ) ;
+                tests_usage(  ) ;
+                tests_version_from_rcs(  ) ;
+                tests_backslash_caret(  ) ;
+                #tests_mailimapclient_connect_bug(  ) ; # it fails with Mail-IMAPClient <= 3.39
+		#tests_always_fail(  ) ;
+		done_testing( 1012 ) ;
+		note( 'Leaving  tests()' ) ;
         }
         return ;
 }
 
 
 
-# IMAPClient 3.xx ads
-
-package Mail::IMAPClient;
-
-sub Tls {
-	my $self  = shift ;
-	my $value = shift ;
-	if ( defined  $value  ) { $self->{TLS} = $value }
-	return $self->{TLS};
-}
-
-sub Reconnect_counter {
-	my $self  = shift ;
-        my $value = shift ;
-	$self->{Reconnect_counter} = 0 if ( not defined  $self->{Reconnect_counter}  ) ;
-	if ( defined  $value  ) { $self->{Reconnect_counter} = $value }
-	return( $self->{Reconnect_counter} ) ;
-}
-
-
-sub Banner {
-	my $self  = shift ;
-	my $value = shift ;
-	if ( defined $value ) { $self->{ BANNER } = $value }
-	return $self->{ BANNER };
-}
-
-sub capability_update {
-	my $self = shift ;
-
-	delete $self->{CAPABILITY} ;
-	return( $self->capability ) ;
-}
-
-
-package Imapsync::Getopt::Long ;
-# Started as a copy of Luke Ross Getopt::Long::CGI
-# https://metacpan.org/release/Getopt-Long-CGI
-# So this section is under the same license as Getopt-Long-CGI Luke Ross wants it,
-# which was Perl 5.6 or later licenses at the date of the copy.
-
-use strict ;
-use warnings ;
-
-use Getopt::Long(  ) ;
-
-
-sub GetOptions {
-    my %options = @_ ;
-
-    if ( not $ENV{SERVER_SOFTWARE} ) {
-        # Not CGI - pass upstream for normal command line handling
-        return Getopt::Long::GetOptions( %options ) ;
-    }
-    my $b_ref = $options{'debugbasket=s'} ;
-    require CGI ;
-    require CGI::Carp ;
-    CGI::Carp->import( 'fatalsToBrowser' ) ;
-
-    my $cgi = CGI->new(  ) ;
-    $cgi->param( 'debugcgi' ) and myprint( "
              Current Values
              \n" . $cgi->Dump  ) ;
-
-    foreach my $key (sort keys %options) {
-        my $val = $options{$key};
-	#push( @{$b_ref}, "opt:[$key] val:[$val]" . ( ('SCALAR' eq ref($val) and defined  $$val  ) ? " [$$val]" : q{} ) . "\n" ) ;
-        if ( $key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/ ) {
-		push  @{$b_ref}, "Unknown opt: [$key]\n"  ;
-            next ; # Unknown item
-        }
-
-        my $name = [split '|', $1, 1 ]->[0];
-
-        if (($3 || q{}) eq '+') {
-            ${ $val } = $cgi->param($name); # "Incremental" integer
-        } elsif ($2) {
-            my @values = $cgi->param($name);
-            my $type = $2;
-            if (($3 || q{}) eq '%' or ref($val) eq 'HASH') {
-                my %values = map { split /=/, $_, 1 } @values;
-                if ($type =~ m/i$/) {
-                    foreach my $k (keys %values) {
-                        $values{$k} = int $values{$k} ;
-                    }
-                } elsif ($type =~ m/f$/) {
-                    foreach my $k (keys %values) {
-                        $values{$k} = 0 + $values{$k}
-                    }
-                }
-                if ( ref($val) eq 'CODE') {
-                    while(my($k, $v) = each %values) {
-                       $val->($name, $k, $v);
-                    }
-                } elsif ( 'REF' eq ref $val ) {
-			#push( @{$b_ref}, "refref($$val): " . ref($$val) . " %values= ", %values, "\n\n" ) ;
-			%{ ${ $val } } = %values;
-		} else {
-			#push( @{$b_ref}, "ref($val): " . ref($val) . " %values= ", %values, "\n\n" ) ;
-			%{ $val } = %values;
-                }
-            } else {
-                if ($type =~ m/i$/) {
-                    @values = map { int $_ } @values;
-                } elsif ($type =~ m/f$/) {
-                    @values = map { 0 + $_ } @values;
-                }
-                if (($3 || q{}) eq '@' or ref($val) eq 'ARRAY') {
-                    if (ref($val) eq 'CODE') {
-                        $val->($name, \@values)
-                    } else {
-                        @{ $val } = @values ;
-                    }
-                } else {
-                    if (ref($val) eq 'CODE') {
-                        $val->($name, $values[0]);
-                    } else {
-                    	${ $val } = $values[0];
-                    }
-                }
-            }
-        } else {
-            # Checkbox
-            ${ $val } = $cgi->param($name) ? 1 : undef ;
-	    #push( @{$b_ref}, "param($name) ref($val): " . ref($val) . " val=[$$val]\n\n" ) ;
-        }
-    }
-    return( 1 ) ;
-}
-
-
diff --git a/index.shtml b/index.shtml
index ebb1b11..72c1398 100644
--- a/index.shtml
+++ b/index.shtml
@@ -5,7 +5,6 @@
 
 
 
-
 Official imapsync migration tool ( release <!--#exec cmd="cat ./VERSION"--> )
 
 
@@ -20,6 +19,11 @@
 
 
 
+
+
+
 
 
 
@@ -27,22 +31,26 @@
 
              
 
 
 
              
-After the imapsync installation you should go  to the documentation section just below 
+After the imapsync installation you should go to the documentation section just below.
 
              
 
 
              Documentation (back to menu)
              
@@ -448,44 +476,56 @@ to understand imapsync and succeed in your migration or backup.
 
              
 
 
-
              The FAQ and FAQ.d/* files present Frequently Asked Questions 
-(and not so frequently asked ones) and their answers. Here is the menu:
              
+
              The FAQ.d/* files present Frequently Asked Questions 
+(and not so frequently asked ones) and their answers. Here is the main menu:
              
   
   
               Tips about imap server softwares:
 
 
 
              
 
 
              Solving problems:
 
 
 
              
 
 
              Various tips: 
 
 
                
+
              •  General FAQ. 
                • 
+
              •  Reporting bugs. 
                • 
 
              •  Massive/bulk migrations. 
                • 
 
              •  ISP. 
                • 
+
              •  TTL  (MX change in DNS). 
                • 
 
              •  Selecting messages. 
                • 
 
              •  Selecting folders. 
                • 
+
              •  Admin authentication. 
                • 
 
              •  Archiving tips. 
                • 
 
              •  Security. 
                • 
 
              •  Emptying an account. 
                • 
@@ -541,7 +581,7 @@ style="border:0;width:88px;height:31px"
 
 
 This document last modified on 
-($Id: index.shtml,v 1.305 2016/08/18 09:55:44 gilles Exp gilles $)
                
+($Id: index.shtml,v 1.341 2017/09/05 15:21:01 gilles Exp gilles $)
                
 Top of the page
 
                
 
diff --git a/tests.sh b/tests.sh
index 94cb044..244bde3 100644
--- a/tests.sh
+++ b/tests.sh
@@ -1,9 +1,12 @@
 #!/bin/sh
 
-# $Id: tests.sh,v 1.282 2016/08/19 17:53:47 gilles Exp gilles $  
+# $Id: tests.sh,v 1.298 2017/09/05 15:22:55 gilles Exp gilles $  
+
+# general tests start
+# general tests end
 
 # Example 1:
-# CMD_PERL='perl -I./W/Mail-IMAPClient-3.38/lib' sh -x tests.sh
+# CMD_PERL='perl -I./W/Mail-IMAPClient-3.39/lib' sh -x tests.sh
 
 # Example 2:
 # To select which Mail-IMAPClient within arguments:
@@ -22,7 +25,7 @@ echo HOST2=$HOST2
 # most tests use:
 
 # few debugging tests use:
-CMD_PERL_3xx='perl -I./W/Mail-IMAPClient-3.38/lib'
+CMD_PERL_3xx='perl -I./W/Mail-IMAPClient-3.39/lib'
 
 CMD_PERL=${CMD_PERL:-$CMD_PERL_3xx}
 
@@ -49,8 +52,11 @@ echolog() {
 
 run_test() {
         echo3 "#### $tests_count $1"
-        $1
-        run_test_status=$?
+	setxon
+	# do not run anything between the two following instructions
+        $1; run_test_status=$?
+	# now you can run
+	setxback 2> /dev/null
         if test x"$run_test_status" = x"0"; then
                 echo "$1 passed"
         else
@@ -59,6 +65,21 @@ run_test() {
         return $run_test_status
 }
 
+setxon() {
+	if ! { echo $-|grep x ; } ; then
+		#echo 'set -x was off'
+		setx_restore_cmd='set +x'
+		set -x
+	else
+		echo 'set -x already on'
+		setx_restore_cmd=""
+	fi 
+}
+
+setxback() {
+	$setx_restore_cmd
+}
+
 run_tests() {
         for t in "$@"; do
                 test X"$t" = X3 && CMD_PERL=$CMD_PERL_3xx && continue
@@ -135,11 +156,19 @@ can_send() {
     return 1
 }
 
+at_home() {
+    test X`hostname` = X"petite" && return 0;
+    return 1
+}
+
+
 zzzz() {
         $CMD_PERL -V
 
 }
 
+# general tests start
+
 option_version() {
         $CMD_PERL ./imapsync --version
 }
@@ -149,6 +178,21 @@ option_tests() {
         $CMD_PERL ./imapsync --tests
 }
 
+option_tests_in_var_tmp_sub() {
+	( 
+	mkdir -p /var/tmp/imapsync_tests
+	cd /var/tmp/imapsync_tests
+        /g/public_html/imapsync/i3 --tests
+	)
+}
+
+option_tests_in_var_tmp() {
+	( 
+	cd /var/tmp/
+        /g/public_html/imapsync/i3 --tests
+	)
+}
+
 option_tests_debug() {
         $CMD_PERL ./imapsync --tests_debug
 }
@@ -174,6 +218,40 @@ passwords_parenthese() {
 	$CMD_PERL ./imapsync --host1 $HOST1 --user1 ee --password1 'secret )' --host2 $HOST2 --user2 ee --password2 '(secret' --showpasswords --debugimap1
 }
 
+passfile1_noexist() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 /noexists \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi 
+	 test "$?" = "66"
+}
+passfile2_noexist() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata  \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 /noexists
+	 test "$?" = "66"
+}
+
+
+ll_showpasswords() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --password1 'ami\"seen' \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+	 --justlogin --showpasswords --debugimap1 
+}
+
+testslive() {
+        $CMD_PERL ./imapsync --testslive
+}
+
+testslive6() {
+        $CMD_PERL ./imapsync --testslive6
+}
 
 
 first_sync_dry() {
@@ -195,7 +273,6 @@ first_sync() {
 
 
 ll() {
-        #can_send && sendtestmessage
         $CMD_PERL  ./imapsync \
          --host1 $HOST1 --user1 tata \
          --passfile1 ../../var/pass/secret.tata \
@@ -203,6 +280,99 @@ ll() {
          --passfile2 ../../var/pass/secret.titi 
 }
 
+ll_minsize() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+		 --minsize 1000000 --folder INBOX
+}
+
+ll_search_larger() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+		 --search 'LARGER 1000' --folder INBOX
+}
+
+
+ll_maxsize() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+		 --maxsize 1000 --folder INBOX
+}
+
+ll_search_smaller() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+		 --search 'SMALLER 1000' --folder INBOX
+}
+
+
+
+ll_abort_nopidfile() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+	 --abort --pidfile /noexist
+}
+
+ll_abort_noprocess() {
+	echo 999999 > /tmp/imapsync_fake.pid
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+	 --abort --pidfile /tmp/imapsync_fake.pid
+}
+
+ll_abort() {
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+	 --pidfile /tmp/imapsync_abortme.pid &
+	 
+	 sleep 3
+
+	 $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+	 --abort --pidfile /tmp/imapsync_abortme.pid
+
+
+}
+
+
+
+
+ll_nouid1() {
+        can_send && sendtestmessage
+        $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+	 --nouid1 --folder INBOX --debugimap1
+}
+
+
+
 ll_eta() {
         can_send && sendtestmessage
         can_send && sendtestmessage
@@ -339,6 +509,16 @@ ll_ask_password() {
                 --justlogin
 }
 
+ll_env_password() {
+		set +x
+		IMAPSYNC_PASSWORD1=`cat ../../var/pass/secret.tata` \
+		IMAPSYNC_PASSWORD2=`cat ../../var/pass/secret.titi` \
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1 --user1 tata \
+                --host2 $HOST2 --user2 titi --passfile2 ../../var/pass/secret.titi \
+                --justlogin
+}
+
 
 ll_authmech_PREAUTH() {
 		# No PREAUTH on my box
@@ -367,7 +547,7 @@ ll_timeout() {
                 --passfile1 ../../var/pass/secret.tata \
                 --host2 $HOST2 --user2 titi \
                 --passfile2 ../../var/pass/secret.titi \
-                --folder INBOX --timeout 1 --justlogin
+                --folder INBOX --timeout 3 --justlogin
 }
 
 ll_timeout1_timeout2() {
@@ -376,7 +556,7 @@ ll_timeout1_timeout2() {
                 --passfile1 ../../var/pass/secret.tata \
                 --host2 $HOST2 --user2 titi \
                 --passfile2 ../../var/pass/secret.titi \
-                --folder INBOX --timeout1 1 --timeout2 2 --justlogin
+                --folder INBOX --timeout1 4 --timeout2 5 --justlogin
 }
 
 ll_timeout_timeout1() {
@@ -385,7 +565,7 @@ ll_timeout_timeout1() {
                 --passfile1 ../../var/pass/secret.tata \
                 --host2 $HOST2 --user2 titi \
                 --passfile2 ../../var/pass/secret.titi \
-                --folder INBOX --timeout1 1 --timeout 2 --justlogin
+                --folder INBOX --timeout1 5 --timeout 4 --justlogin
 }
 
 
@@ -429,6 +609,25 @@ ll_star() {
                 --folder 'INBOX.backstar\*' --dry --justfolders --regextrans2 's,\*,_,g'
 }
 
+ll_tr() {
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1  --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --dry --justfolders --regextrans2 'tr/a/_/'
+}
+
+ll_regextrans2_d() {
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1  --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --dry --justfolders --regextrans2 's,INBOX\.,,'
+}
+
+
 lks_trailing_space() {
                 $CMD_PERL ./imapsync \
                 --host1 $HOST1  --user1 tata \
@@ -537,6 +736,31 @@ ll_folder_domino_sub() {
 		--justfolders  --dry --debug 
 }
 
+ll_domino2() {
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1  --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --folder INBOX.yop.yap.yip --regextrans2 's/yop/newyop/' \
+                --domino2 \
+		--subfolder2 'OLDBOX' \
+		--justfolders  --dry --debug 
+
+}
+
+ll_domino1_domino2() {
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1  --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --folder INBOX.yop.yap.yip --regextrans2 's/yop/newyop/' \
+                --domino1 --domino2 \
+		--subfolder2 'OLDBOX' \
+		--justfolders  --dry
+}
+
 
 
 
@@ -818,9 +1042,21 @@ ll_justfolders_delete1emptyfolders() {
                 --passfile1 ../../var/pass/secret.tata \
                 --host2 $HOST2 --user2 titi \
                 --passfile2 ../../var/pass/secret.titi \
-                --justfolders  --delete1emptyfolders --include Empty --folder INBOX --folderfirst INBOX.Empty.Empty
+                --justfolders  --delete1emptyfolders --delete --include Empty --folder INBOX --folderfirst INBOX.Empty.Empty
 }
 
+ll_delete1_delete1emptyfolders() {
+                ./W/learn/create_folder localhost tata `cat /g/var/pass/secret.tata` INBOX.Empty INBOX.Empty.Empty INBOX.Empty.Empty.Empty
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1  --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --delete1emptyfolders --delete1 --include Empty --folder INBOX --folderfirst INBOX.Empty.Empty --dry
+}
+
+
+
 ll_justfolders_skipemptyfolders() {
                 $CMD_PERL ./imapsync \
                 --host1 $HOST1  --user1 tata \
@@ -1056,11 +1292,49 @@ ll_nosubscribe()
 ll_justconnect() 
 {
                 $CMD_PERL ./imapsync    \
-                --host2 $HOST2 \
                 --host1 $HOST1 \
-                --justconnect --timeout 1
+                --host2 $HOST2 \
+                --justconnect 
 }
 
+
+
+
+
+ll_justconnect_ipv6()
+{
+        $CMD_PERL ./imapsync    \
+                --host1 "::1" \
+                --host2 "::1" \
+                --justconnect 
+}
+
+ll_justconnect_ipv6_nossl()
+{
+        $CMD_PERL ./imapsync    \
+                --host1 "::1" --nossl1 \
+                --host2 "::1" --nossl2 \
+                --justconnect 
+}
+
+ks_justconnect_ipv6()
+{
+        $CMD_PERL ./imapsync    \
+                --host1 ks2ipv6.lamiral.info \
+                --host2 ks2ipv6.lamiral.info \
+                --justconnect 
+}
+
+ks_justconnect_ipv6_nossl()
+{
+        $CMD_PERL ./imapsync    \
+                --host1 ks2ipv6.lamiral.info --nossl1 \
+                --host2 ks2ipv6.lamiral.info --nossl2 \
+                --justconnect 
+}
+
+
+
 ll_justfoldersizes() 
 {
                 $CMD_PERL ./imapsync \
@@ -1458,6 +1732,39 @@ ll_search_SENTSINCE_and_BEFORE_search2()
 	--search2 'ALL' --folder INBOX --delete2
 }
 
+ll_search_HEADER_attachment() 
+{
+        $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --search "OR HEADER Content-Disposition attachment HEADER Content-Type multipart/mixed" \
+	--folder INBOX
+}
+
+ll_search_HEADER_attachment_multipart() 
+{
+        $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --search "HEADER Content-Type multipart/mixed" \
+	--folder INBOX
+}
+
+ll_search_NOT_SUBJECT() 
+{
+        $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --search "NOT SUBJECT test:" \
+	--folder INBOX
+}
+
 
 
 
@@ -1481,7 +1788,28 @@ ll_nosearch_hack()
         --passfile1 ../../var/pass/secret.tata \
         --host2 $HOST2 --user2 titi \
         --passfile2 ../../var/pass/secret.titi \
-        --folder INBOX.few_emails --debugdev --debugimap1 --noabletosearch
+        --folder INBOX.few_emails --noabletosearch --debugimap
+	# --debugdev --debugimap
+}
+
+ll_noabletosearch1() 
+{
+        $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --folder INBOX.few_emails --noabletosearch1 --debugimap
+}
+
+ll_noabletosearch2() 
+{
+        $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --folder INBOX.few_emails --noabletosearch2 --debugimap
 }
 
 
@@ -2109,12 +2437,13 @@ ll_skipmess()
                 #echo3 Here is plume
 		sendtestmessage tata 
         fi
+        sendtestmessage tata 
 	$CMD_PERL ./imapsync \
         --host1 $HOST1 --user1 tata \
         --passfile1 ../../var/pass/secret.tata \
         --host2 $HOST2 --user2 titi \
         --passfile2 ../../var/pass/secret.titi \
-        --folder INBOX --nofoldersizes --noreleasecheck \
+        --folder INBOX --nofoldersizes \
         --skipmess 'm{.*}ism' 
 }
 
@@ -2175,6 +2504,17 @@ ll_regexmess()
 	fi
 }
 
+ll_regexmess_bad_regex() 
+{
+        ! $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --folder INBOX.yop.yap \
+        --regexmess 'I am BAD' 
+}
+
 ll_regexmess_trailing_NUL() 
 {
         if can_send; then 	
@@ -2198,17 +2538,56 @@ ll_regexmess_trailing_NUL()
 }
 
 
-ll_regexmess_bad_regex() 
+ll_regexmess_add_header() 
 {
-        ! $CMD_PERL ./imapsync \
-        --host1 $HOST1 --user1 tata \
-        --passfile1 ../../var/pass/secret.tata \
-        --host2 $HOST2 --user2 titi \
-        --passfile2 ../../var/pass/secret.titi \
-        --folder INBOX.yop.yap \
-        --regexmess 'I am BAD' 
+        if at_home; then
+                rm -f /home/vmail/titi/.yop.yap/cur/*
+        fi
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1 --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --folder INBOX.yop.yap \
+                --regexmess 's/\A/X-migrated-from-foo: 20100617\n/' \
+		--search 'SUBJECT add_some_header_please'  \
+                --debugcontent --dry
+                
+        if at_home; then 	
+		file=`ls -t /home/vmail/titi/.yop.yap/cur/* | tail -1`
+                diff ../../var/imapsync/tests/ll_regexmess/dest_03_add_some_header $file || return 1
+                echo 'sudo rm -fv /home/vmail/titi/.yop.yap/cur/*'
+	fi
 }
 
+ll_regexmess_change_header() 
+{
+# 
+# --regexmess 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}xms'
+        if at_home; then
+                rm -f /home/vmail/titi/.yop.yap/cur/*
+        fi
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1 --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --folder INBOX.yop.yap \
+                --regexmess 's{\A(.*?(?! ^$))^Date:\ \(Invalid\)(.*?)$}{$1Date: Thu, 1 Jun 2017 23:59:59 +0000}xms' \
+				--search "HEADER Date Invalid"  \
+                --debugcontent --dry
+                
+}
+
+ll_search_not_header() {
+                $CMD_PERL ./imapsync \
+                --host1 $HOST1 --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+                --folder INBOX.yop.yap \
+				--search "NOT HEADER Date Invalid" --debugcontent --dry
+}
 
 ll_regexmess_remove_header_Disposition() 
 {
@@ -2385,10 +2764,10 @@ ll_regex_flag6_add_SEEN()
 	$CMD_PERL ./imapsync \
         --host1 $HOST1 --user1 tata \
         --passfile1 ../../var/pass/secret.tata \
-        --host2 $HOST2 --user2 titi \
-        --passfile2 ../../var/pass/secret.titi \
-        --folder INBOX.yop.yap \
-        --debugflags --regexflag "s/(.*)/\$1 \\\\Seen/"
+        --host2 $HOST2 --user2 tata \
+        --passfile2 ../../var/pass/secret.tata \
+        --folder INBOX.flagsetSeen \
+        --debugflags --regexflag "s/(.*)/\$1 \\\\Seen/" --dry 
 
         echo 'rm -f /home/vmail/titi/.yop.yap/cur/*'
 }
@@ -2401,11 +2780,23 @@ ll_regex_flag7_add_SEEN()
         --host2 $HOST2 --user2 titi \
         --passfile2 ../../var/pass/secret.titi \
         --folder INBOX.yop.yap \
-        --debugflags --regexflag 's/(.*)/$1 \\Seen/'
+        --debugflags --regexflag 's,, \\Seen,' --dry 
 
         echo 'rm -f /home/vmail/titi/.yop.yap/cur/*'
 }
 
+ll_regex_flag8_add_SEEN_if_not_here() 
+{
+	$CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --folder INBOX.flagsetSeen --nofoldersizes \
+        --debugflags --dry --regexflag 's,^((?!\\Seen)).*$,$1 \\Seen,'
+
+}
+
 
 ll_regex_flag_keep_only() 
 {
@@ -2456,8 +2847,8 @@ ll_tls_justlogin() {
 
 
 ll_tls_devel() {
-   ll_justlogin ll_ssl_justlogin \
-&& ll_tls_justconnect ll_tls_justlogin
+   ll_justlogin && ll_ssl_justlogin \
+&& ll_tls_justconnect && ll_tls_justlogin
 }
 
 ll_tls() {
@@ -2628,7 +3019,7 @@ ll_authmech_ssl_cmich() {
 
 
 ll_authmech_XOAUTH_gmail() {
-                ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \
+                ! ping -c2 imap.gmail.com || $CMD_PERL ./imapsync \
                 --host1 imap.gmail.com --ssl1 --user1 imapsync@lab3.dedalusprime.com.br \
                 --passfile1 ../../var/pass/secret.xoauth \
                 --host2 imap.gmail.com --ssl2 --user2 imapsync@lab3.dedalusprime.com.br \
@@ -2777,24 +3168,24 @@ ll_delete2_reverse() {
 
 
 
-ll_delete_reverse() {
+ll_delete1_reverse() {
         $CMD_PERL ./imapsync \
         --host1 $HOST1 --user1 titi \
         --passfile1 ../../var/pass/secret.titi \
         --host2 $HOST2 --user2 tata \
         --passfile2 ../../var/pass/secret.tata \
         --folder INBOX \
-        --delete --minage 100 --maxage 300 --noexpungeaftereach
+        --delete1 --minage 100 --maxage 300 --noexpungeaftereach --nofoldersizes
 }
 
-ll_delete_reverse_useuid() {
+ll_delete1_reverse_useuid() {
         $CMD_PERL ./imapsync \
         --host1 $HOST1 --user1 titi \
         --passfile1 ../../var/pass/secret.titi \
         --host2 $HOST2 --user2 tata \
         --passfile2 ../../var/pass/secret.tata \
         --folder INBOX \
-        --delete --minage 100 --maxage 300 --noexpungeaftereach \
+        --delete1 --minage 100 --maxage 300 --noexpungeaftereach \
 	--useuid
 }
 
@@ -2810,7 +3201,7 @@ ll_delself() {
         --passfile1 ../../var/pass/secret.delme \
         --host2 $HOST2 --user2 delme \
         --passfile2 ../../var/pass/secret.delme \
-        --delete --noexpungeaftereach
+        --delete1 --noexpungeaftereach
 
         $CMD_PERL ./imapsync \
         --host1 $HOST1 --user1 delme \
@@ -2824,7 +3215,7 @@ ll_delself() {
 
 
 ll_maxmessagespersecond() {
-	ll_delete_reverse
+	ll_delete1_reverse
         $CMD_PERL ./imapsync \
         --host1 $HOST1 --user1 tata \
         --passfile1 ../../var/pass/secret.tata \
@@ -2835,14 +3226,25 @@ ll_maxmessagespersecond() {
 }
 
 ll_maxbytespersecond() {
-	ll_delete_reverse
+	ll_delete1_reverse
         $CMD_PERL ./imapsync \
         --host1 $HOST1 --user1 tata \
         --passfile1 ../../var/pass/secret.tata \
         --host2 $HOST2 --user2 titi \
         --passfile2 ../../var/pass/secret.titi \
         --folder INBOX \
-	--maxbytespersecond 10000
+	--maxbytespersecond 2000 --nofoldersizes
+}
+
+ll_maxbytesafter() {
+	ll_delete1_reverse
+        $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 $HOST2 --user2 titi \
+        --passfile2 ../../var/pass/secret.titi \
+        --folder INBOX \
+	--maxbytespersecond 1000 --maxbytesafter 20000 --nofoldersizes
 }
 
 
@@ -2928,7 +3330,7 @@ ll_delete() {
         --passfile1 ../../var/pass/secret.tata \
         --host2 $HOST2 --user2 titi \
         --passfile2 ../../var/pass/secret.titi \
-        --folder INBOX.oneemail3 --delete
+        --folder INBOX.oneemail3 --delete1
 
 	#find /home/vmail/titi/.oneemail3/ || :
 	echo After first sync
@@ -2941,7 +3343,7 @@ ll_delete() {
         --host2 $HOST2 --user2 tata \
         --passfile2 ../../var/pass/secret.tata \
         --folder INBOX.oneemail3 \
-        --delete
+        --delete1
 
 	echo 3333333333333333333333333
         $CMD_PERL ./imapsync \
@@ -2966,7 +3368,7 @@ ll_delete_delete2() {
         --passfile1 ../../var/pass/secret.titi \
         --host2 $HOST2 --user2 tata \
         --passfile2 ../../var/pass/secret.tata \
-        --delete --delete2
+        --delete1 --delete2
 }
 
 
@@ -3421,8 +3823,31 @@ gmail_via_stunnel_ks() {
                 --debug --justfolders
 }
 
-gmail_gmail() {
+easygmail_gmail1_gmail2() {
+                ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \
+		--gmail1 \
+                --user1 gilles.lamiral@gmail.com \
+                --passfile1 ../../var/pass/secret.gilles_gmail \
+                --gmail2 \
+                --user2 imapsync.gl@gmail.com \
+                --passfile2 ../../var/pass/secret.imapsync.gl_gmail \
+                --justfolders
+}
 
+easygmail_gmail2() {
+                $CMD_PERL ./imapsync \
+                --user1 gilles.lamiral@gmail.com \
+                --passfile1 ../../var/pass/secret.gilles_gmail \
+		--host1 imap.gmail.com --ssl1 \
+                --gmail2 \
+                --user2 imapsync.gl@gmail.com \
+                --passfile2 ../../var/pass/secret.imapsync.gl_gmail \
+                --justfolders
+}
+
+
+
+gmail_gmail() {
                 ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \
                 --host1 imap.gmail.com \
                 --ssl1 \
@@ -3598,7 +4023,7 @@ gmail_gmail_3_delete() {
                 --ssl2 \
                 --user2 gilles.lamiral@gmail.com \
                 --passfile2 ../../var/pass/secret.gilles_gmail \
-                --folder '[Gmail]/All Mail' --delete
+                --folder '[Gmail]/All Mail' --delete1
 		# '[Gmail]/All Mail' is not expunge by default!
 
 }
@@ -3633,21 +4058,42 @@ gmail_gmail_5_exclude_only_Gmail() {
 }
 
 gmail_gmail_6_search() {
+                ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \
+                --gmail1 \
+                --user1 gilles.lamiral@gmail.com \
+                --passfile1 ../../var/pass/secret.gilles_gmail \
+                --gmail2 \
+                --user2 imapsync.gl@gmail.com \
+                --passfile2 ../../var/pass/secret.imapsync.gl_gmail \
+                --folder INBOX --search 'X-GM-RAW "has:attachment"'
+}
 
+gmail_gmail_7_search() {
                 ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \
                 --host1 imap.gmail.com \
-                --ssl1 \
                 --user1 gilles.lamiral@gmail.com \
                 --passfile1 ../../var/pass/secret.gilles_gmail \
                 --host2 imap.gmail.com \
-                --ssl2 \
                 --user2 imapsync.gl@gmail.com \
                 --passfile2 ../../var/pass/secret.imapsync.gl_gmail \
-                --exclude "\[Gmail\]$" --folder INBOX --search 'X-GM-RAW "has:attachment"'
+                --folder "[Gmail]/All Mail" --search 'X-GM-RAW "Analysez lalala performances"' 
 }
 
-gmail_gl_gl2_sslargs() {
+gmail_gmail_8_search() {
+                ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \
+                --gmail1 \
+                --user1 gilles.lamiral@gmail.com \
+                --passfile1 ../../var/pass/secret.gilles_gmail \
+                --gmail2 \
+                --user2 imapsync.gl@gmail.com \
+                --passfile2 ../../var/pass/secret.imapsync.gl_gmail \
+                --search 'X-GM-RAW "label:Important label:Test"' 
+}
 
+
+
+
+gmail_gl_gl2_sslargs() {
                 ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \
                 --host1 imap.gmail.com \
                 --ssl1 \
@@ -3676,9 +4122,10 @@ yahoo_xxxx_login() {
 }
 
 yahoo_xxxx_login_tls() {
+		# tls1 no longer works on Yahoo
                 ! ping -c1 imap.mail.yahoo.com || $CMD_PERL ./imapsync \
                 --host1 imap.mail.yahoo.com \
-                --tls1 \
+                --tls1 --timeout1 5 \
                 --user1 glamiral \
                 --passfile1 ../../var/pass/secret.gilles_yahoo \
                 --host2 $HOST2 \
@@ -3699,12 +4146,14 @@ yahoo_xxxx() {
                 --passfile1 ../../var/pass/secret.gilles_yahoo \
                 --host2 $HOST2 \
                 --user2 titi \
-                --passfile2 ../../var/pass/secret.titi \
-		--sep1 '.'
-
+                --passfile2 ../../var/pass/secret.titi 
 }
 
-
+yahoo_all() {
+        ! yahoo_xxxx_login_tls || return 1
+	yahoo_xxxx_login       || return 1
+	yahoo_xxxx             || return 1
+}
 
 archiveopteryx_1() {
 	if can_send; then
@@ -3740,6 +4189,18 @@ ll_justlogin() {
 		--justlogin 
 }
 
+ll_justlogin_notls() {
+                $CMD_PERL  ./imapsync \
+                --host1 $HOST1 --user1 tata \
+                --passfile1 ../../var/pass/secret.tata \
+                --host2 $HOST2 --user2 titi \
+                --passfile2 ../../var/pass/secret.titi \
+		--justlogin --notls1 --notls2 
+}
+
+
+
+
 ll_justlogin_backslash_char() {
 # Look in the file ../../var/pass/secret.tptp to see 
 # strange \ character behavior
@@ -3775,8 +4236,6 @@ ll_justlogin_equal_char() {
 ll_usecache() {
         if can_send; then
                 sendtestmessage
-        else
-                :
         fi
 	
         $CMD_PERL  ./imapsync \
@@ -3788,13 +4247,7 @@ ll_usecache() {
          --folder INBOX 
 }
 
-ll_usecache_all() {
-        if can_send; then
-                sendtestmessage
-        else
-                :
-        fi
-	
+ll_usecache_all() {	
         $CMD_PERL  ./imapsync \
          --host1 $HOST1 --user1 tata \
          --passfile1 ../../var/pass/secret.tata \
@@ -3981,6 +4434,18 @@ l_office365()
         --folder INBOX --tmpdir /var/tmp --usecache --regextrans2 's/INBOX/tata/' --delete2 --expunge2
 }
 
+l_office365_deleted_flag()
+{
+        $CMD_PERL ./imapsync \
+        --host1 $HOST1 --user1 tata \
+        --passfile1 ../../var/pass/secret.tata \
+        --host2 imap-mail.outlook.com --ssl2 --user2 gilles.lamiral@outlook.com \
+        --passfile2 ../../var/pass/secret.outlook.com \
+        --folder INBOX.flags --tmpdir /var/tmp --usecache --regextrans2 's/INBOX/tata/'  --debugflags
+}
+
+
+
 l_office365_SSL_verify_mode()
 {
         $CMD_PERL ./imapsync \
@@ -3991,7 +4456,20 @@ l_office365_SSL_verify_mode()
         --justlogin --sslargs2 SSL_verify_mode=1
 }
 
-l_office365_justconnect_tls_SSL_verify_mode_1()
+office1_office2()
+{
+        $CMD_PERL ./imapsync \
+        --office1   \
+	--user1 gilles.lamiral@outlook.com \
+	--passfile1 ../../var/pass/secret.outlook.com \
+        --office2   \
+	--user2 gilles.lamiral@outlook.com \
+        --passfile2 ../../var/pass/secret.outlook.com \
+	--justfolders
+}
+
+
+office365_justconnect_tls_SSL_verify_mode_1()
 {
         $CMD_PERL ./imapsync \
         --host1 imap-mail.outlook.com  --ssl1 --user1 gilles.lamiral@outlook.com \
@@ -4002,7 +4480,7 @@ l_office365_justconnect_tls_SSL_verify_mode_1()
 }
 
 
-l_office365_justlogin()
+office365_justlogin_ssl1_ssl2()
 {
         $CMD_PERL ./imapsync \
         --host1 imap-mail.outlook.com --ssl1 --user1 gilles.lamiral@outlook.com \
@@ -4012,7 +4490,18 @@ l_office365_justlogin()
         --justlogin 
 }
 
-l_office365_justlogin_2()
+office365_justlogin_tls()
+{
+        $CMD_PERL ./imapsync \
+        --host1 imap-mail.outlook.com  --ssl1 --user1 gilles.lamiral@outlook.com \
+        --passfile1 ../../var/pass/secret.outlook.com \
+        --host2 imap.outlook.com       --tls2 --user2 gilles.lamiral@outlook.com \
+        --passfile2 ../../var/pass/secret.outlook.com \
+        --justlogin 
+}
+
+
+office365_justlogin_2()
 {
         $CMD_PERL ./imapsync \
         --host1 imap-mail.outlook.com  --ssl1 --user1 gilles.lamiral@outlook.com \
@@ -4022,48 +4511,65 @@ l_office365_justlogin_2()
         --justlogin 
 }
 
-
-
-l_office365_justconnect_inet4_inet6()
-{
-        # force ipv4
+office365_justconnect_stunnel() {
         $CMD_PERL ./imapsync \
-        --host1 imap-mail.outlook.com --ssl1 \
-        --host2 outlook.office365.com --ssl2 \
+        --host1 outlook.office365.com --ssl1 \
+        --host2 ks.lamiral.info --port2 144 \
+        --justconnect
+}
+
+office365_justconnect_inet4_inet6()
+{
+        echo force ipv4
+        $CMD_PERL ./imapsync \
+        --host1 imap-mail.outlook.com \
+        --host2 outlook.office365.com \
         --justconnect --inet4
 
-        # force ipv6
+		echo
+		echo force ipv6
         $CMD_PERL ./imapsync \
-        --host1 imap-mail.outlook.com --ssl1 \
-        --host2 outlook.office365.com --ssl2 \
+        --host1 imap-mail.outlook.com \
+        --host2 outlook.office365.com \
         --justconnect --inet6
 
+		echo
         # outlook.office365.com gives ipv6 2a01:111:f400:2fa2::2
-        # this one must fail
-        ! $CMD_PERL ./imapsync \
-        --host1 imap-mail.outlook.com  --ssl1 \
-        --host2  2a01:111:f400:2fa2::2 --ssl2 \
+        echo this one should fail but is does not
+        $CMD_PERL ./imapsync \
+        --host1 imap-mail.outlook.com  \
+        --host2  2603:1026:4:51::2  \
         --justconnect --inet4
 
-        # outlook.office365.com gives ipv4 40.96.19.210
-        # this one should fail but is does not
+		echo
+        # outlook.office365.com gives ipv4 40.101.42.82
+        echo this one should fail but is does not
         $CMD_PERL ./imapsync \
-        --host1 imap-mail.outlook.com  --ssl1 \
-        --host2 40.96.19.210 --ssl2 \
+        --host1 imap-mail.outlook.com \
+        --host2 40.101.42.82  \
         --justconnect --inet6
-}
 
-
-l_office365_justlogin_tls()
-{
+		echo
+        # outlook.office365.com gives ipv6 2603:1026:4:50::2
+        echo this one should succeed
         $CMD_PERL ./imapsync \
-        --host1 imap-mail.outlook.com  --ssl1 --user1 gilles.lamiral@outlook.com \
-        --passfile1 ../../var/pass/secret.outlook.com \
-        --host2 imap.outlook.com       --tls2 --user2 gilles.lamiral@outlook.com \
-        --passfile2 ../../var/pass/secret.outlook.com \
-        --justlogin 
+        --host1 2603:1026:4:51::2  \
+        --host2 imap-mail.outlook.com  \
+        --justconnect
 }
 
+inet4_inet6()
+{
+		echo
+        # outlook.office365.com gives ipv6 2603:1026:4:50::2
+        echo this one should succeed
+        ! $CMD_PERL ./imapsync \
+        --host1 2603:1026:4:50::2  \
+        --host2 imap-mail.outlook.com  \
+        --justconnect --ssl1
+}
+
+
 
 
 l_office365_bigfolders()
@@ -4113,10 +4619,33 @@ l_exchange_maxline()
 	--minmaxlinelength 10000 --maxlinelength 11000 --debugmaxlinelength 
 }
 
+fuzz_basic() {
+        zzuf -E '^' $CMD_PERL  ./imapsync 
+}
+
+fuzz_network() {
+        zzuf -E '^' -d -n $CMD_PERL  ./imapsync \
+         --host1 $HOST1 --user1 tata \
+         --passfile1 ../../var/pass/secret.tata \
+         --host2 $HOST2 --user2 titi \
+         --passfile2 ../../var/pass/secret.titi \
+	 --timeout 5 
+}
+
+# general tests end
+
 ##########################
 # specific tests
 ##########################
 
+
+free_ssl() {
+	$CMD_PERL ./imapsync \
+	--host1 imap.free.fr --user1 gilles.lamiral@free.fr --passfile1 ../../var/pass/secret.gilles_free \
+	--host2 imap.free.fr --user2 gilles.lamiral@free.fr --passfile2 ../../var/pass/secret.gilles_free \
+	--justlogin --ssl1 --ssl2  
+}
+
 mail2World() {
 	$CMD_PERL ./imapsync \
 	--host1 mail2.name-services.com  --user1 jessica@champlaindoor.com \
@@ -4533,7 +5062,7 @@ jong_1() {
 $CMD_PERL ./imapsync \
     --host1 mail.y-publicaties.nl --user1 gillesl --passfile1 ../../var/pass/secret.jong \
     --host2 $HOST2 --user2 titi --passfile2 ../../var/pass/secret.titi --sep1 /  --prefix1 '' \
-    --delete2 --expunge2 --expunge1 --expunge \
+    --delete2 --expunge2 --expunge1 \
     --foldersizes --folder Junk/2009 --useuid
 # --debugimap1 --dry
 }
@@ -4543,7 +5072,7 @@ $CMD_PERL ./imapsync \
     --host2 mail.y-publicaties.nl --user2 gillesl --passfile2 ../../var/pass/secret.jong \
     --host1 $HOST2 --user1 gilles@est.belle --passfile1 ../../var/pass/secret.gilles_mbox \
     --sep2 /  --prefix2 ''  \
-    --folder INBOX.Junk.2009 --delete2 --expunge2 --expunge1 --expunge --useuid
+    --folder INBOX.Junk.2009 --delete2 --expunge2 --expunge1 --useuid
 #--nofoldersizes 
 # --debugimap1 --dry
 }
@@ -4566,7 +5095,7 @@ jong_2_delete() {
 $CMD_PERL ./imapsync \
     --host1 mail.y-publicaties.nl --user1 gillesl --passfile1 ../../var/pass/secret.jong \
     --host2 $HOST2 --user2 titi --passfile2 ../../var/pass/secret.titi --sep1 /  --prefix1 '' \
-    --delete --folder INBOX
+    --delete1 --folder INBOX
 # --debugimap1 --dry
 }
 
@@ -4824,8 +5353,12 @@ mandatory_tests='
 no_args 
 option_version
 option_tests
+option_tests_in_var_tmp
+option_tests_in_var_tmp_sub
 option_tests_debug
-option_bad_delete2 
+option_bad_delete2
+passfile1_noexist
+passfile2_noexist
 passwords_masked 
 passwords_not_masked 
 first_sync_dry 
@@ -4841,11 +5374,13 @@ gmail
 gmail_gmail 
 gmail_gmail_INBOX 
 gmail_gmail_folderfirst
-yahoo_xxxx
-l_office365_justconnect_inet4_inet6
-l_office365_justconnect_tls_SSL_verify_mode_1
+yahoo_all
+free_ssl
+office365_justconnect_inet4_inet6
+office365_justconnect_tls_SSL_verify_mode_1
 ll_unknow_option 
-ll_ask_password 
+ll_ask_password
+ll_env_password
 ll_bug_folder_name_with_blank 
 ll_timeout 
 ll_folder
@@ -4897,7 +5432,11 @@ ll_flags
 ll_regex_flag 
 ll_regex_flag_bad
 ll_regex_flag_keep_only 
-ll_justconnect 
+ll_justconnect
+ll_justconnect_ipv6
+ll_justconnect_ipv6_nossl
+ks_justconnect_ipv6
+ks_justconnect_ipv6_nossl
 ll_justlogin 
 ll_justconnect_devel
 ll_ssl 
@@ -4907,7 +5446,6 @@ ll_tls_justconnect
 ll_tls_justlogin 
 ll_tls 
 ll_authmech_PLAIN 
-ll_authmech_XOAUTH_gmail
 ll_authmech_xoauth2_gmail
 ll_authmech_xoauth2_json_gmail
 ll_authmech_LOGIN 
@@ -4935,6 +5473,12 @@ ll_useuid
 ll_useuid_nousecache
 ll_noheader_force
 ll_noheader
+ll_domino1_domino2
+ll_domino2
+fuzz_basic
+fuzz_network
+testslive
+testslive6
 '
 
 other_tests='
@@ -4943,7 +5487,6 @@ msw
 msw2
 ll_bigmail 
 ll_justlogin_backslash_char
-option_tests_debug
 '
 
 l() {
diff --git a/tmp/firstline.txt b/tmp/firstline.txt
deleted file mode 100644
index d35e62f..0000000
--- a/tmp/firstline.txt
+++ /dev/null
@@ -1 +0,0 @@
-blabla
diff --git a/tmp/firstline2.txt b/tmp/firstline2.txt
deleted file mode 100644
index e69de29..0000000
diff --git a/tmp/firstline3.txt b/tmp/firstline3.txt
deleted file mode 100644
index 8b13789..0000000
--- a/tmp/firstline3.txt
+++ /dev/null
@@ -1 +0,0 @@
-