From ef64b638eb4771e56f2747d49dea0fe8936a856d Mon Sep 17 00:00:00 2001 From: Peter Date: Mon, 6 Jan 2020 18:43:21 +0100 Subject: [PATCH] Update imapsync to 1.977 (#3248) --- data/Dockerfiles/dovecot/imapsync | 2994 +++++++++++++++++++++-------- 1 file changed, 2242 insertions(+), 752 deletions(-) diff --git a/data/Dockerfiles/dovecot/imapsync b/data/Dockerfiles/dovecot/imapsync index a75795b0..4c941f44 100755 --- a/data/Dockerfiles/dovecot/imapsync +++ b/data/Dockerfiles/dovecot/imapsync @@ -1,6 +1,6 @@ #!/usr/bin/env perl -# $Id: imapsync,v 1.937 2019/05/01 22:14:00 gilles Exp gilles $ +# $Id: imapsync,v 1.977 2019/12/23 20:18:02 gilles Exp gilles $ # structure # pod documentation # use pragmas @@ -19,13 +19,13 @@ =head1 NAME -imapsync - Email IMAP tool for syncing, copying and migrating -email mailboxes between two imap servers, one way, +imapsync - Email IMAP tool for syncing, copying, migrating +and archiving email mailboxes between two imap servers, one way, and without duplicates. =head1 VERSION -This documentation refers to Imapsync $Revision: 1.937 $ +This documentation refers to Imapsync $Revision: 1.977 $ =head1 USAGE @@ -46,15 +46,21 @@ one another. Imapsync command is a tool allowing incremental and recursive imap transfers from one mailbox to another. +If you don't understand the previous sentence, it's normal, +it's pedantic computer oriented jargon. -By default all folders are transferred, recursively, meaning +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. +a given message if it already resides on the destination side. +Messages that are on the destination side but not on the +source side stay as they are (see the --delete2 +option to have a strict sync). +How imapsync knows a message is already on both sides? Same specific headers and the transfer is done only once. By default, the identification headers are "Message-Id:" and "Received:" lines @@ -63,29 +69,40 @@ but this choice can be changed with the --useheader option. All flags are preserved, unread messages will stay unread, read ones will stay read, deleted will stay deleted. -You can stop the transfer at any time and restart it later, +You can abort the transfer at any time and restart it later, imapsync works well with bad connections and interruptions, -by design. +by design. On a terminal hit Ctr-c twice within two seconds +in order to abort the program. Hit Ctr-c just once makes +imapsync reconnect to both imap servers. -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. - -You can also decide to remove empty folders once all of their -messages have been transferred. Add --delete1emptyfolders to -obtain this behavior. - -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. +A classical scenario is synchronizing a mailbox B from another mailbox A +where you just want to keep a strict copy of A in B. Strict meaning +all messages in A will be in B but no more. For this, option --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. +--delete2foldersonly and --delete2foldersbutnot to set up exceptions +on folders to destroy. INBOX will never be destroy, it's a mandatory +folder in IMAP. + +A different scenario is to delete the messages from the source mailbox +after a successful transfer, it can be a good feature when migrating +mailboxes since messages will be only on one side. The source account +will only have messages that are not on the destination yet, ie, +messages that arrived after a sync or that failed to be copied. + +In that case, use the --delete1 option. Option --delete1 implies also +option --expunge1 so all messages marked deleted on host1 will be really +deleted. In IMAP protocol deleting a message does not really delete it, +it marks it with the flag \Deleted, allowing an undelete. Expunging +a folder removes, definitively, all the messages marked as \Deleted +in this folder. + +You can also decide to remove empty folders once all of their messages +have been transferred. Add --delete1emptyfolders to obtain this +behavior. + Imapsync is not adequate for maintaining two active imap accounts in synchronization when the user plays independently on both sides. @@ -97,11 +114,11 @@ Michael R. Elkins) for a 2 ways synchronization. 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. +The standard options are the six values forming the credentials. +Three values on each side are needed in order to log in into the IMAP +servers. These six values are a host, a username, and a password, two times. -Conventions used: +Conventions used in the following descriptions of the options: str means string int means integer @@ -114,26 +131,28 @@ Conventions used: =head2 OPTIONS/credentials - --host1 str : Source or "from" imap server. Mandatory. + --host1 str : Source or "from" imap server. --port1 int : Port to connect on host1. - Optional since default port is 143 or 993 if --ssl1 - --user1 str : User to login on host1. Mandatory. + Optional since default ports are the + well known ports imap/143 or imaps/993. + --user1 str : User to login on host1. --password1 str : Password for the user1. - --host2 str : "destination" imap server. Mandatory. - --port2 int : Port to connect on host2. - Optional since default port is 143 or 993 if --ssl2 - --user2 str : User to login on host2. Mandatory. + --host2 str : "destination" imap server. + --port2 int : Port to connect on host2. Optional + --user2 str : User to login on host2. --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. + Useful to restart a complete run by just reading + the command line used in the log, + or to debug passwords. + It's not a secure practice at all. --passfile1 str : Password file for the user1. It must contain the - password on the first line. This option avoids to show + password on the first line. This option avoids showing the password on the command line like --password1 does. - --passfile2 str : Password file for the user2. Contains the password. + --passfile2 str : Password file for the user2. You can also pass the passwords in the environment variables IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 @@ -195,15 +214,16 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 --folderrec str : Sync this folder recursively. --folderrec str : and this one, etc. - --folderfirst str : Sync this folder first. --folderfirst "Work" + --folderfirst str : Sync this folder first. Ex. --folderfirst "INBOX" --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: with Sent SENT sent - on host1 only Sent will be synced to host2). + similar folder is synced (example: with folders + "Sent", "SENT" and "sent" + on host1 only "Sent" will be synced to host2). --skipemptyfolders : Empty host1 folders are not created on host2. @@ -228,12 +248,16 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 --regextrans2 options before all others. Add --debug to see what's really going on. - --subfolder1 str : Syncs the host1 folders hierarchy under str - to the root hierarchy of host2. + --subfolder1 str : Syncs the host1 folders hierarchy which is under folder + str to the root hierarchy of host2. It's the couterpart of a sync done by --subfolder2 - in the reverse order. Use --subfolder2 str - for a backup under str and --subfolder1 str - for the restore from str. + when doing it in the reverse order. + Backup/Restore scenario: + Use --subfolder2 str for a backup to the folder str + on host2. Then use --subfolder1 str for restoring + from the folder str, after inverting + host1/host2 user1/user2 values. + --subscribed : Transfers subscribed folders. --subscribe : Subscribe to the folders transferred on the @@ -242,21 +266,30 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 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 "". + 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. + does not have NAMESPACE capability. So 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. + + --sep1 str : Host1 separator. This option should not be used + most of the time. + Imapsync gets the separator from the server itself, + by using NAMESPACE, or it tries to guess it + from the folders listing (it counts + characters / . \\ \ in folder names and choose the + more frequent, or finally / if nothing is found. + --sep2 str : Host2 separator. See --sep1 --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 + Then, when happy, remove --dry for a run, then + remove --justfolders for the next ones. + Have in mind that --regextrans2 is applied after + the automatic prefix and separator inversion. + For examples see: https://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt =head2 OPTIONS/folders sizes @@ -289,6 +322,17 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 --logfile str : Change the default log filename (can be dirname/filename). --logdir str : Change the default log directory. Default is LOG_imapsync/ +The default logfile name is for example + + LOG_imapsync/2019_12_22_23_57_59_532_user1_user2.txt + +where: + + 2019_12_22_23_57_59_532 is nearly the date of the start + YYYY_MM_DD_HH_MM_SS_mmm + year_month_day_hour_minute_seconde_millisecond + +and user1 user2 are the --user1 --user2 values. =head2 OPTIONS/messages @@ -297,9 +341,25 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 --skipmess is applied before --regexmess --skipmess reg : or this one, etc. + --skipcrossduplicates : Avoid copying messages that are already copied + in another folder, good from Gmail to X when + X is not also Gmail. + Activated with --gmail1 unless --noskipcrossduplicates + + --debugcrossduplicates : Prints which messages (UIDs) are skipped with + --skipcrossduplicates (and in what other folders + they are). + --pipemess cmd : Apply this cmd command to each message content before the copy. --pipemess cmd : and this one, etc. + With several --pipemess, the output of each cmd + command (STDOUT) is given to the input (STDIN) + of the next command. + For example, + --pipemess cmd1 --pipemess cmd2 --pipemess cmd3 + is like a Unix pipe: + "cat message | cmd1 | cmd2 | cmd3" --disarmreadreceipts : Disarms read receipts (host2 Exchange issue) @@ -307,9 +367,29 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 Example: 's/\000/ /g' # to replace null by space. --regexmess reg : and this one, etc. +=head2 OPTIONS/labels + +Gmail present labels as folders in imap. Imapsync can accelerate the sync +by syncing X-GM-LABELS, it will avoid to transfer messages when they are +already on host2. + + + --synclabels : Syncs also Gmail labels when a message is copied to host2. + Activated by default with --gmail1 --gmail2 unless + --nosynclabels is added. + + --resynclabels : Resyncs Gmail labels when a message is already on host2. + Activated by default with --gmail1 --gmail2 unless + --noresynclabels is added. + +For Gmail syncs, see also: +https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt =head2 OPTIONS/flags + If you encounter flag problems see also: + https://imapsync.lamiral.info/FAQ.d/FAQ.Flags.txt + --regexflag reg : Apply the whole regex to each flags list. Example: 's/"Junk"//g' # to remove "Junk" flag. --regexflag reg : then this one, etc. @@ -328,19 +408,26 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 \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. + --noexpungeaftereach to speed up, expunging will then be + done only twice per folder, one at the beginning and + one at the end of a folder sync. + --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. + if option --delete1 is set (unless --noexpungeaftereach). + --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. + --delete2 implies --uidexpunge2 + --delete2duplicates : Delete messages in host2 that are duplicates. Works only without --useuid since duplicates are detected with an header part of each message. @@ -348,37 +435,44 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 --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$/" + and see what folders will be deleted. - --expunge2 : Expunge messages on host2 after messages transfer. - --uidexpunge2 : uidexpunge messages on the host2 account - that are not on the host1 account, requires --delete2 + --delete2foldersonly reg : Delete only folders matching the regex reg. + Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" + This option activates --delete2folders + + --delete2foldersbutnot reg : Do not delete folders matching the regex rex. + Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" + This option activates --delete2folders + + --noexpunge2 : Do not expunge messages on host2. + --nouidexpunge2 : Do not uidexpunge messages on the host2 account + that are not on the host1 account. =head2 OPTIONS/dates + If you encounter problems with dates, see also: + https://imapsync.lamiral.info/FAQ.d/FAQ.Dates.txt + --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). + a message arrived on a host (Unix mtime). --idatefromheader : Sets the internal dates on host2 same as the - "Date:" headers. - If you encounter problems with dates see also - https://imapsync.lamiral.info/FAQ.d/FAQ.Dates.txt + ones in "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. + --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): + You can do (+ zone are the messages selected): past|----maxage+++++++++++++++>now past|+++++++++++++++minage---->now past|----maxage+++++minage---->now (intersection) @@ -386,25 +480,26 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 --search str : Selects only messages returned by this IMAP SEARCH command. Applied on both sides. - For a complete of what can be search see + For a complete set of what can be search see https://imapsync.lamiral.info/FAQ.d/FAQ.Messages_Selection.txt --search1 str : Same as --search but for selecting host1 messages only. --search2 str : Same as --search but for selecting host2 messages only. - --search CRIT equals --search1 CRIT --search2 CRIT + So --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. + RFC 2822 says it must be no more than 1000 bytes but + real life servers and email clients do more. --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. + --usecache : Use cache to speed up next syncs. Not set by default. --nousecache : Do not use cache. Caveat: --useuid --nousecache creates duplicates on multiple runs. - --useuid : Use UIDs instead of headers as a criterium to recognize + --useuid : Use UIDs instead of headers as a criterion to recognize messages. Option --usecache is then implied unless --nousecache is used. @@ -412,8 +507,11 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 =head2 OPTIONS/miscellaneous --syncacls : Synchronizes acls (Access Control Lists). + Acls in IMAP are not standardized, be careful + since one acl code on one side may signify something + else on the other one. --nosyncacls : Does not synchronize acls. This is the default. - Acls in IMAP are not standardized, be careful. + --addheader : When a message has no headers to be identified, --addheader adds a "Message-Id" header, like "Message-Id: 12345@imapsync", where 12345 @@ -442,19 +540,17 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 =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 + --gmail1 : sets --host1 to Gmail and other options. See FAQ.Gmail.txt + --gmail2 : sets --host2 to Gmail and other options. See 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 + --office1 : sets --host1 to Office365 and other options. See FAQ.Exchange.txt + --office2 : sets --host2 to Office365 and other options. See FAQ.Exchange.txt + --exchange1 : sets options for Exchange. See FAQ.Exchange.txt + --exchange2 : sets options for Exchange. See FAQ.Exchange.txt + --domino1 : sets options for Domino. See FAQ.Domino.txt + --domino2 : sets options for Domino. See FAQ.Domino.txt =head2 OPTIONS/behavior @@ -471,16 +567,25 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 --abort : terminates a previous call still running. It uses the pidfile to know what process to abort. - --exitwhenover int : Stop syncing when total bytes transferred reached. + --exitwhenover int : Stop syncing and exits when int total bytes + transferred is 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). + --noreleasecheck : Do not check for any new imapsync release. + --releasecheck : Check for new imapsync release. + it's an http request to + http://imapsync.lamiral.info/prj/imapsync/VERSION + --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. + Obsolete since "imapsync --host1 imaphost" alone + implies --justconnect + --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. @@ -505,24 +610,26 @@ IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2 =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 +password since it is safer. With --password1 option, on Linux, +any user on your host can see the password by using the 'ps auxwwww' +command. Using a variable (like IMAPSYNC_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 detailed behavior is 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. +If the automatic ssl and the tls detections fail then imapsync will +not protect against sniffing activities on the network, especially +for passwords. If you want to force ssl or tls just use --ssl1 --ssl2 or --tls1 --tls2 @@ -532,9 +639,9 @@ 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. -Here is the list of the exit code values (an integer between 0 and 255), -the names reflects their meaning: +Otherwise, it exits with a non-zero status. That's classical Unix behavior. +Here is the list of the exit code values (an integer between 0 and 255). +The names reflect their meaning: =for comment egrep '^Readonly my.*\$EX' imapsync | egrep -o 'EX.*' | sed 's_^_ _' @@ -557,10 +664,11 @@ egrep '^Readonly my.*\$EX' imapsync | egrep -o 'EX.*' | sed 's_^_ _' EXIT_TESTS_FAILED => 254 ; # Like Test::More API + =head1 LICENSE AND COPYRIGHT Imapsync is free, open, public but not always gratis software -cover by the NOLIMIT Public License. +cover by the NOLIMIT Public License, now called NLPL. See the LICENSE file included in the distribution or just read this simple sentence as it IS the licence text: @@ -570,13 +678,14 @@ In case it is not long enough, I repeat: "No limits to do anything with this work and this license." -https://imapsync.lamiral.info/LICENSE +Look at https://imapsync.lamiral.info/LICENSE =head1 AUTHOR Gilles LAMIRAL -Feedback good or bad is very often welcome. +Good feedback is always welcome. +Bad feedback is very often welcome. Gilles LAMIRAL earns his living by writing, installing, configuring and teaching free, open and often gratis @@ -595,19 +704,6 @@ See https://imapsync.lamiral.info/S/imapservers.shtml =head1 HUGE MIGRATION -Pay special attention to options ---subscribed ---subscribe ---delete1 ---delete1emptyfolders ---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. @@ -643,14 +739,14 @@ https://imapsync.lamiral.info/examples/ =head1 INSTALL - Imapsync works under any Unix with perl. + Imapsync works under any Unix with Perl. Imapsync works under most Windows (2000, XP, Vista, Seven, Eight, Ten - and all Server releases 2000, 2003, 2008 and R2, 2012 and R2) + and all Server releases 2000, 2003, 2008 and R2, 2012 and R2, 2016) as a standalone binary software called imapsync.exe, usually launched from a batch file in order to avoid always typing - the options. - + the options. There is also a 64bit binary called imapsync_64bit.exe + Imapsync works under OS X as a standalone binary software called imapsync_bin_Darwin @@ -687,47 +783,50 @@ Feel free to hack imapsync as the NOLIMIT license permits it. See also https://imapsync.lamiral.info/S/external.shtml for a better up to date list. -Last updated and verified on Thu Apr 11, 2019. +Last updated and verified on Sun Dec 8, 2019. + + + imapsync: https://github.com/imapsync/imapsync (this is an imapsync copy, sometimes delayed, with --noreleasecheck by default since release 1.592, 2014/05/22) + imap_tools: https://web.archive.org/web/20161228145952/http://www.athensfbc.com/imap_tools/. The imap_tools code is now at https://github.com/andrewnimmo/rick-sanders-imap-tools + imaputils: https://github.com/mtsatsenko/imaputils (very old imap_tools fork) + Doveadm-Sync: https://wiki2.dovecot.org/Tools/Doveadm/Sync ( Dovecot sync tool ) + davmail: http://davmail.sourceforge.net/ + offlineimap: http://offlineimap.org/ + mbsync: http://isync.sourceforge.net/ + mailsync: http://mailsync.sourceforge.net/ + mailutil: https://www.washington.edu/imap/ part of the UW IMAP toolkit. (well, seems abandoned now) + imaprepl: https://bl0rg.net/software/ http://freecode.com/projects/imap-repl/ + imapcopy (Pascal): http://www.ardiehl.de/imapcopy/ + imapcopy (Java): https://code.google.com/archive/p/imapcopy/ + imapsize: http://www.broobles.com/imapsize/ + migrationtool: http://sourceforge.net/projects/migrationtool/ + imapmigrate: http://sourceforge.net/projects/cyrus-utils/ + larch: https://github.com/rgrove/larch (derived from wonko_imapsync, good at Gmail) + wonko_imapsync: http://wonko.com/article/554 (superseded by larch) + pop2imap: http://www.linux-france.org/prj/pop2imap/ (I wrote that too) + exchange-away: http://exchange-away.sourceforge.net/ + SyncBackPro: http://www.2brightsparks.com/syncback/sbpro.html + ImapSyncClient: https://github.com/ridaamirini/ImapSyncClient + MailStore: https://www.mailstore.com/en/products/mailstore-home/ + mnIMAPSync: https://github.com/manusa/mnIMAPSync + imap-upload: http://imap-upload.sourceforge.net/ (A tool for uploading a local mbox file to IMAP4 server) + imapbackup: https://github.com/rcarmo/imapbackup (A Python script for incremental backups of IMAP mailboxes) + BitRecover email-backup 99 USD, 299 USD https://www.bitrecover.com/email-backup/. + ImportExportTools: https://addons.thunderbird.net/en-us/thunderbird/addon/importexporttools/ ImportExportTools for Mozilla Thunderbird by Paolo Kaosmos. ImportExportTools does not do IMAP. + - imapsync : https://github.com/imapsync/imapsync - (this is an imapsync copy, sometimes delayed, - with --noreleasecheck by default since release 1.592, 2014/05/22) - imap_tools : https://web.archive.org/web/20161228145952/http://www.athensfbc.com/imap_tools/ - The imap_tools code is now at - https://github.com/andrewnimmo/rick-sanders-imap-tools - imaputils : https://github.com/mtsatsenko/imaputils (very old imap_tools fork) - Doveadm-Sync : https://wiki2.dovecot.org/Tools/Doveadm/Sync ( Dovecot sync tool ) - davmail : http://davmail.sourceforge.net/ - offlineimap : http://offlineimap.org/ - mbsync : http://isync.sourceforge.net/ - mailsync : http://mailsync.sourceforge.net/ - mailutil : http://www.washington.edu/imap/ part of the UW IMAP tookit. - imaprepl : https://bl0rg.net/software/ http://freecode.com/projects/imap-repl/ - imapcopy (Pascal): http://www.ardiehl.de/imapcopy/ - imapcopy (Java) : https://code.google.com/archive/p/imapcopy/ - imapsize : http://www.broobles.com/imapsize/ - migrationtool : http://sourceforge.net/projects/migrationtool/ - imapmigrate : http://sourceforge.net/projects/cyrus-utils/ - larch : https://github.com/rgrove/larch (derived from wonko_imapsync, good at Gmail) - wonko_imapsync : http://wonko.com/article/554 (superseded by larch) - pop2imap : http://www.linux-france.org/prj/pop2imap/ (I wrote that too) - exchange-away : http://exchange-away.sourceforge.net/ - SyncBackPro : http://www.2brightsparks.com/syncback/sbpro.html - ImapSyncClient : https://github.com/ridaamirini/ImapSyncClient - MailStore : https://www.mailstore.com/en/products/mailstore-home/ - mnIMAPSync : https://github.com/manusa/mnIMAPSync - imap-upload : http://imap-upload.sourceforge.net/ - (a tool for uploading a local mbox file to IMAP4 server) =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 an often broken low-bandwidth ISDN link. +I initially wrote imapsync in July 2001 because an enterprise, +called BaSystemes, paid me to install a new imap server +without losing huge old mailboxes located in a far +away remote imap server, accessible by an +often broken low-bandwidth ISDN link. I had to verify every mailbox was well transferred, all folders, all messages, -without wasting bandwidth or creating duplicates upon resyncs. The design was -made with the rsync command in mind. +without wasting bandwidth or creating duplicates upon resyncs. The imapsync +design was made with the beautiful rsync command in mind. 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 @@ -735,13 +834,15 @@ module tarball source (more precisely in the examples/ directory of the Mail-IMAPClient tarball). So many happened since then that I wonder -if it remains any lines of the original copy_folder.pl in imapsync source code. +if it remains any lines of the original +copy_folder.pl in imapsync source code. =cut # use pragmas +# use strict ; use warnings ; @@ -768,7 +869,7 @@ use IPC::Open3 'open3' ; use Mail::IMAPClient 3.30 ; use MIME::Base64 ; use Pod::Usage qw(pod2usage) ; -use POSIX qw(uname SIGALRM) ; +use POSIX qw(uname SIGALRM :sys_wait_h) ; use Sys::Hostname ; use Term::ReadKey ; use Test::More ; @@ -779,9 +880,13 @@ use Cwd ; use Readonly ; use Sys::MemInfo ; use Regexp::Common ; -use Text::ParseWords; +use Text::ParseWords ; # for quotewords() use File::Tail ; +use Encode ; +use Encode::IMAPUTF7 ; + + local $OUTPUT_AUTOFLUSH = 1 ; # constants @@ -812,15 +917,12 @@ Readonly my $EX_SOFTWARE => 70 ; #/* internal software error */ # Mine Readonly my $EXIT_CATCH_ALL => 1 ; # Any other error - Readonly my $EXIT_BY_SIGNAL => 6 ; # Should be 128+n where n is the sig_num Readonly my $EXIT_PID_FILE_ERROR => 8 ; - Readonly my $EXIT_CONNECTION_FAILURE => 10 ; Readonly my $EXIT_TLS_FAILURE => 12 ; Readonly my $EXIT_AUTHENTICATION_FAILURE => 16 ; Readonly my $EXIT_SUBFOLDER1_NO_EXISTS => 21 ; - Readonly my $EXIT_WITH_ERRORS => 111 ; Readonly my $EXIT_WITH_ERRORS_MAX => 112 ; @@ -828,9 +930,24 @@ Readonly my $EXIT_WITH_ERRORS_MAX => 112 ; Readonly my $EXIT_TESTS_FAILED => 254 ; # Like Test::More API +Readonly my %EXIT_TXT => ( + $EX_OK => 'EX_OK: successful termination', + $EX_USAGE => 'EX_USAGE: command line usage error', + $EX_NOINPUT => 'EX_NOINPUT: cannot open input', + $EX_UNAVAILABLE => 'EX_UNAVAILABLE: service unavailable', + $EX_SOFTWARE => 'EX_SOFTWARE: internal software error', - - + $EXIT_CATCH_ALL => 'EXIT_CATCH_ALL', + $EXIT_BY_SIGNAL => 'EXIT_BY_SIGNAL', + $EXIT_PID_FILE_ERROR => 'EXIT_PID_FILE_ERROR' , + $EXIT_CONNECTION_FAILURE => 'EXIT_CONNECTION_FAILURE', + $EXIT_TLS_FAILURE => 'EXIT_TLS_FAILURE', + $EXIT_AUTHENTICATION_FAILURE => 'EXIT_AUTHENTICATION_FAILURE', + $EXIT_SUBFOLDER1_NO_EXISTS => 'EXIT_SUBFOLDER1_NO_EXISTS', + $EXIT_WITH_ERRORS => 'EXIT_WITH_ERRORS', + $EXIT_WITH_ERRORS_MAX => 'EXIT_WITH_ERRORS_MAX', + $EXIT_TESTS_FAILED => 'EXIT_TESTS_FAILED', +) ; Readonly my $DEFAULT_LOGDIR => 'LOG_imapsync' ; @@ -875,8 +992,8 @@ Readonly my $NUMBER_42 => 42 ; Readonly my $NUMBER_100 => 100 ; Readonly my $NUMBER_200 => 200 ; Readonly my $NUMBER_300 => 300 ; -Readonly my $NUMBER_123456 => 123456 ; -Readonly my $NUMBER_654321 => 654321 ; +Readonly my $NUMBER_123456 => 123_456 ; +Readonly my $NUMBER_654321 => 654_321 ; Readonly my $NUMBER_20_000 => 20_000 ; @@ -903,6 +1020,7 @@ Readonly my $STR_use_releasecheck => q{Check if a new imapsync release is availa Readonly my $GMAIL_MAXSIZE => 35_651_584 ; +Readonly my $FORCE => 1 ; # if ( 'MSWin32' eq $OSNAME ) # if ( 'darwin' eq $OSNAME ) @@ -916,11 +1034,23 @@ Readonly my $GMAIL_MAXSIZE => 35_651_584 ; my( $sync, + $timestart_str, $debugimap, $debugimap1, $debugimap2, $debugcontent, $debugflags, $debuglist, $debugdev, $debugmaxlinelength, $debugcgi, $domain1, $domain2, + @include, @exclude, @folderrec, @folderfirst, @folderlast, + @h1_folders_all, %h1_folders_all, + @h2_folders_all, %h2_folders_all, + @h2_folders_from_1_wanted, %h2_folders_from_1_all, + %requested_folder, + $h1_folders_wanted_nb, $h1_folders_wanted_ct, + @h2_folders_not_in_1, + %h1_subscribed_folder, %h2_subscribed_folder, + %h2_folders_from_1_wanted, + %h2_folders_from_1_several, + $prefix1, $prefix2, @regexmess, @regexflag, @skipmess, @pipemess, $pipemesscheck, $flagscase, $filterflags, $syncflagsaftercopy, @@ -929,9 +1059,9 @@ my( $syncacls, $fastio1, $fastio2, $minsize, $maxage, $minage, - $search, $search1, $search2, - $skipheader, @useheader, - $skipsize, $allowsizemismatch, $foldersizes, $foldersizesatend, $buffersize, + $search, + $skipheader, @useheader, %useheader, + $skipsize, $allowsizemismatch, $buffersize, $authmd5, $authmd51, $authmd52, @@ -949,14 +1079,12 @@ my( $h1_bytes_processed, - $h1_nb_msg_start, $h1_bytes_start, - $h2_nb_msg_start, $h2_bytes_start, $h1_nb_msg_end, $h1_bytes_end, $h2_nb_msg_end, $h2_bytes_end, $timeout, $timestart_int, - $timebefore, + $uid1, $uid2, $authuser1, $authuser2, $proxyauth1, $proxyauth2, @@ -978,10 +1106,18 @@ my( $create_folder_old, $skipcrossduplicates, $debugcrossduplicates, $disarmreadreceipts, - $mixfolders, $skipemptyfolders, + $mixfolders, $fetch_hash_set, + $cgidir, + %month_abrev, + $SSL_VERIFY_POLICY, + $warn_release, ) ; +single_sync( ) ; + +sub single_sync +{ # main program # global variables initialization @@ -991,7 +1127,7 @@ my( $sync->{timestart} = time ; # Is a float because of use Time::HiRres -$sync->{rcs} = q{$Id: imapsync,v 1.937 2019/05/01 22:14:00 gilles Exp gilles $} ; +$sync->{rcs} = q{$Id: imapsync,v 1.977 2019/12/23 20:18:02 gilles Exp gilles $} ; $sync->{ memory_consumption_at_start } = memory_consumption( ) || 0 ; @@ -1007,17 +1143,21 @@ $sync->{loadavg} = join( q{ }, $loadavg[ 0 ] ) $sync->{ total_bytes_transferred } = 0 ; -$sync->{ total_bytes_skipped } = 0; -$sync->{ nb_msg_transferred } = 0; -$sync->{ nb_msg_skipped } = $nb_msg_skipped_dry_mode = 0; -$sync->{ h1_nb_msg_deleted } = $h2_nb_msg_deleted = 0; -$h1_nb_msg_duplicate = $h2_nb_msg_duplicate = 0; +$sync->{ total_bytes_skipped } = 0 ; +$sync->{ nb_msg_transferred } = 0 ; +$sync->{ nb_msg_skipped } = $nb_msg_skipped_dry_mode = 0 ; +$sync->{ h1_nb_msg_deleted } = 0 ; +$h2_nb_msg_deleted = 0 ; +$h1_nb_msg_duplicate = 0 ; +$h2_nb_msg_duplicate = 0 ; $sync->{ h1_nb_msg_noheader } = 0 ; $h2_nb_msg_noheader = 0 ; -$h1_nb_msg_start = $h1_bytes_start = 0 ; -$h2_nb_msg_start = $h2_bytes_start = 0 ; +$sync->{ h1_nb_msg_start } = 0 ; +$sync->{ h1_bytes_start } = 0 ; +$sync->{ h2_nb_msg_start } = 0 ; +$sync->{ h2_bytes_start } = 0 ; $sync->{ h1_nb_msg_processed } = $h1_bytes_processed = 0 ; $sync->{ h2_nb_msg_crossdup } = 0 ; @@ -1028,7 +1168,7 @@ $sync->{ h2_nb_msg_crossdup } = 0 ; $sync->{nb_errors} = 0; $max_msg_size_in_bytes = 0; -my %month_abrev = ( +%month_abrev = ( Jan => '00', Feb => '01', Mar => '02', @@ -1044,7 +1184,6 @@ my %month_abrev = ( ); -my $cgidir ; # Just create a CGI object if under cgi context only. # Needed for the get_options() call @@ -1052,7 +1191,7 @@ 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 ) ; -# Is it The first myprint? +# Is it the first myprint? docker_context( $sync ) ; cgibuildheader( $sync ) ; @@ -1078,6 +1217,7 @@ if ( $sync->{ version } ) { exit 0 ; } +#$sync->{debugenv} = 1 ; $sync->{debugenv} and printenv( $sync ) ; # if option --debugenv load_modules( ) ; @@ -1100,52 +1240,42 @@ $sync->{ tmpdir } ||= File::Spec->tmpdir( ) ; testsexit( $sync ) ; # init live varaiables -testslive( $sync ) if ( $sync->{testslive} ) ; -testslive6( $sync ) if ( $sync->{testslive6} ) ; +testslive_init( $sync ) if ( $sync->{testslive} ) ; +testslive6_init( $sync ) if ( $sync->{testslive6} ) ; # -$sync->{pidfile} = defined $sync->{pidfile} ? $sync->{pidfile} : $sync->{ tmpdir } . '/imapsync.pid' ; -$sync->{pidfilelocking} = defined $sync->{pidfilelocking} ? $sync->{pidfilelocking} : 0 ; +pidfile( $sync ) ; # old abort place -# Unix signals -@{ $sync->{ sigexit } } = ( defined( $sync->{ sigexit } ) ) ? @{ $sync->{ sigexit } } : ( 'QUIT', 'TERM' ) ; -@{ $sync->{ sigreconnect } } = ( defined( $sync->{ sigreconnect } ) ) ? @{ $sync->{ sigreconnect } } : ( 'INT' ) ; -@{ $sync->{ sigprint } } = ( defined( $sync->{ sigprint } ) ) ? @{ $sync->{ sigprint } } : ( 'HUP' ) ; -@{ $sync->{ sigignore } } = ( defined( $sync->{ sigignore } ) ) ? @{ $sync->{ sigignore } } : ( ) ; - -local %SIG = %SIG ; -sig_install( $sync, \&catch_exit, @{ $sync->{ sigexit } } ) ; -sig_install( $sync, \&catch_reconnect, @{ $sync->{ sigreconnect } } ) ; -sig_install( $sync, \&catch_print, @{ $sync->{ sigprint } } ) ; -# --sigignore can override sigexit, sigreconnect and sigprint (for the same signals only) -sig_install( $sync, \&catch_ignore, @{ $sync->{ sigignore } } ) ; - -sig_install_toggle_sleep( $sync ) ; - +install_signals( $sync ) ; $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 ; # log and output +binmode STDOUT, ":encoding(UTF-8)" ; + if ( $sync->{log} ) { setlogfile( $sync ) ; teelaunch( $sync ) ; # now $sync->{tee} is a filehandle to STDOUT and the logfile } + +#binmode STDERR, ":encoding(UTF-8)" ; # STDERR goes to the same place: LOG and STDOUT (if logging is on) +# Useful only for --debugssl $sync->{tee} and local *STDERR = *${$sync->{tee}}{IO} ; $timestart_int = int( $sync->{timestart} ) ; -$timebefore = $sync->{timestart} ; +$sync->{timebefore} = $sync->{timestart} ; -my $timestart_str = localtime( $sync->{timestart} ) ; +$timestart_str = localtime( $sync->{timestart} ) ; # The prints in the log starts here @@ -1161,7 +1291,7 @@ myprint( 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (eui $modulesversion = defined $modulesversion ? $modulesversion : 1 ; -my $warn_release = ( $sync->{releasecheck} ) ? check_last_release( ) : $STR_use_releasecheck ; +$warn_release = ( $sync->{releasecheck} ) ? check_last_release( ) : $STR_use_releasecheck ; $wholeheaderifneeded = defined $wholeheaderifneeded ? $wholeheaderifneeded : 1; @@ -1209,15 +1339,15 @@ remove_pidfile_not_running( $sync->{pidfile} ) ; # if another imapsync is running then tail -f its logfile and exit # useful in cgi context -if ( $sync->{tail} and tail( $sync ) ) +if ( $sync->{ tail } and tail( $sync ) ) { - myprint( "Tail -f finished. Now finishing myself\n" ) ; - exit_clean( $sync, $EX_OK ) ; + $sync->{nb_errors}++ ; + exit_clean( $sync, $EX_OK, "Tail -f finished. Now finishing myself processus $PROCESS_ID\n" ) ; exit $EX_OK ; } if ( ! write_pidfile( $sync ) ) { - myprint( "Exiting with return value $EXIT_PID_FILE_ERROR\n" ) ; + myprint( "Exiting with return value $EXIT_PID_FILE_ERROR ($EXIT_TXT{$EXIT_PID_FILE_ERROR}) $sync->{nb_errors}/$sync->{errorsmax} nb_errors/max_errors\n" ) ; exit $EXIT_PID_FILE_ERROR ; } @@ -1281,10 +1411,10 @@ sslcheck( $sync ) ; $split1 ||= $SPLIT ; $split2 ||= $SPLIT ; -$sync->{host1} || missing_option( $sync, '--host1' ) ; +#$sync->{host1} || missing_option( $sync, '--host1' ) ; $sync->{port1} ||= ( $sync->{ssl1} ) ? $IMAP_SSL_PORT : $IMAP_PORT ; -$sync->{host2} || missing_option( $sync, '--host2' ) ; +#$sync->{host2} || missing_option( $sync, '--host2' ) ; $sync->{port2} ||= ( $sync->{ssl2} ) ? $IMAP_SSL_PORT : $IMAP_PORT ; $debugimap1 = $debugimap2 = 1 if ( $debugimap ) ; @@ -1307,7 +1437,6 @@ if ( defined $delete2foldersbutnot or defined $delete2foldersonly ) { } -my $SSL_VERIFY_POLICY ; my %SSL_VERIFY_STR ; Readonly $SSL_VERIFY_POLICY => IO::Socket::SSL::SSL_VERIFY_NONE( ) ; @@ -1333,16 +1462,27 @@ if ( $sync->{ssl2} ) { myprint( 'Host2: Use --sslargs2 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER( ) . " to have $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER( )} of host2\n" ) ; } +# ID on by default since 1.832 +$sync->{id} = defined $sync->{id} ? $sync->{id} : 1 ; + +if ( $sync->{justconnect} + or not $sync->{user1} + or not $sync->{user2} + or not $sync->{host1} + or not $sync->{host2} + ) +{ + my $justconnect = justconnect( $sync ) ; -if ( $sync->{justconnect} ) { - justconnect( $sync ) ; myprint( debugmemory( $sync, " after justconnect() call" ) ) ; - exit_clean( $sync, $EX_OK ) ; + exit_clean( $sync, $EX_OK, + "Exiting after a justconnect on host(s): $justconnect\n" + ) ; } -$sync->{user1} || missing_option( $sync, '--user1' ) ; -$sync->{user2} || missing_option( $sync, '--user2' ) ; +#$sync->{user1} || missing_option( $sync, '--user1' ) ; +#$sync->{user2} || missing_option( $sync, '--user2' ) ; $syncinternaldates = defined $syncinternaldates ? $syncinternaldates : 1; @@ -1361,6 +1501,7 @@ if ( $sync->{ delete1 } ) { if ( $sync->{ uidexpunge2 } and not Mail::IMAPClient->can( 'uidexpunge' ) ) { myprint( "Failure: uidexpunge not supported (IMAPClient release < 3.17), use nothing or --expunge2 instead\n" ) ; + $sync->{nb_errors}++ ; exit_clean( $sync, $EX_SOFTWARE ) ; } @@ -1376,6 +1517,7 @@ if ( ( $sync->{ delete2 } or $sync->{ delete2duplicates } ) and not defined $sy if ( $sync->{ delete1 } and $sync->{ delete2 } ) { myprint( "Warning: using --delete1 and --delete2 together is almost always a bad idea, exiting imapsync\n" ) ; + $sync->{nb_errors}++ ; exit_clean( $sync, $EX_USAGE ) ; } @@ -1422,8 +1564,8 @@ if (defined $proxyauth2 && !$authuser2) { missing_option( $sync, 'With --proxyauth2, --authuser2' ) ; } -$authuser1 ||= $sync->{user1}; -$authuser2 ||= $sync->{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") ; @@ -1438,10 +1580,18 @@ myprint( "Host2: imap connection timeout is $sync->{h2}->{timeout} seconds\n" ) $syncacls = defined $syncacls ? $syncacls : 0 ; # No folders sizes if --justfolders, unless really wanted. -if ( $sync->{ justfolders } and not defined $foldersizes ) { $foldersizes = 0 ; } +if ( + $sync->{ justfolders } + and not defined $sync->{ foldersizes } + and not $sync->{ justfoldersizes } ) +{ + $sync->{ foldersizes } = 0 ; + $sync->{ foldersizesatend } = 1 ; +} + +$sync->{ foldersizes } = ( defined $sync->{ foldersizes } ) ? $sync->{ foldersizes } : 1 ; +$sync->{ foldersizesatend } = ( defined $sync->{ foldersizesatend } ) ? $sync->{ foldersizesatend } : $sync->{ foldersizes } ; -$foldersizes = ( defined $foldersizes ) ? $foldersizes : 1 ; -$foldersizesatend = ( defined $foldersizesatend ) ? $foldersizesatend : $foldersizes ; $fastio1 = defined $fastio1 ? $fastio1 : 0 ; $fastio2 = defined $fastio2 ? $fastio2 : 0 ; @@ -1455,8 +1605,6 @@ $uidnext_default = $DEFAULT_UIDNEXT ; if ( ! @useheader ) { @useheader = qw( Message-Id Received ) ; } -my %useheader ; - # Make a hash %useheader of each --useheader 'key' in uppercase for ( @useheader ) { $useheader{ uc $_ } = undef } ; @@ -1475,8 +1623,8 @@ if( $sync->{dry} ) { $sync->{dry_message} = "\t(not really since --dry mode)" ; } -$search1 ||= $search if ( $search ) ; -$search2 ||= $search if ( $search ) ; +$sync->{ search1 } ||= $search if ( $search ) ; +$sync->{ 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} ; @@ -1491,17 +1639,25 @@ if ( @pipemess and $pipemesscheck ) { my $string = pipemess( q{ }, @pipemess ) ; # string undef means something was bad. if ( not ( defined $string ) ) { - exit_clean( $sync, $EX_USAGE, "Error: one of --pipemess command is bad, check it\n" ) ; + $sync->{nb_errors}++ ; + exit_clean( $sync, $EX_USAGE, + "Error: one of --pipemess command is bad, check it\n" + ) ; } myprint( "Ok with each --pipemess @pipemess\n" ) ; } if ( $maxlinelengthcmd ) { - myprint( "Checking --maxlinelengthcmd command, $maxlinelengthcmd, with an space string.\n" ) ; + 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 ) ) { - exit_clean( $sync, $EX_USAGE, "Error: --maxlinelengthcmd command is bad, check it\n" ) ; + $sync->{nb_errors}++ ; + exit_clean( $sync, $EX_USAGE, + "Error: --maxlinelengthcmd command is bad, check it\n" + ) ; } myprint( "Ok with --maxlinelengthcmd $maxlinelengthcmd\n" ) ; } @@ -1511,7 +1667,10 @@ if ( @regexmess ) { myprint( "Checking each --regexmess command with an space string.\n" ) ; # string undef means one of the eval regex was bad. if ( not ( defined $string ) ) { - exit_clean( $sync, $EX_USAGE, 'Error: one of --regexmess option is bad, check it' ) ; + #errors_incr( $sync, 'Warning: one of --regexmess option may be bad, check them' ) ; + exit_clean( $sync, $EX_USAGE, + "Error: one of --regexmess option is bad, check it\n" + ) ; } myprint( "Ok with each --regexmess\n" ) ; } @@ -1521,7 +1680,10 @@ if ( @skipmess ) { my $match = skipmess( q{ } ) ; # match undef means one of the eval regex was bad. if ( not ( defined $match ) ) { - exit_clean( $sync, $EX_USAGE, 'Error: one of --skipmess option is bad, check it' ) ; + $sync->{nb_errors}++ ; + exit_clean( $sync, $EX_USAGE, + "Error: one of --skipmess option is bad, check it\n" + ) ; } myprint( "Ok with each --skipmess\n" ) ; } @@ -1531,7 +1693,10 @@ if ( @regexflag ) { my $string = flags_regex( q{ } ) ; # string undef means one of the eval regex was bad. if ( not ( defined $string ) ) { - exit_clean( $sync, $EX_USAGE, 'Error: one of --regexflag option is bad, check it' ) ; + $sync->{nb_errors}++ ; + exit_clean( $sync, $EX_USAGE, + "Error: one of --regexflag option is bad, check it\n" + ) ; } myprint( "Ok with each --regexflag\n" ) ; } @@ -1551,9 +1716,18 @@ $sync->{ debug } and myprint( 'Host1 Buffer I/O: ', $sync->{imap1}->Buffer(), "\ $sync->{ debug } and myprint( 'Host2 Buffer I/O: ', $sync->{imap2}->Buffer(), "\n" ) ; -if ( ! $sync->{imap1}->IsAuthenticated( ) ) { exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, 'Not authenticated on host1' ) ; } +if ( ! $sync->{imap1}->IsAuthenticated( ) ) +{ + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Not authenticated on host1\n" ) ; +} myprint( "Host1: state Authenticated\n" ) ; -if ( ! $sync->{imap2}->IsAuthenticated( ) ) { exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, 'Not authenticated on host2' ) ; } + +if ( ! $sync->{imap2}->IsAuthenticated( ) ) +{ + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Not authenticated on host2\n" ) ; +} myprint( "Host2: state Authenticated\n" ) ; myprint( 'Host1 capability once authenticated: ', join(q{ }, @{ $sync->{imap1}->capability() || [] }), "\n" ) ; @@ -1563,9 +1737,6 @@ myprint( 'Host1 capability once authenticated: ', join(q{ }, @{ $sync->{imap1}-> myprint( 'Host2 capability once authenticated: ', join(q{ }, @{ $sync->{imap2}->capability() || [] }), "\n" ) ; - -# ID on by default since 1.832 -$sync->{id} = defined $sync->{id} ? $sync->{id} : 1 ; imap_id_stuff( $sync ) ; #quota( $sync, $sync->{imap1}, 'h1' ) ; # quota on host1 is useless and pollute host2 output. @@ -1576,8 +1747,7 @@ maxsize_setting( $sync ) ; if ( $sync->{ justlogin } ) { $sync->{imap1}->logout( ) ; $sync->{imap2}->logout( ) ; - myprint( "Exiting because of --justlogin\n" ) ; - exit_clean( $sync, $EX_OK ) ; + exit_clean( $sync, $EX_OK, "Exiting because of --justlogin\n" ) ; } @@ -1585,17 +1755,8 @@ if ( $sync->{ justlogin } ) { # Folder stuff # -my ( - @h1_folders_all , %h1_folders_all , @h1_folders_wanted , %requested_folder , - %h1_subscribed_folder , %h2_subscribed_folder , - @h2_folders_all , %h2_folders_all , %h2_folders_all_UPPER , - @h2_folders_from_1_wanted , %h2_folders_from_1_wanted , - %h2_folders_from_1_several , - %h2_folders_from_1_all , -) ; - -my $h1_folders_wanted_nb = 0 ; -my $h1_folders_wanted_ct = 0 ; # counter of folders done. +$h1_folders_wanted_nb = 0 ; # counter of folders to be done. +$h1_folders_wanted_ct = 0 ; # counter of folders done. # All folders on host1 and host2 @@ -1605,17 +1766,20 @@ 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" ) ; -foreach my $f ( @h1_folders_all ) { - $h1_folders_all{ $f } = 1 +foreach my $f ( @h1_folders_all ) +{ + $h1_folders_all{ $f } = 1 } -foreach my $f ( @h2_folders_all ) { + +foreach my $f ( @h2_folders_all ) +{ $h2_folders_all{ $f } = 1 ; - $h2_folders_all_UPPER{ uc $f } = 1 ; + $sync->{h2_folders_all_UPPER}{ uc $f } = 1 ; } $sync->{h1_folders_all} = \%h1_folders_all ; $sync->{h2_folders_all} = \%h2_folders_all ; -$sync->{h2_folders_all_UPPER} = \%h2_folders_all_UPPER ; + private_folders_separators_and_prefixes( ) ; @@ -1677,6 +1841,8 @@ else # consider (optional) includes and excludes if ( scalar @include ) { foreach my $include ( @include ) { + # No, do not add /x after the regex, never. + # Users would kill you! 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" ) ; @@ -1686,6 +1852,8 @@ if ( scalar @include ) { if ( scalar @exclude ) { foreach my $exclude ( @exclude ) { my @requested_folder = sort keys %requested_folder ; + # No, do not add /x after the regex, never. + # Users would kill you! 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" ) ; @@ -1695,7 +1863,8 @@ if ( scalar @exclude ) { # sort before is not very powerful # it adds --folderfirst and --folderlast even if they don't exist on host1 -@h1_folders_wanted = sort_requested_folders( ) ; +#@h1_folders_wanted = sort_requested_folders( ) ; +$sync->{h1_folders_wanted} = [ sort_requested_folders( ) ] ; # Remove no selectable folders @@ -1703,7 +1872,7 @@ if ( scalar @exclude ) { if ( $sync->{ checkfoldersexist } ) { my @h1_folders_wanted_exist ; myprint( "Host1: Checking wanted folders exist. Use --nocheckfoldersexist to avoid this check (shared of public namespace targeted).\n" ) ; - foreach my $folder ( @h1_folders_wanted ) { + foreach my $folder ( @{ $sync->{h1_folders_wanted} } ) { ( $sync->{ 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" ) ; @@ -1712,7 +1881,7 @@ if ( $sync->{ checkfoldersexist } ) { push @h1_folders_wanted_exist, $folder ; } } - @h1_folders_wanted = @h1_folders_wanted_exist ; + @{ $sync->{h1_folders_wanted} } = @h1_folders_wanted_exist ; }else{ myprint( "Host1: Not checking that wanted folders exist. Remove --nocheckfoldersexist to get this check.\n" ) ; } @@ -1721,7 +1890,7 @@ if ( $sync->{ checkfoldersexist } ) { if ( $sync->{ checkselectable } ) { my @h1_folders_wanted_selectable ; myprint( "Host1: Checking wanted folders are selectable. Use --nocheckselectable to avoid this check.\n" ) ; - foreach my $folder ( @h1_folders_wanted ) { + foreach my $folder ( @{ $sync->{h1_folders_wanted} } ) { ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "Checking $folder is selectable on host1\n" ) ; # It does an imap command LIST "" $folder and then search for no \Noselect if ( ! $sync->{imap1}->selectable( $folder ) ) { @@ -1730,13 +1899,12 @@ if ( $sync->{ checkselectable } ) { push @h1_folders_wanted_selectable, $folder ; } } - @h1_folders_wanted = @h1_folders_wanted_selectable ; - ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( 'Host1: checking folders took ', timenext( ), " s\n" ) ; + @{ $sync->{h1_folders_wanted} } = @h1_folders_wanted_selectable ; + ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( 'Host1: checking folders took ', timenext( $sync ), " s\n" ) ; }else{ myprint( "Host1: Not checking that wanted folders are selectable. Remove --nocheckselectable to get this check.\n" ) ; } -$sync->{h1_folders_wanted} = \@h1_folders_wanted ; # Old place of private_folders_separators_and_prefixes( ) call. @@ -1750,7 +1918,7 @@ $sync->{h1_folders_wanted} = \@h1_folders_wanted ; automap( $sync ) ; -foreach my $h1_fold ( @h1_folders_wanted ) { +foreach my $h1_fold ( @{ $sync->{h1_folders_wanted} } ) { my $h2_fold ; $h2_fold = imap2_folder_name( $sync, $h1_fold ) ; $h2_folders_from_1_wanted{ $h2_fold }++ ; @@ -1758,12 +1926,21 @@ foreach my $h1_fold ( @h1_folders_wanted ) { $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( $sync, $h1_fold ) ; $h2_folders_from_1_all{ $h2_fold }++ ; + # Follows a fix to avoid deleting folder $sync->{ subfolder2 } + # because it usually does not exist on host1. + if ( $sync->{ subfolder2 } ) + { + $h2_folders_from_1_all{ $sync->{ h2_prefix } . $sync->{ subfolder2 } }++ ; + $h2_folders_from_1_all{ $sync->{ subfolder2 } }++ ; + } } @@ -1801,7 +1978,7 @@ if ( $subscribed ) { } -my @h2_folders_not_in_1; + @h2_folders_not_in_1 = list_folders_in_2_not_in_1( ) ; if ( @h2_folders_not_in_1 ) { @@ -1834,21 +2011,28 @@ if ( keys %{ $sync->{f1f2h} } ) { myprint( "\n" ) ; } -exit_clean( $sync, $EX_OK ) if ( $sync->{justfolderlists} ) ; -exit_clean( $sync, $EX_OK ) if ( $sync->{justautomap} ) ; +exit_clean( $sync, $EX_OK, "Exiting because of --justfolderlists\n" ) if ( $sync->{ justfolderlists } ) ; +exit_clean( $sync, $EX_OK, "Exiting because of --justautomap\n" ) if ( $sync->{ justautomap } ) ; debugsleep( $sync ) ; -if ( $foldersizes ) { - foldersizes_on_h1h2( $sync ) ; +if ( $sync->{ skipemptyfolders } ) +{ + myprint( "Host1: will not syncing empty folders on host1. Use --noskipemptyfolders to create them anyway on host2\n") ; +} + + +if ( $sync->{ foldersizes } ) { + + foldersizes_at_the_beggining( $sync ) ; + #foldersizes_at_the_beggining_old( $sync ) ; } if ( $sync->{ justfoldersizes } ) { - myprint( "Exiting because of --justfoldersizes\n" ) ; - exit_clean( $sync, $EX_OK ) ; + exit_clean( $sync, $EX_OK, "Exiting because of --justfoldersizes\n" ) ; } $sync->{stats} = 1 ; @@ -1860,7 +2044,7 @@ if ( $sync->{ delete1emptyfolders } ) { delete_folders_in_2_not_in_1( ) if $delete2folders ; # folder loop -$h1_folders_wanted_nb = scalar @h1_folders_wanted ; +$h1_folders_wanted_nb = scalar @{ $sync->{h1_folders_wanted} } ; myprint( "++++ Looping on each one of $h1_folders_wanted_nb folders to sync\n" ) ; @@ -1871,11 +2055,15 @@ my %uid_candidate_no_deletion ; $sync->{ h2_folders_of_md5 } = { } ; -FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { +FOLDER: foreach my $h1_fold ( @{ $sync->{h1_folders_wanted} } ) +{ + $sync->{ h1_current_folder } = $h1_fold ; + eta_print( $sync ) ; if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; } my $h2_fold = imap2_folder_name( $sync, $h1_fold ) ; + $sync->{ h2_current_folder } = $h2_fold ; $h1_folders_wanted_ct++ ; myprintf( "Folder %7s %-35s -> %-35s\n", "$h1_folders_wanted_ct/$h1_folders_wanted_nb", @@ -1890,16 +2078,19 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { my $h1_fold_nb_messages = count_from_select( $sync->{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 ) { + if ( $sync->{ skipemptyfolders } and 0 == $h1_fold_nb_messages ) { myprint( "Host1: skipping empty host1 folder [$h1_fold]\n" ) ; next FOLDER ; } # Code added from https://github.com/imapsync/imapsync/issues/95 # Thanks jh1995 - if ( $skipemptyfolders ) { + # Goal: do not create folder if --search or --max/minage return 0 message. + # even if there are messages by SELECT (no not real empty, empty for the user point of vue). + if ( $sync->{ skipemptyfolders } ) + { my $h1_msgs_all_hash_ref_tmp = { } ; - my @h1_msgs_tmp = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref_tmp, $search1, $h1_fold ) ; + my @h1_msgs_tmp = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref_tmp, $sync->{ search1 }, $h1_fold ) ; my $h1_fold_nb_messages_tmp = scalar( @h1_msgs_tmp ) ; if ( 0 == $h1_fold_nb_messages_tmp ) { myprint( "Host1: skipping empty host1 folder [$h1_fold] (0 message found by SEARCH)\n" ) ; @@ -1930,7 +2121,10 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { if ( $sync->{ expunge1 } ) { myprint( "Host1: Expunging $h1_fold $sync->{dry_message}\n" ) ; - if ( ! $sync->{dry} ) { $sync->{imap1}->expunge( ) } ; + if ( ! $sync->{dry} ) + { + $sync->{imap1}->expunge( ) ; + } } if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribeall ) @@ -1945,7 +2139,7 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; } my $h1_msgs_all_hash_ref = { } ; - my @h1_msgs = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref, $search1, $sync->{abletosearch1}, $h1_fold ); + my @h1_msgs = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref, $sync->{ search1 }, $sync->{abletosearch1}, $h1_fold ); if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; } @@ -1953,10 +2147,10 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { myprint( "Host1: folder [$h1_fold] considering $h1_msgs_nb messages\n" ) ; ( $sync->{ debug } or $debuglist ) and myprint( "Host1: folder [$h1_fold] considering $h1_msgs_nb messages, LIST gives: @h1_msgs\n" ) ; - $sync->{ debug } and myprint( "Host1: selecting messages of folder [$h1_fold] took ", timenext(), " s\n" ) ; + $sync->{ debug } and myprint( "Host1: selecting messages of folder [$h1_fold] took ", timenext( $sync ), " s\n" ) ; my $h2_msgs_all_hash_ref = { } ; - my @h2_msgs = select_msgs( $sync->{imap2}, $h2_msgs_all_hash_ref, $search2, $sync->{abletosearch2}, $h2_fold ) ; + my @h2_msgs = select_msgs( $sync->{imap2}, $h2_msgs_all_hash_ref, $sync->{ search2 }, $sync->{abletosearch2}, $h2_fold ) ; if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; } @@ -1964,10 +2158,11 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { myprint( "Host2: folder [$h2_fold] considering $h2_msgs_nb messages\n" ) ; ( $sync->{ debug } or $debuglist ) and myprint( "Host2: folder [$h2_fold] considering $h2_msgs_nb messages, LIST gives: @h2_msgs\n" ) ; - $sync->{ debug } and myprint( "Host2: selecting messages of folder [$h2_fold] took ", timenext(), " s\n" ) ; + $sync->{ debug } and myprint( "Host2: selecting messages of folder [$h2_fold] took ", timenext( $sync ), " s\n" ) ; my $cache_base = "$sync->{ tmpdir }/imapsync_cache/" ; - my $cache_dir = cache_folder( $cache_base, "$sync->{host1}/$sync->{user1}/$sync->{host2}/$sync->{user2}", $h1_fold, $h2_fold ) ; + 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 = $sync->{imap1}->uidvalidity( ) || q{} ; @@ -2022,7 +2217,7 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { my ($h1_heads_ref, $h1_fir_ref) = ({}, {}); $h1_heads_ref = $sync->{imap1}->parse_headers([@h1_msgs_not_in_cache], @useheader) if (@h1_msgs_not_in_cache); - $sync->{ debug } and myprint( "Host1: parsing headers of folder [$h1_fold] took ", timenext(), " s\n" ) ; + $sync->{ debug } and myprint( "Host1: parsing headers of folder [$h1_fold] took ", timenext( $sync ), " s\n" ) ; @{ $h1_fir_ref }{@h1_msgs} = ( undef ) ; @@ -2044,7 +2239,7 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { if ( @h1_msgs ) ; } - $sync->{ debug } and myprint( "Host1: getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n" ) ; + $sync->{ debug } and myprint( "Host1: getting flags idate and sizes of folder [$h1_fold] took ", timenext( $sync ), " s\n" ) ; if ( ! $h1_fir_ref ) { my $error = join( q{}, "Host1: folder $h1_fold : Could not fetch_hash ", @@ -2080,7 +2275,7 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { myprint( "Host1: folder [$h1_fold] selected $h1_msgs_nb messages, duplicates $h1_msgs_duplicate_nb\n" ) ; - $sync->{ debug } and myprint( 'Host1: whole time parsing headers took ', timenext(), " s\n" ) ; + $sync->{ debug } and myprint( 'Host1: whole time parsing headers took ', timenext( $sync ), " s\n" ) ; # Getting headers and metada can be so long that host2 might be disconnected here if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; } @@ -2089,7 +2284,7 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} ); $h2_heads_ref = $sync->{imap2}->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache); - $sync->{ debug } and myprint( "Host2: parsing headers of folder [$h2_fold] took ", timenext(), " s\n" ) ; + $sync->{ debug } and myprint( "Host2: parsing headers of folder [$h2_fold] took ", timenext( $sync ), " s\n" ) ; $sync->{ 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 @@ -2107,7 +2302,7 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { if ( @h2_msgs ) ; } - $sync->{ debug } and myprint( "Host2: getting flags idate and sizes of folder [$h2_fold] took ", timenext(), " s\n" ) ; + $sync->{ debug } and myprint( "Host2: getting flags idate and sizes of folder [$h2_fold] took ", timenext( $sync ), " s\n" ) ; my @h2_msgs_duplicate; foreach my $m (@h2_msgs_not_in_cache) { @@ -2137,7 +2332,7 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { myprint( "Host2: folder [$h2_fold] selected $h2_msgs_nb messages, duplicates $h2_msgs_duplicate_nb\n" ) ; - $sync->{ debug } and myprint( 'Host2 whole time parsing headers took ', timenext( ), " s\n" ) ; + $sync->{ debug } and myprint( 'Host2 whole time parsing headers took ', timenext( $sync ), " s\n" ) ; $sync->{ debug } and myprint( "++++ Verifying [$h1_fold] -> [$h2_fold]\n" ) ; # messages in host1 that are not in host2 @@ -2419,9 +2614,10 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) { myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n" ) ; if ( ! $sync->{dry} ) { $sync->{imap2}->expunge( ) } ; } - $sync->{ debug } and myprint( 'Time: ', timenext( ), " s\n" ) ; + $sync->{ debug } and myprint( 'Time: ', timenext( $sync ), " s\n" ) ; } +eta_print( $sync ) ; myprint( "++++ End looping on each folder\n" ) ; @@ -2429,10 +2625,10 @@ if ( $sync->{ delete1 } and $sync->{ delete1emptyfolders } ) { delete1emptyfolders( $sync ) ; } -( $sync->{ debug } or $sync->{debugfolders} ) and myprint( 'Time: ', timenext( ), " s\n" ) ; +( $sync->{ debug } or $sync->{debugfolders} ) and myprint( 'Time: ', timenext( $sync ), " s\n" ) ; -if ( $foldersizesatend ) { +if ( $sync->{ foldersizesatend } ) { myprint( << 'END_SIZE' ) ; Folders sizes after the synchronization. @@ -2450,10 +2646,20 @@ myprint( errorsdump( $sync->{nb_errors}, errors_log( $sync ) ) ) if ( $sync->{er 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 ) ; -# END of main program +if ( $sync->{nb_errors} ) +{ + exit_clean( $sync, $EXIT_WITH_ERRORS ) ; +} +else +{ + exit_clean( $sync, $EX_OK ) ; +} + +return ; +} + +# END of sub single_sync # subroutines @@ -2562,64 +2768,331 @@ sub output_reset_with return $mysync->{ output } ; } +sub pidfile +{ + my $mysync = shift ; + + $mysync->{ pidfilelocking } = defined $mysync->{ pidfilelocking } ? $mysync->{ pidfilelocking } : 0 ; + + my $host1 = $mysync->{ host1 } || q{} ; + my $user1 = $mysync->{ user1 } || q{} ; + my $host2 = $mysync->{ host2 } || q{} ; + my $user2 = $mysync->{ user2 } || q{} ; + + my $account1_filtered = filter_forbidden_characters( slash_to_underscore( $host1 . '_' . $user1 ) ) || q{} ; + my $account2_filtered = filter_forbidden_characters( slash_to_underscore( $host2 . '_' . $user2 ) ) || q{} ; + + my $pidfile_basename ; + + if ( $ENV{ 'NET_SERVER_SOFTWARE' } and ( $ENV{ 'NET_SERVER_SOFTWARE' } =~ /Net::Server::HTTP/ ) ) + { + # under local webserver + $pidfile_basename = 'imapsync' . '_' . $account1_filtered . '_' . $account2_filtered . '.pid' ; + } + else + { + $pidfile_basename = 'imapsync.pid' ; + } + + $mysync->{ pidfile } = defined $mysync->{ pidfile } ? $mysync-> { pidfile } : $mysync->{ tmpdir } . "/$pidfile_basename" ; + return ; +} + + +sub tests_kill_zero +{ + note( 'Entering tests_kill_zero()' ) ; + + + + SKIP: { + if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests tests_kill_zero avoided on Windows', 8 ) ; } + + + is( 1, kill( 'ZERO', $PROCESS_ID ), "kill ZERO : myself $PROCESS_ID => 1" ) ; + is( 2, kill( 'ZERO', $PROCESS_ID, $PROCESS_ID ), "kill ZERO : myself $PROCESS_ID $PROCESS_ID => 2" ) ; + + if ( (-e '/.dockerenv' ) or ( 0 == $EFFECTIVE_USER_ID) ) + { + is( 1, kill( 'ZERO', 1 ), "kill ZERO : pid 1 => 1 (docker context or root)" ) ; + is( 2, kill( 'ZERO', $PROCESS_ID, 1 ), "kill ZERO : myself + pid 1, $PROCESS_ID 1 => 2 (docker context or root)" ) ; + } + else + { + is( 0, kill( 'ZERO', 1 ), "kill ZERO : pid 1 => 0 (non root)" ) ; + is( 1, kill( 'ZERO', $PROCESS_ID, 1 ), "kill ZERO : myself + pid 1, $PROCESS_ID 1 => 1 (one is non root)" ) ; + + } + + + my $pid_1 = fork( ) ; + if ( $pid_1 ) + { + # parent + } + else + { + # child + sleep 3 ; + exit ; + } + + my $pid_2 ; + $pid_2 = fork( ) ; + if ( $pid_2 ) + { + # I am the parent + ok( defined( $pid_2 ), "kill_zero: initial fork ok. I am the parent $PROCESS_ID" ) ; + ok( $pid_2 , "kill_zero: initial fork ok, child pid is $pid_2" ) ; + is( 3, kill( 'ZERO', $PROCESS_ID, $pid_2, $pid_1 ), "kill ZERO : myself $PROCESS_ID and child $pid_2 and brother $pid_1 => 3" ) ; + + is( $pid_2, waitpid( $pid_2, 0 ), "kill_zero: child $pid_2 no more there => waitpid return $pid_2" ) ; + } + else + { + # I am the child + note( 'This one fails under Windows, kill ZERO returns 0 instead of 2' ) ; + is( 2, kill( 'ZERO', $PROCESS_ID, $pid_1 ), "kill ZERO : myself child $PROCESS_ID brother $pid_1 => 2" ) ; + myprint( "I am the child pid $PROCESS_ID, Exiting\n" ) ; + exit ; + } + wait( ) ; + + # End of SKIP block + } + + note( 'Leaving tests_kill_zero()' ) ; + return ; +} + + + + +sub tests_killpid_by_parent +{ + note( 'Entering tests_killpid_by_parent()' ) ; + + SKIP: { + if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests tests_killpid_by_parent avoided on Windows', 7 ) ; } + + is( undef, killpid( ), 'killpid: no args => undef' ) ; + note( "killpid: trying to kill myself pid $PROCESS_ID, hope I will not succeed" ) ; + is( undef, killpid( $PROCESS_ID ), 'killpid: myself => undef' ) ; + + local $SIG{'QUIT'} = sub { myprint "GOT SIG QUIT! I am PID $PROCESS_ID. Exiting\n" ; exit ; } ; + + my $pid ; + $pid = fork( ) ; + if ( $pid ) + { + # I am the parent + ok( defined( $pid ), "killpid: initial fork ok. I am the parent $PROCESS_ID" ) ; + ok( $pid , "killpid: initial fork ok, child pid is $pid" ) ; + + is( 2, kill( 'ZERO', $PROCESS_ID, $pid ), "kill ZERO : myself $PROCESS_ID and child $pid => 2" ) ; + is( 1, killpid( $pid ), "killpid: child $pid killed => 1" ) ; + is( -1, waitpid( $pid, 0 ), "killpid: child $pid no more there => waitpid return -1" ) ; + } + else + { + # I am the child + myprint( "I am the child pid $PROCESS_ID, sleeping 1 + 3 seconds then kill myself\n" ) ; + sleep 1 ; + myprint( "I am the child pid $PROCESS_ID, slept 1 second, should be killed by my parent now, PPID " . mygetppid( ) . "\n" ) ; + sleep 3 ; + # this test should not be run. If it happens => failure. + ok( 0 == 1, "killpid: child pid $PROCESS_ID not dead => failure" ) ; + myprint( "I am the child pid $PROCESS_ID, killing myself failure... Exiting\n" ) ; + exit ; + } + + # End of SKIP block + } + note( 'Leaving tests_killpid_by_parent()' ) ; + return ; +} + +sub tests_killpid_by_brother +{ + note( 'Entering tests_killpid_by_brother()' ) ; + + + SKIP: { + if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests tests_killpid_by_brother avoided on Windows', 2 ) ; } + + local $SIG{'QUIT'} = sub { myprint "GOT SIG QUIT! I am PID $PROCESS_ID. Exiting\n" ; exit ; } ; + + my $pid_parent = $PROCESS_ID ; + myprint( "I am the parent pid $pid_parent\n" ) ; + my $pid_1 = fork( ) ; + if ( $pid_1 ) + { + # parent + } + else + { + # child + #while ( 1 ) { } ; + sleep 2 ; + sleep 2 ; + # this test should not be run. If it happens => failure. + # Well under Windows this always fails, shit! + ok( 0 == 1 or ( 'MSWin32' eq $OSNAME ) , "killpid: child pid $PROCESS_ID killing by brother but not dead => failure" ) ; + myprint( "I am the child pid $PROCESS_ID, killing by brother failed... Exiting\n" ) ; + exit ; + } + + my $pid_2 ; + $pid_2 = fork( ) ; + if ( $pid_2 ) + { + # parent + } + else + { + # I am the child + myprint( "I am the child pid $PROCESS_ID, my brother has pid $pid_1\n" ) ; + is( 1, killpid( $pid_1 ), "killpid: brother $pid_1 killed => 1" ) ; + sleep 2 ; + exit ; + } + + #sleep 1 ; + is( $pid_1, waitpid( $pid_1, 0), "I am the parent $PROCESS_ID waitpid _1( $pid_1 )" ) ; + is( $pid_2, waitpid( $pid_2, 0 ), "I am the parent $PROCESS_ID waitpid _2( $pid_2 )" ) ; + + + # End of SKIP block + } + + note( 'Leaving tests_killpid_by_brother()' ) ; + return ; +} + + +sub killpid +{ + my $pidtokill = shift ; + + if ( ! $pidtokill ) { + myprint( "No process to abort.\n" ) ; + return ; + } + + if ( $PROCESS_ID == $pidtokill ) { + myprint( "I will not kill myself pid $PROCESS_ID via killpid. Sractch it!\n" ) ; + return ; + } + + + # First ask for suicide + if ( kill( 'ZERO', $pidtokill ) or ( 'MSWin32' eq $OSNAME ) ) { + myprint( "Sending signal QUIT to PID $pidtokill \n" ) ; + kill 'QUIT', $pidtokill ; + sleep 2 ; + waitpid( $pidtokill, WNOHANG) ; + }else{ + myprint( "Can not send signal kill ZERO to PID $pidtokill.\n" ) ; + return ; + } + + #while ( waitpid( $pidtokill, WNOHANG) > 0 ) { } ; + + # Then murder + if ( kill( 'ZERO', $pidtokill ) or ( 'MSWin32' eq $OSNAME ) ) { + myprint( "Sending signal KILL to PID $pidtokill \n" ) ; + kill 'KILL', $pidtokill ; + sleep 1 ; + waitpid( $pidtokill, WNOHANG) ; + }else{ + myprint( "Process PID $pidtokill ended.\n" ) ; + return 1; + } + # Well ... + if ( kill( 'ZERO', $pidtokill ) or ( 'xMSWin32' eq $OSNAME ) ) { + myprint( "Process PID $pidtokill seems still there. Can not do much.\n" ) ; + return ; + }else{ + myprint( "Process PID $pidtokill ended.\n" ) ; + return 1; + } + + return ; +} + +sub tests_abort +{ + note( 'Entering tests_abort()' ) ; + + is( undef, abort( ), 'abort: no args => undef' ) ; + note( 'Leaving tests_abort()' ) ; + return ; +} + + sub abort { - my $mysync = shift @ARG ; - if ( ! -r $mysync->{pidfile} ) { - myprint( "Can not read pidfile $mysync->{pidfile}. Exiting.\n" ) ; - exit $EX_OK ; - } - my $pidtokill = firstline( $mysync->{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 ; - }else{ - myprint( "Process PID $pidtokill ended. Exiting.\n" ) ; - exit $EX_OK ; - } - # well abort job done anyway + my $mysync = shift @ARG ; + + if ( not $mysync ) { return ; } + + if ( ! -r $mysync->{pidfile} ) { + myprint( "Can not read pidfile $mysync->{pidfile}. Exiting.\n" ) ; + exit $EX_OK ; + } + my $pidtokill = firstline( $mysync->{pidfile} ) ; + if ( ! $pidtokill ) { + myprint( "No process to abort. Exiting.\n" ) ; + exit $EX_OK ; + } + + killpid( $pidtokill ) ; + + # well, the abort job is done anyway, because even when not succeeded + # in aborting another run, this run has to end without doing any + # thing else exit $EX_OK ; } +sub under_docker_context +{ + my $mysync = shift ; + + if ( -e '/.dockerenv' ) + { + return 1 ; + } + else + { + return 0 ; + } + + return ; +} + sub docker_context { my $mysync = shift ; - -e '/.dockerenv' || return ; - myprint( "Docker context detected with /.dockerenv\n" ) ; + + #-e '/.dockerenv' || return ; + + if ( ! under_docker_context( $mysync ) ) + { + return ; + } + + $mysync->{ debug } and 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" ) ; + $mysync->{ debug } and myprint( "Changing current directory to /var/tmp/\n" ) ; chdir '/var/tmp/' ; return ; @@ -2630,7 +3103,7 @@ sub cgibegin my $mysync = shift ; if ( ! under_cgi_context( $mysync ) ) { return ; } require CGI ; - CGI->import( qw( -no_debug ) ) ; + CGI->import( qw( -no_debug -utf8 ) ) ; require CGI::Carp ; CGI::Carp->import( qw( fatalsToBrowser ) ) ; $mysync->{cgi} = CGI->new( ) ; @@ -2670,12 +3143,12 @@ sub tests_under_cgi_context sub under_cgi_context { my $mysync = shift ; - # Under cgi context - if ( $ENV{SERVER_SOFTWARE} ) { - return 1 ; - } - # Not in cgi context - return ; + # Under cgi context + if ( $ENV{SERVER_SOFTWARE} ) { + return 1 ; + } + # Not in cgi context + return ; } sub cgibuildheader @@ -2706,7 +3179,7 @@ sub cgibuildheader ) ; }else{ $httpheader = $mysync->{cgi}->header( - -type => 'text/plain', + -type => 'text/plain; charset=UTF-8', -status => '200 OK to sync IMAP boxes' . ". Load on " . hostname() . " is $mysync->{ loadavg }", -cookie => $cookie, ) ; @@ -2724,8 +3197,10 @@ sub cgiload if ( $mysync->{ abort } ) { return ; } # keep going to abort since some ressources will be free soon 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 ) ; + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EX_UNAVAILABLE, + "Server is on heavy load. Be back in $mysync->{ loaddelay } min. Load is $mysync->{ loadavg }\n" + ) ; } return ; } @@ -2831,7 +3306,7 @@ sub tests_umask return ; } -sub cgisetcontext +sub cgisetcontext { my $mysync = shift ; if ( ! under_cgi_context( $mysync ) ) { return ; } @@ -2851,7 +3326,8 @@ sub cgisetcontext # Set safe default values (I hope...) - $mysync->{pidfile} = 'imapsync.pid' ; + + #$mysync->{pidfile} = 'imapsync.pid' ; $mysync->{pidfilelocking} = 1 ; $mysync->{errorsmax} = $ERRORS_MAX_CGI ; $modulesversion = 0 ; @@ -2864,28 +3340,40 @@ sub cgisetcontext $mysync->{hashfile} = $CGI_HASHFILE ; my $hashsynclocal = hashsynclocal( $mysync ) || die "Can not get hashsynclocal. Exiting\n" ; - $cgidir = $CGI_TMPDIR_TOP . '/' . $hashsynclocal ; + if ( $ENV{ 'NET_SERVER_SOFTWARE' } and ( $ENV{ 'NET_SERVER_SOFTWARE' } =~ /Net::Server::HTTP/ ) ) + { + # under local webserver + $cgidir = q{.} ; + } + else + { + $cgidir = $CGI_TMPDIR_TOP . '/' . $hashsynclocal ; + } -d $cgidir or mkpath $cgidir or die "Can not create $cgidir: $OS_ERROR\n" ; + $mysync->{ tmpdir } = $cgidir ; + chdir $cgidir or die "Can not cd to $cgidir: $OS_ERROR\n" ; - $mysync->{ tmpdir } = $cgidir ; - cgioutputenvcontext( $mysync ) ; + cgioutputenvcontext( $mysync ) ; $mysync->{ debug } and output( $mysync, 'Current directory is ' . getcwd( ) . "\n" ) ; $mysync->{ debug } and output( $mysync, 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ; $mysync->{ debug } and output( $mysync, 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ; - $skipemptyfolders = defined $skipemptyfolders ? $skipemptyfolders : 1 ; + $mysync->{ skipemptyfolders } = defined $mysync->{ skipemptyfolders } ? $mysync->{ skipemptyfolders } : 1 ; # Out of memory with messages over 1 GB ? $mysync->{ maxsize } = defined $mysync->{ maxsize } ? $mysync->{ maxsize } : 1_000_000_000 ; # tail -f behaviour on by default $mysync->{ tail } = defined $mysync->{ tail } ? $mysync->{ tail } : 1 ; - + # not sure it's for good @useheader = qw( Message-Id ) ; - return ; + # addheader on by default + $mysync->{ addheader } = defined $mysync->{ addheader } ? $mysync->{ addheader } : 1 ; + + return ; } sub cgioutputenvcontext @@ -2902,9 +3390,6 @@ sub cgioutputenvcontext } - - - sub debugsleep { my $mysync = shift @ARG ; @@ -2915,7 +3400,440 @@ sub debugsleep return ; } -sub foldersizes_on_h1h2 +sub tests_foldersize +{ + note( 'Entering tests_foldersize()' ) ; + + is( undef, foldersize( ), 'foldersize: no args => undef' ) ; + + + #is_deeply( {}, {}, 'foldersize: a hash is a hash' ) ; + #is_deeply( [], [], 'foldersize: an array is an array' ) ; + note( 'Leaving tests_foldersize()' ) ; + return ; +} + + + +# Globals: +# $uidnext_default +# $fetch_hash_set +# +sub foldersize +{ + # size of one folder + my ( $mysync, $side, $imap, $search_cmd, $abletosearch, $folder ) = @ARG ; + + if ( ! all_defined( $mysync, $side, $imap, $folder ) ) + { + return ; + } + + # FTGate is RFC buggy with EXAMINE it does not act as SELECT + #if ( ! $imap->examine( $folder ) ) { + if ( ! $imap->select( $folder ) ) { + my $error = join q{}, + "$side Folder $folder: Could not select: ", + $imap->LastError, "\n" ; + errors_incr( $mysync, $error ) ; + return ; + } + + if ( $imap->IsUnconnected( ) ) + { + return ; + } + + my $hash_ref = { } ; + my @msgs = select_msgs( $imap, undef, $search_cmd, $abletosearch, $folder ) ; + my $nb_msgs = scalar @msgs ; + my $biggest_in_folder = 0 ; + @{ $hash_ref }{ @msgs } = ( undef ) if @msgs ; + + my $stot = 0 ; + + if ( $imap->IsUnconnected( ) ) + { + return ; + } + + 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\n" ; + errors_incr( $mysync, $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: $EVAL_ERROR\n" ; + errors_incr( $mysync, $error ) ; + return ; + } + } + for ( keys %{ $hash_ref } ) { + my $size = $hash_ref->{ $_ }->{ 'RFC822.SIZE' } ; + $stot += $size ; + $biggest_in_folder = max( $biggest_in_folder, $size ) ; + } + } + return( $stot, $nb_msgs, $biggest_in_folder ) ; + +} + + +# The old subroutine that performed just one side at a time. +# Still here for a while, until confident with sub foldersize_diff_compute() +sub foldersizes +{ + my ( $mysync, $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 ; + my $biggest_in_folder = 0 ; + + $ct_folders++ ; + myprintf( "$side folder %7s %-35s", "$ct_folders/$nb_folders", jux_utf8( $folder ) ) ; + if ( 'Host2' eq $side and not exists $mysync->{h2_folders_all_UPPER}{ uc $folder } ) { + myprint( " does not exist yet\n") ; + next ; + } + if ( 'Host1' eq $side and not exists $h1_folders_all{ $folder } ) { + myprint( " does not exist\n" ) ; + next ; + } + + last if $imap->IsUnconnected( ) ; + + ( $stot, $nb_msgs, $biggest_in_folder ) = foldersize( $mysync, $side, $imap, $search_cmd, $abletosearch, $folder ) ; + + 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 on sizing: %11.1f seconds\n", $side, timenext( $mysync ) ) ; + return( $total_nb, $total_size ) ; +} + + +sub foldersize_diff_present +{ + my $mysync = shift ; + my $folder1 = shift ; + my $folder2 = shift ; + my $counter_str = shift ; + my $force = shift ; + + my $values1_str ; + my $values2_str ; + + if ( ! defined $mysync->{ folder1 }->{ $folder1 }->{ size } || $force ) + { + foldersize_diff_compute( $mysync, $folder1, $folder2, $force ) ; + } + + # again, but this time it means no availaible data. + if ( defined $mysync->{ folder1 }->{ $folder1 }->{ size } ) + { + $values1_str = sprintf( "Size: %9s Messages: %5s Biggest: %9s\n", + $mysync->{ folder1 }->{ $folder1 }->{ size }, + $mysync->{ folder1 }->{ $folder1 }->{ nb_msgs }, + $mysync->{ folder1 }->{ $folder1 }->{ biggest }, + ) ; + } + else + { + $values1_str = " does not exist\n" ; + } + + if ( defined $mysync->{ folder2 }->{ $folder2 }->{ size } ) + { + $values2_str = sprintf( "Size: %9s Messages: %5s Biggest: %9s\n", + $mysync->{ folder2 }->{ $folder2 }->{ size }, + $mysync->{ folder2 }->{ $folder2 }->{ nb_msgs }, + $mysync->{ folder2 }->{ $folder2 }->{ biggest }, + ) ; + } + else + { + $values2_str = " does not exist yet\n" ; + } + + myprintf( "Host1 folder %7s %-35s %s", + "$counter_str", + jux_utf8( $folder1 ), + $values1_str + ) ; + + myprintf( "Host2 folder %7s %-35s %s", + "$counter_str", + jux_utf8( $folder2 ), + $values2_str + ) ; + + myprintf( "Host2-Host1 %7s %-35s %9s %5s %9s\n\n", + "", + "", + $mysync->{ folder1 }->{ $folder1 }->{ size_diff }, + $mysync->{ folder1 }->{ $folder1 }->{ nb_msgs_diff }, + $mysync->{ folder1 }->{ $folder1 }->{ biggest_diff }, + + ) ; + + + + + return ; +} + +sub foldersize_diff_compute +{ + my $mysync = shift ; + my $folder1 = shift ; + my $folder2 = shift ; + my $force = shift ; + + + + my ( $size_1, $nb_msgs_1, $biggest_1 ) ; + # memoization + if ( + exists $h1_folders_all{ $folder1 } + && + ( + ! defined $mysync->{ folder1 }->{ $folder1 }->{ size } + || $force + ) + ) + { + #myprint( "foldersize folder1 $h1_folders_all{ $folder1 }\n" ) ; + ( $size_1, $nb_msgs_1, $biggest_1 ) = + foldersize( $mysync, + 'Host1', + $mysync->{ imap1 }, + $mysync->{ search1 }, + $mysync->{ abletosearch1 }, + $folder1 + ) ; + $mysync->{ folder1 }->{ $folder1 }->{ size } = $size_1 ; + $mysync->{ folder1 }->{ $folder1 }->{ nb_msgs } = $nb_msgs_1 ; + $mysync->{ folder1 }->{ $folder1 }->{ biggest } = $biggest_1 ; + } + else + { + $size_1 = $mysync->{ folder1 }->{ $folder1 }->{ size } ; + $nb_msgs_1 = $mysync->{ folder1 }->{ $folder1 }->{ nb_msgs } ; + $biggest_1 = $mysync->{ folder1 }->{ $folder1 }->{ biggest } ; + + } + + + my ( $size_2, $nb_msgs_2, $biggest_2 ) ; + if ( + exists $mysync->{ h2_folders_all_UPPER }{ uc $folder2 } + && + ( + ! defined $mysync->{ folder2 }->{ $folder2 }->{ size } + || $force + ) + ) + { + #myprint( "foldersize folder2\n" ) ; + ( $size_2, $nb_msgs_2, $biggest_2 ) = + foldersize( $mysync, + 'Host2', + $mysync->{ imap2 }, + $mysync->{ search2 }, + $mysync->{ abletosearch2 }, + $folder2 + ) ; + + $mysync->{ folder2 }->{ $folder2 }->{ size } = $size_2 ; + $mysync->{ folder2 }->{ $folder2 }->{ nb_msgs } = $nb_msgs_2 ; + $mysync->{ folder2 }->{ $folder2 }->{ biggest } = $biggest_2 ; + } + else + { + $size_2 = $mysync->{ folder2 }->{ $folder2 }->{ size } ; + $nb_msgs_2 = $mysync->{ folder2 }->{ $folder2 }->{ nb_msgs } ; + $biggest_2 = $mysync->{ folder2 }->{ $folder2 }->{ biggest } ; + + } + + + my $size_diff = diff( $size_2, $size_1 ) ; + my $nb_msgs_diff = diff( $nb_msgs_2, $nb_msgs_1 ) ; + my $biggest_diff = diff( $biggest_2, $biggest_1 ) ; + + $mysync->{ folder1 }->{ $folder1 }->{ size_diff } = $size_diff ; + $mysync->{ folder1 }->{ $folder1 }->{ nb_msgs_diff } = $nb_msgs_diff ; + $mysync->{ folder1 }->{ $folder1 }->{ biggest_diff } = $biggest_diff ; + + # It's redundant but easier to access later + $mysync->{ folder2 }->{ $folder2 }->{ size_diff } = $size_diff ; + $mysync->{ folder2 }->{ $folder2 }->{ nb_msgs_diff } = $nb_msgs_diff ; + $mysync->{ folder2 }->{ $folder2 }->{ biggest_diff } = $biggest_diff ; + + return ; +} + +sub diff +{ + my $x = shift ; + my $y = shift ; + + $x ||= 0 ; + $y ||= 0 ; + + return $x - $y ; +} + +sub add +{ + my $x = shift ; + my $y = shift ; + + $x ||= 0 ; + $y ||= 0 ; + + return $x + $y ; +} + + +sub foldersizes_diff_list +{ + my $mysync = shift ; + my $force = shift ; + + my @folders = @{ $mysync->{h1_folders_wanted} } ; + my $nb_folders = scalar @folders ; + my $ct_folders = 0 ; # folder counter. + + foreach my $folder1 ( @folders ) + { + $ct_folders++ ; + my $counter_str = "$ct_folders/$nb_folders" ; + my $folder2 = imap2_folder_name( $mysync, $folder1 ) ; + foldersize_diff_present( $mysync, $folder1, $folder2, $counter_str, $force ) ; + } + + return ; +} + +sub foldersizes_total +{ + my $mysync = shift ; + + my @folders_1 = @{ $mysync->{h1_folders_wanted} } ; + my @folders_2 = @h2_folders_from_1_wanted ; + + my $nb_folders_1 = scalar( @folders_1 ) ; + my $nb_folders_2 = scalar( @folders_2 ) ; + + my ( $total_size_1, $total_nb_1, $biggest_in_all_1 ) = ( 0, 0, 0 ) ; + my ( $total_size_2, $total_nb_2, $biggest_in_all_2 ) = ( 0, 0, 0 ) ; + + foreach my $folder1 ( @folders_1 ) + { + $total_size_1 = add( $total_size_1, $mysync->{ folder1 }->{ $folder1 }->{ size } ) ; + $total_nb_1 = add( $total_nb_1, $mysync->{ folder1 }->{ $folder1 }->{ nb_msgs } ) ; + $biggest_in_all_1 = max( $biggest_in_all_1 , $mysync->{ folder1 }->{ $folder1 }->{ biggest } ) ; + } + + foreach my $folder2 ( @folders_2 ) + { + $total_size_2 = add( $total_size_2, $mysync->{ folder2 }->{ $folder2 }->{ size } ) ; + $total_nb_2 = add( $total_nb_2, $mysync->{ folder2 }->{ $folder2 }->{ nb_msgs } ) ; + $biggest_in_all_2 = max( $biggest_in_all_2 , $mysync->{ folder2 }->{ $folder2 }->{ biggest } ) ; + + } + + myprintf( "Host1 Nb folders: %11s folders\n", $nb_folders_1 ) ; + myprintf( "Host2 Nb folders: %11s folders\n", $nb_folders_2 ) ; + myprint( "\n" ) ; + myprintf( "Host1 Nb messages: %11s messages\n", $total_nb_1 ) ; + myprintf( "Host2 Nb messages: %11s messages\n", $total_nb_2 ) ; + myprint( "\n" ) ; + myprintf( "Host1 Total size: %11s bytes (%s)\n", $total_size_1, bytes_display_string( $total_size_1 ) ) ; + myprintf( "Host2 Total size: %11s bytes (%s)\n", $total_size_2, bytes_display_string( $total_size_2 ) ) ; + myprint( "\n" ) ; + myprintf( "Host1 Biggest message: %11s bytes (%s)\n", $biggest_in_all_1, bytes_display_string( $biggest_in_all_1 ) ) ; + myprintf( "Host2 Biggest message: %11s bytes (%s)\n", $biggest_in_all_2, bytes_display_string( $biggest_in_all_2 ) ) ; + myprint( "\n" ) ; + myprintf( "Time spent on sizing: %11.1f seconds\n", timenext( $mysync ) ) ; + + my @total_1_2 = ( $total_nb_1, $total_size_1, $total_nb_2, $total_size_2 ) ; + return @total_1_2 ; +} + +sub foldersizesatend_old +{ + my $mysync = shift ; + timenext( $mysync ) ; + return if ( $mysync->{imap1}->IsUnconnected( ) ) ; + return if ( $mysync->{imap2}->IsUnconnected( ) ) ; + # Get all folders on host2 again since new were created + @h2_folders_all = sort $mysync->{imap2}->folders(); + for ( @h2_folders_all ) { + $h2_folders_all{ $_ } = 1 ; + $mysync->{h2_folders_all_UPPER}{ uc $_ } = 1 ; + } ; + ( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( $mysync, 'Host1', $mysync->{imap1}, $mysync->{ search1 }, $mysync->{abletosearch1}, @{ $mysync->{h1_folders_wanted} } ) ; + ( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( $mysync, 'Host2', $mysync->{imap2}, $mysync->{ search2 }, $mysync->{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( $mysync, $error ) ; + } + return ; +} + +sub foldersizesatend +{ + my $mysync = shift ; + timenext( $mysync ) ; + return if ( $mysync->{imap1}->IsUnconnected( ) ) ; + return if ( $mysync->{imap2}->IsUnconnected( ) ) ; + # Get all folders on host2 again since new were created + @h2_folders_all = sort $mysync->{imap2}->folders(); + for ( @h2_folders_all ) { + $h2_folders_all{ $_ } = 1 ; + $mysync->{h2_folders_all_UPPER}{ uc $_ } = 1 ; + } ; + + + foldersizes_diff_list( $mysync, $FORCE ) ; + + ( $h1_nb_msg_end, $h1_bytes_end, $h2_nb_msg_end, $h2_bytes_end ) + = foldersizes_total( $mysync ) ; + + + 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( $mysync, $error ) ; + } + return ; +} + + +sub foldersizes_at_the_beggining { my $mysync = shift ; @@ -2926,21 +3844,73 @@ You can remove foldersizes listings by using "--nofoldersizes" and "--nofoldersi but then you will also lose the ETA (Estimation Time of Arrival) given after each message copy. END_SIZE - ( $h1_nb_msg_start, $h1_bytes_start ) = foldersizes( 'Host1', $mysync->{imap1}, $search1, $mysync->{abletosearch1}, @h1_folders_wanted ) ; - ( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( 'Host2', $mysync->{imap2}, $search2, $mysync->{abletosearch2}, @h2_folders_from_1_wanted ) ; + foldersizes_diff_list( $mysync ) ; - if ( not all_defined( $h1_nb_msg_start, $h1_bytes_start, $h2_nb_msg_start, $h2_bytes_start ) ) { + ( $mysync->{ h1_nb_msg_start }, $mysync->{ h1_bytes_start }, + $mysync->{ h2_nb_msg_start }, $mysync->{ h2_bytes_start } ) + = foldersizes_total( $mysync ) ; + + + if ( not all_defined( + $mysync->{ h1_nb_msg_start }, + $mysync->{ h1_bytes_start }, + $mysync->{ h2_nb_msg_start }, + $mysync->{ h2_bytes_start } ) ) + { my $error = "Failure getting foldersizes, ETA and final diff will not be displayed\n" ; errors_incr( $mysync, $error ) ; - $foldersizes = 0 ; - $foldersizesatend = 0 ; + $mysync->{ foldersizes } = 0 ; + $mysync->{ foldersizesatend } = 0 ; return ; } my $h2_bytes_limit = $mysync->{h2}->{quota_limit_bytes} || 0 ; - if ( $h2_bytes_limit and ( $h2_bytes_limit < $h1_bytes_start ) ) { - 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" ; + if ( $h2_bytes_limit and ( $h2_bytes_limit < $mysync->{ h1_bytes_start } ) ) + { + my $quota_percent = mysprintf( '%.0f', $NUMBER_100 * $mysync->{ h1_bytes_start } / $h2_bytes_limit ) ; + my $error = "Host2: Quota limit will be exceeded! Over $quota_percent % ( $mysync->{ h1_bytes_start } bytes / $h2_bytes_limit bytes )\n" ; + errors_incr( $mysync, $error ) ; + } + return ; +} + + +# Globals: +# @h2_folders_from_1_wanted + +sub foldersizes_at_the_beggining_old +{ + my $mysync = shift ; + + myprint( << 'END_SIZE' ) ; + +Folders sizes before the synchronization. +You can remove foldersizes listings by using "--nofoldersizes" and "--nofoldersizesatend" +but then you will also lose the ETA (Estimation Time of Arrival) given after each message copy. +END_SIZE + + ( $mysync->{ h1_nb_msg_start }, $mysync->{ h1_bytes_start } ) = + foldersizes( $mysync, 'Host1', $mysync->{imap1}, $mysync->{ search1 }, + $mysync->{abletosearch1}, @{ $mysync->{h1_folders_wanted} } ) ; + ( $mysync->{ h2_nb_msg_start }, $mysync->{ h2_bytes_start } ) = + foldersizes( $mysync, 'Host2', $mysync->{imap2}, $mysync->{ search2 }, + $mysync->{abletosearch2}, @h2_folders_from_1_wanted ) ; + + if ( not all_defined( $mysync->{ h1_nb_msg_start }, + $mysync->{ h1_bytes_start }, $mysync->{ h2_nb_msg_start }, $mysync->{ h2_bytes_start } ) ) + { + my $error = "Failure getting foldersizes, ETA and final diff will not be displayed\n" ; + errors_incr( $mysync, $error ) ; + $mysync->{ foldersizes } = 0 ; + $mysync->{ foldersizesatend } = 0 ; + return ; + } + + my $h2_bytes_limit = $mysync->{h2}->{quota_limit_bytes} || 0 ; + if ( $h2_bytes_limit and ( $h2_bytes_limit < $mysync->{ h1_bytes_start } ) ) + { + my $quota_percent = mysprintf( '%.0f', $NUMBER_100 * $mysync->{ h1_bytes_start } / $h2_bytes_limit ) ; + my $error = "Host2: Quota limit will be exceeded! Over $quota_percent % ( $mysync->{ h1_bytes_start } bytes / $h2_bytes_limit bytes )\n" ; errors_incr( $mysync, $error ) ; } return ; @@ -3036,9 +4006,11 @@ sub tests_mock_capability sub sig_install_toggle_sleep { my $mysync = shift ; - if ( ! 'MSWin32' eq $OSNAME ) { - sig_install( $mysync, \&toggle_sleep, 'USR1' ) + if ( 'MSWin32' ne $OSNAME ) { + #myprint( "sig_install( $mysync, \&toggle_sleep, 'USR1' )\n" ) ; + sig_install( $mysync, 'toggle_sleep', 'USR1' ) ; } + #myprint( "Leaving sig_install_toggle_sleep\n" ) ; return ; } @@ -3237,7 +4209,7 @@ sub appendlimit my $appendlimit = appendlimit_from_capability( $myimap ) ; if ( defined $appendlimit ) { - myprint( "Host2: found APPENDLIMIT=$appendlimit in CAPABILITY\n" ) ; + myprint( "Host2: found APPENDLIMIT=$appendlimit in CAPABILITY (use --appendlimit xxxx to override this automatic setting)\n" ) ; return $appendlimit ; } return ; @@ -3245,7 +4217,7 @@ sub appendlimit } -sub tests_maxsize_setting +sub tests_maxsize_setting { note( 'Entering tests_maxsize_setting()' ) ; @@ -3262,6 +4234,7 @@ sub tests_maxsize_setting $mysync = { } ; $mysync->{ maxsize } = $NUMBER_123456 ; + # --maxsize alone is( $NUMBER_123456, maxsize_setting( $mysync ), 'maxsize_setting: --maxsize 123456 alone => 123456' ) ; @@ -3282,7 +4255,20 @@ sub tests_maxsize_setting 'maxsize_setting: APPENDLIMIT 654321 alone => maxsize 654321' ) ; + # APPENDLIMIT with --appendlimit => --appendlimit wins + $mysync->{ appendlimit } = $NUMBER_123456 ; + is( $NUMBER_123456, maxsize_setting( $mysync ), + 'maxsize_setting: APPENDLIMIT 654321 + --appendlimit 123456 => 123456' + ) ; + + is( $NUMBER_123456, $mysync->{ maxsize }, + 'maxsize_setting: APPENDLIMIT 654321 + --appendlimit 123456 => maxsize 123456' + ) ; + + # Fresh + $mysync = { } ; + $mysync->{ imap2 } = $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=654321' ) ; # Case: "APPENDLIMIT >= --maxsize" => maxsize. $mysync->{ maxsize } = $NUMBER_123456 ; @@ -3293,32 +4279,54 @@ sub tests_maxsize_setting # Case: "APPENDLIMIT < --maxsize" => APPENDLIMIT. - $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=123456' ) ; + + # Fresh + $mysync = { } ; + $mysync->{ imap2 } = $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=123456' ) ; $mysync->{ maxsize } = $NUMBER_654321 ; is( $NUMBER_123456, maxsize_setting( $mysync ), 'maxsize_setting: APPENDLIMIT 123456 --maxsize 654321 => 123456 ' ) ; + # Now --truncmess stuff + + + note( 'Leaving tests_maxsize_setting()' ) ; return ; } +# Three variables to take account of +# appendlimit (given by --appendlimit or CAPABILITY...) +# maxsize +# truncmess + sub maxsize_setting { my $mysync = shift || return ; - $mysync->{ appendlimit } = appendlimit( $mysync ) ; + if ( defined $mysync->{ appendlimit } ) + { + myprint( "Host2: Getting appendlimit from --appendlimit $mysync->{ appendlimit }\n" ) ; + } + else + { + $mysync->{ appendlimit } = appendlimit( $mysync ) ; + } - my $maxsize ; if ( all_defined( $mysync->{ appendlimit }, $mysync->{ maxsize } ) ) { - return min( $mysync->{ maxsize }, $mysync->{ appendlimit } ) ; + my $min_maxsize_appendlimit = min( $mysync->{ maxsize }, $mysync->{ appendlimit } ) ; + myprint( "Host2: Setting maxsize to $min_maxsize_appendlimit (min of --maxsize $mysync->{ maxsize } and appendlimit $mysync->{ appendlimit }\n" ) ; + $mysync->{ maxsize } = $min_maxsize_appendlimit ; + return $mysync->{ maxsize } ; } elsif ( defined $mysync->{ appendlimit } ) { + myprint( "Host2: Setting maxsize to appendlimit $mysync->{ appendlimit }\n" ) ; $mysync->{ maxsize } = $mysync->{ appendlimit } ; return $mysync->{ maxsize } ; }elsif ( defined $mysync->{ maxsize } ) @@ -3369,17 +4377,17 @@ sub tests_hashsynclocal note( 'Entering tests_hashsynclocal()' ) ; my $mysync = { - host1 => '', - user1 => '', - password1 => '', - host2 => '', - user2 => '', - password2 => '', + host1 => q{}, + user1 => q{}, + password1 => q{}, + host2 => q{}, + user2 => q{}, + password2 => q{}, } ; is( undef, hashsynclocal( $mysync ), 'hashsynclocal: no hashfile name' ) ; - $mysync->{ hashfile } = '' ; + $mysync->{ hashfile } = q{} ; is( undef, hashsynclocal( $mysync ), 'hashsynclocal: empty hashfile name' ) ; $mysync->{ hashfile } = './noexist/rrr' ; @@ -3542,6 +4550,8 @@ sub imap_id { my ( $mysync, $imap, $Side ) = @_ ; + if ( not $mysync->{id} ) { return q{} ; } ; + $Side ||= q{} ; my $imap_id_response = q{} ; @@ -3556,7 +4566,7 @@ sub imap_id $imap->Debug( 1 ) ; my $id_out = $imap->tag_and_run( 'ID ' . $id_inp ) ; #my $id_out = $imap->tag_and_run( 'ID NIL' ) ; - myprint( "\n" ) ; + myprint( "\n" ) ; $imap->Debug( $debug_before ) ; #$imap_id_response = Data::Dumper->Dump( [ $id_out ], [ 'IMAP_ID' ] ) ; } @@ -3578,7 +4588,7 @@ sub imapsync_id vendor => 'Gilles LAMIRAL', 'support-url' => 'https://imapsync.lamiral.info/', # Example of date-time: 19-Sep-2015 08:56:07 - date => date_from_rcs( q{$Date: 2019/05/01 22:14:00 $ } ), + date => date_from_rcs( q{$Date: 2019/12/23 20:18:02 $ } ), } ; my $imapsync_id_github = { @@ -3587,7 +4597,7 @@ sub imapsync_id os => $OSNAME, vendor => 'github', 'support-url' => 'https://github.com/imapsync/imapsync', - date => date_from_rcs( q{$Date: 2019/05/01 22:14:00 $ } ), + date => date_from_rcs( q{$Date: 2019/12/23 20:18:02 $ } ), } ; $imapsync_id = $imapsync_id_lamiral ; @@ -3900,7 +4910,9 @@ sub build_possible_special $possible_special->{'\Archive'} = [ 'Archive', 'Archives', '&BBAEQARFBDgEMg-' ] ; $possible_special->{'\Drafts'} = [ 'Drafts', 'DRAFTS', '&BCcENQRABD0EPgQyBDgEOgQ4-', 'Szkice', 'Wersje robocze' ] ; $possible_special->{'\Flagged'} = [ 'Flagged', 'Starred', '&BB8EPgQ8BDUERwQ1BD0EPQRLBDU-' ] ; - $possible_special->{'\Junk'} = [ 'Junk', 'Spam', 'SPAM', '&BCEEPwQwBDw-', 'Potwierdzony spam', 'Wiadomo&AVs-ci-&AVs-mieci' ] ; + $possible_special->{'\Junk'} = [ 'Junk', 'junk', 'Spam', 'SPAM', '&BCEEPwQwBDw-', + 'Potwierdzony spam', 'Wiadomo&AVs-ci-&AVs-mieci', + 'Junk E-Mail', 'Junk Email'] ; $possible_special->{'\Sent'} = [ 'Sent', 'Sent Messages', 'Sent Items', 'Gesendete Elemente', 'Gesendete Objekte', '&AMk-l&AOk-ments envoy&AOk-s', 'Envoy&AOk-', 'Objets envoy&AOk-s', @@ -3908,7 +4920,10 @@ sub build_possible_special '&kAFP4W4IMH8wojCkMMYw4A-', '&BB4EQgQ,BEAEMAQyBDsENQQ9BD0ESwQ1-', 'Elementy wys&AUI-ane'] ; - $possible_special->{'\Trash'} = [ 'Trash', 'TRASH', '&BCMENAQwBDsENQQ9BD0ESwQ1-', '&BBoEPgRABDcEOAQ9BDA-', 'Kosz', 'Deleted Items' ] ; + $possible_special->{'\Trash'} = [ 'Trash', 'TRASH', + '&BCMENAQwBDsENQQ9BD0ESwQ1-', '&BBoEPgRABDcEOAQ9BDA-', + 'Kosz', + 'Deleted Items', 'Deleted Messages' ] ; foreach my $special ( qw( \All \Archive \Drafts \Flagged \Junk \Sent \Trash ) ){ @@ -4063,26 +5078,6 @@ sub tests_live_result return ; } -sub foldersizesatend -{ - my $mysync = shift ; - timenext( ) ; - return if ( $mysync->{imap1}->IsUnconnected( ) ) ; - return if ( $mysync->{imap2}->IsUnconnected( ) ) ; - # Get all folders on host2 again since new were created - @h2_folders_all = sort $mysync->{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', $mysync->{imap1}, $search1, $mysync->{abletosearch1}, @h1_folders_wanted ) ; - ( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( 'Host2', $mysync->{imap2}, $search2, $mysync->{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( $mysync, $error ) ; - } - return ; -} sub size_filtered_flag { @@ -4222,6 +5217,9 @@ sub tests_max is( 1, max( 1 ), 'max 1 => 1' ) ; is( $MINUS_ONE, max( $MINUS_ONE ), 'max -1 => -1') ; is( undef, max( ), 'max no arg => undef' ) ; + is( undef, max( undef ), 'undef => undef' ) ; + is( undef, max( undef, undef ), 'undef, undef => 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' ) ; @@ -4249,20 +5247,30 @@ sub max return( undef ) if ( 0 == scalar @list ) ; my( @numbers, @notnumbers ) ; - foreach my $item ( @list ) { - if ( is_number( $item ) ) { + foreach my $item ( @list ) + { + if ( is_number( $item ) ) + { push @numbers, $item ; - }else{ + } + elsif ( defined $item ) + { push @notnumbers, $item ; } } my @sorted ; - if ( @numbers ) { + + if ( @numbers ) + { @sorted = sort { $a <=> $b } @numbers ; - }elsif( @notnumbers ) { + } + elsif ( @notnumbers ) + { @sorted = sort { $a cmp $b } @notnumbers ; - }else{ + } + else + { return ; } @@ -4273,7 +5281,8 @@ sub tests_is_number { note( 'Entering tests_is_number()' ) ; - ok( ! is_number( ), 'is_number: no args => undef ' ) ; + is( undef, is_number( ), 'is_number: no args => undef ' ) ; + is( undef, is_number( undef ), 'is_number: undef => undef ' ) ; ok( is_number( 1 ), 'is_number: 1 => 1' ) ; ok( is_number( 1.1 ), 'is_number: 1.1 => 1' ) ; ok( is_number( 0 ), 'is_number: 0 => 1' ) ; @@ -4398,6 +5407,8 @@ sub modulesversion 'Digest::HMAC_MD5' => sub { $Digest::HMAC_MD5::VERSION }, 'Digest::HMAC_SHA1' => sub { $Digest::HMAC_SHA1::VERSION }, 'Digest::MD5' => sub { $Digest::MD5::VERSION }, + 'Encode' => sub { $Encode::VERSION }, + 'Encode::IMAPUTF7' => sub { $Encode::IMAPUTF7::VERSION }, 'File::Copy::Recursive' => sub { $File::Copy::Recursive::VERSION }, 'File::Spec' => sub { $File::Spec::VERSION }, 'Getopt::Long' => sub { $Getopt::Long::VERSION }, @@ -4412,6 +5423,7 @@ sub modulesversion 'JSON::WebToken' => sub { $JSON::WebToken::VERSION }, 'LWP' => sub { $LWP::VERSION }, 'Mail::IMAPClient' => sub { $Mail::IMAPClient::VERSION }, + 'MIME::Base64' => sub { $MIME::Base64::VERSION }, 'Net::Ping' => sub { $Net::Ping::VERSION }, 'Net::SSLeay' => sub { $Net::SSLeay::VERSION }, 'Term::ReadKey' => sub { $Term::ReadKey::VERSION }, @@ -4580,6 +5592,7 @@ FIN_PASSFILE if ( defined $mysync->{ passfile1 } ) { if ( ! -e -r $mysync->{ passfile1 } ) { myprint( "Failure: file from parameter --passfile1 $mysync->{ passfile1 } does not exist or is not readable\n" ) ; + $mysync->{nb_errors}++ ; exit_clean( $mysync, $EX_NOINPUT ) ; } # passfile1 readable @@ -4622,6 +5635,7 @@ FIN_PASSFILE if ( defined $mysync->{ passfile2 } ) { if ( ! -e -r $mysync->{ passfile2 } ) { myprint( "Failure: file from parameter --passfile2 $mysync->{ passfile2 } does not exist or is not readable\n" ) ; + $mysync->{nb_errors}++ ; exit_clean( $mysync, $EX_NOINPUT ) ; } # passfile2 readable @@ -4683,7 +5697,7 @@ sub exit_clean { myprint( @messages ) ; } - myprint( "Exiting with return value $status\n" ) ; + myprint( "Exiting with return value $status ($EXIT_TXT{$status}) $mysync->{nb_errors}/$mysync->{errorsmax} nb_errors/max_errors\n" ) ; cleanup_before_exit( $mysync ) ; exit $status ; @@ -4693,6 +5707,7 @@ sub missing_option { my $mysync = shift ; my $option = shift ; + $mysync->{nb_errors}++ ; exit_clean( $mysync, $EX_USAGE, "$option option is mandatory, for help run $PROGRAM_NAME --help\n" ) ; return ; } @@ -4733,10 +5748,16 @@ sub catch_exit myprint( "Killing myself with signal $signame\n" ) ; cleanup_before_exit( $mysync ) ; kill( $signame, $PROCESS_ID ) ; + sleep 1 ; + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EXIT_BY_SIGNAL, + "Still there after killing myself with signal $signame...\n" + ) ; } else { - exit_clean( $mysync, $EXIT_BY_SIGNAL ) ; + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EXIT_BY_SIGNAL, "Exiting in catch_exit with no signal...\n" ) ; } return ; } @@ -4753,6 +5774,20 @@ sub catch_print 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{ + return $FALSE ; + } +} + sub catch_reconnect { @@ -4780,6 +5815,7 @@ sub catch_reconnect } else { + $mysync->{nb_errors}++ ; exit_clean( $mysync, $EXIT_CONNECTION_FAILURE ) ; } myprint( "Info: reconnecting to host2 imap server\n" ) ; @@ -4791,6 +5827,7 @@ sub catch_reconnect } else { + $mysync->{nb_errors}++ ; exit_clean( $mysync, $EXIT_CONNECTION_FAILURE ) ; } myprint( "Info: reconnected to both imap servers\n" ) ; @@ -4798,6 +5835,40 @@ sub catch_reconnect return ; } +sub install_signals +{ + my $mysync = shift ; + + if ( under_docker_context( $mysync ) ) + { + # output( $mysync, "Under docker context so leaving signals as they are\n" ) ; + output( $mysync, "Under docker context so installing only signals to exit\n" ) ; + @{ $mysync->{ sigexit } } = ( defined( $mysync->{ sigexit } ) ) ? @{ $mysync->{ sigexit } } : ( 'INT', 'QUIT', 'TERM' ) ; + sig_install( $mysync, 'catch_exit', @{ $mysync->{ sigexit } } ) ; + } + else + { + # Unix signals + @{ $mysync->{ sigexit } } = ( defined( $mysync->{ sigexit } ) ) ? @{ $mysync->{ sigexit } } : ( 'QUIT', 'TERM' ) ; + @{ $mysync->{ sigreconnect } } = ( defined( $mysync->{ sigreconnect } ) ) ? @{ $mysync->{ sigreconnect } } : ( 'INT' ) ; + @{ $mysync->{ sigprint } } = ( defined( $mysync->{ sigprint } ) ) ? @{ $mysync->{ sigprint } } : ( 'HUP' ) ; + @{ $mysync->{ sigignore } } = ( defined( $mysync->{ sigignore } ) ) ? @{ $mysync->{ sigignore } } : ( ) ; + + #local %SIG = %SIG ; + sig_install( $mysync, 'catch_exit', @{ $mysync->{ sigexit } } ) ; + sig_install( $mysync, 'catch_reconnect', @{ $mysync->{ sigreconnect } } ) ; + sig_install( $mysync, 'catch_print', @{ $mysync->{ sigprint } } ) ; + # --sigignore can override sigexit, sigreconnect and sigprint (for the same signals only) + sig_install( $mysync, 'catch_ignore', @{ $mysync->{ sigignore } } ) ; + + sig_install_toggle_sleep( $mysync ) ; + } + + return ; +} + + + sub tests_reconnect_12_if_needed { note( 'Entering tests_reconnect_12_if_needed()' ) ; @@ -4885,36 +5956,56 @@ sub reconnect_if_needed -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{ - return $FALSE ; - } -} - +# $sync->{id} = defined $sync->{id} ? $sync->{id} : 1 ; +# imap_id_stuff( $sync ) ; sub justconnect { my $mysync = shift ; - $mysync->{imap1} = connect_imap( $mysync->{host1}, $mysync->{port1}, $debugimap1, - $mysync->{ssl1}, $mysync->{tls1}, 'Host1', $mysync->{h1}->{timeout}, $mysync->{h1} ) ; - $mysync->{imap2} = connect_imap( $mysync->{host2}, $mysync->{port2}, $debugimap2, - $mysync->{ssl2}, $mysync->{tls2}, 'Host2', $mysync->{h2}->{timeout}, $mysync->{h2} ) ; - $mysync->{imap1}->logout( ) ; - $mysync->{imap2}->logout( ) ; - return ; + my $justconnect1 = justconnect1( $sync ) ; + my $justconnect2 = justconnect2( $sync ) ; + return "$justconnect1 $justconnect2"; +} + +sub justconnect1 +{ + my $mysync = shift ; + if ( $mysync->{host1} ) + { + myprint( "Host1: Will just connect to $mysync->{host1} without login\n" ) ; + $mysync->{imap1} = connect_imap( + $mysync->{host1}, $mysync->{port1}, $debugimap1, + $mysync->{ssl1}, $mysync->{tls1}, 'Host1', + $mysync->{h1}->{timeout}, $mysync->{h1} ) ; + imap_id( $mysync, $mysync->{imap1}, 'Host1' ) ; + $mysync->{imap1}->logout( ) ; + return $mysync->{host1} ; + } + + return q{} ; +} + +sub justconnect2 +{ + my $mysync = shift ; + if ( $mysync->{host2} ) + { + myprint( "Host2: Will just connect to $mysync->{host2} without login\n" ) ; + $mysync->{imap2} = connect_imap( + $mysync->{host2}, $mysync->{port2}, $debugimap2, + $mysync->{ssl2}, $mysync->{tls2}, 'Host2', + $mysync->{h2}->{timeout}, $mysync->{h2} ) ; + imap_id( $mysync, $mysync->{imap2}, 'Host2' ) ; + $mysync->{imap2}->logout( ) ; + return $mysync->{host2} ; + } + + return q{} ; } sub skip_macosx { - return ; + #return ; return( 'macosx.polarhome.com' eq hostname() ) ; } @@ -4928,13 +6019,14 @@ sub tests_mailimapclient_connect is( 'Mail::IMAPClient', ref( $imap ), 'mailimapclient_connect ipv4: ref is Mail::IMAPClient' ) ; # Mail::IMAPClient 3.40 die on this... So we skip it, thanks to "mature" IO::Socket::IP - # is( undef, $imap->connect( ), 'mailimapclient_connect ipv4: connect with no server => failure' ) ; + # Mail::IMAPClient 3.42 is ok so this test is back. + 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 )' ) ; + is( 3, $imap->Timeout( 3 ), 'mailimapclient_connect ipv4: setting Timout( 3 )' ) ; like( ref( $imap->connect( ) ), qr/IO::Socket::INET|IO::Socket::IP/, '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' ) ; @@ -4943,16 +6035,19 @@ sub tests_mailimapclient_connect 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 )' ) ; + ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE, SSL_cipher_list => 'DEFAULT:!DH' ] ), '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' ) ; + like( $imap->logout( ), qr/Mail::IMAPClient/, 'mailimapclient_connect ipv4 + ssl: logout in ssl does not cause failure' ) ; is( undef, undef $imap, 'mailimapclient_connect ipv4 + ssl: free variable' ) ; # ipv6 + ssl + # Fails often on ks2ipv6.lamiral.info + 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( 'petiteipv6.lamiral.info', $imap->Server( 'petiteipv6.lamiral.info' ), 'mailimapclient_connect ipv6 + ssl: setting Server petiteipv6.lamiral.info' ) ; + is( 3, $imap->Timeout( 3 ), 'mailimapclient_connect ipv4: setting Timout( 3 )' ) ; + ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE, SSL_cipher_list => 'DEFAULT:!DH' ] ), 'mailimapclient_connect ipv6 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ; is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv6 + ssl: setting Port( 993 )' ) ; SKIP: { if ( @@ -4961,13 +6056,23 @@ sub tests_mailimapclient_connect skip_macosx() or -e '/.dockerenv' + or + 'pcHPDV7-HP' eq hostname() ) { - skip( 'Tests avoided on CUILLERE can not do ipv6', 2 ) ; + skip( 'Tests avoided on CUILLERE/pcHPDV7-HP/macosx.polarhome.com/docker cannot do ipv6', 4 ) ; } - 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( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4 + ssl: setting Debug( 1 )' ) ; + + # It sounds stupid but it avoids failures on the next test about $imap->connect + is( '2a01:e34:ecde:70d0:223:54ff:fec2:36d7', resolv( 'petiteipv6.lamiral.info' ), 'resolv: petiteipv6.lamiral.info => 2001:41d0:8:bebd::1' ) ; + + like( ref( $imap->connect( ) ), qr/IO::Socket::SSL/, 'mailimapclient_connect ipv6 + ssl: connect to petiteipv6.lamiral.info' ) ; + # This one is ok on petite, not on ks2, do not know why, so commented. + like( ref( $imap->logout( ) ), qr/Mail::IMAPClient/, 'mailimapclient_connect ipv6 + ssl: logout in ssl is ok on petiteipv6.lamiral.info' ) ; } + is( undef, undef $imap, 'mailimapclient_connect ipv6 + ssl: free variable' ) ; @@ -4994,9 +6099,11 @@ sub tests_mailimapclient_connect_bug skip_macosx() or -e '/.dockerenv' + or + 'pcHPDV7-HP' eq hostname() ) { - skip( 'Tests avoided on CUILLERE can not do ipv6', 1 ) ; + skip( 'Tests avoided on CUILLERE/pcHPDV7-HP/macosx.polarhome.com/docker cannot do ipv6', 1 ) ; } like( ref( $imap->connect( ) ), qr/IO::Socket::INET/, 'mailimapclient_connect_bug ipv6: connect to ks2ipv6.lamiral.info' ) or diag( 'mailimapclient_connect_bug ipv6: ', $imap->LastError( ), $!, ) ; @@ -5025,9 +6132,11 @@ sub tests_connect_socket skip_macosx() or -e '/.dockerenv' + or + 'pcHPDV7-HP' eq hostname() ) { - skip( 'Tests avoided on CUILLERE/macosx.polarhome.com/docker cannot do ipv6', 2 ) ; + skip( 'Tests avoided on CUILLERE/pcHPDV7-HP/macosx.polarhome.com/docker cannot do ipv6', 2 ) ; } $socket = IO::Socket::INET6->new( @@ -5043,11 +6152,12 @@ sub tests_connect_socket $imap->logout( ) ; } - #$IO::Socket::SSL::DEBUG = 4 ; + $IO::Socket::SSL::DEBUG = 4 ; $socket = IO::Socket::SSL->new( PeerHost => 'ks2ipv6.lamiral.info', PeerPort => 993, SSL_verify_mode => SSL_VERIFY_NONE, + SSL_cipher_list => 'DEFAULT:!DH', ) ; # myprint( $socket ) ; ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 993 IO::Socket::SSL' ) ; @@ -5091,44 +6201,55 @@ sub tests_probe_imapssl is( undef, probe_imapssl( ), 'probe_imapssl: no args => undef' ) ; is( undef, probe_imapssl( 'unknown' ), 'probe_imapssl: unknown => undef' ) ; - SKIP: { + note( "hostname is: ", hostname() ) ; + SKIP: { if ( 'CUILLERE' eq hostname() or skip_macosx() or -e '/.dockerenv' + or + 'pcHPDV7-HP' eq hostname() ) { - skip( 'Tests avoided on CUILLERE/macosx.polarhome.com/docker cannot do ipv6', 2 ) ; + skip( 'Tests avoided on CUILLERE or pcHPDV7-HP or Mac or docker: cannot do ipv6', 0 ) ; } - like( probe_imapssl( 'ks2ipv6.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: ks2ipv6.lamiral.info matches "* OK"' ) ; - like( probe_imapssl( 'imap.gmail.com' ), qr/^\* OK/, 'probe_imapssl: imap.gmail.com matches "* OK"' ) ; + # fed up with this one + #like( probe_imapssl( 'ks2ipv6.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: ks2ipv6.lamiral.info matches "* OK"' ) ; } ; + + # It sounds stupid but it avoids failures on the next test about $imap->connect + ok( resolv( 'imap.gmail.com' ), 'resolv: imap.gmail.com => something' ) ; + like( probe_imapssl( 'imap.gmail.com' ), qr/^\* OK/, 'probe_imapssl: imap.gmail.com matches "* OK"' ) ; + like( probe_imapssl( 'test1.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: test1.lamiral.info matches "* OK"' ) ; note( 'Leaving tests_probe_imapssl()' ) ; return ; } + sub probe_imapssl { my $host = shift ; if ( ! $host ) { return ; } - + $sync->{ debug } and $IO::Socket::SSL::DEBUG = 4 ; my $socket = IO::Socket::SSL->new( PeerHost => $host, PeerPort => $IMAP_SSL_PORT, - SSL_verify_mode => SSL_VERIFY_NONE, + SSL_verifycn_scheme => 'imap', + SSL_verify_mode => $SSL_VERIFY_POLICY, + SSL_cipher_list => 'DEFAULT:!DH', ) ; - #print "$socket\n" ; if ( ! $socket ) { return ; } + $sync->{ debug } and print "socket: $socket\n" ; my $banner ; $socket->sysread( $banner, 65_536 ) ; - #print "$banner" ; + $sync->{ debug } and print "banner: $banner" ; $socket->close( ) ; return $banner ; @@ -5138,6 +6259,7 @@ sub connect_imap { 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 ) ; @@ -5147,9 +6269,17 @@ sub connect_imap my $side = lc $Side ; myprint( "$Side: connecting on $side [$host] port [$port]\n" ) ; - $imap->connect( ) - or exit_clean( $sync, $EXIT_CONNECTION_FAILURE, "$Side: Can not open imap connection on [$host]: " . $imap->LastError . " $OS_ERROR\n" ) ; - myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n" ) ; + if ( ! $imap->connect( ) ) + { + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_CONNECTION_FAILURE, + "$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] ; myprint( "$Side banner: $banner" ) ; @@ -5157,8 +6287,14 @@ sub connect_imap if ( $tls ) { set_tls( $imap, $h ) ; - $imap->starttls( ) - or exit_clean( $sync, $EXIT_TLS_FAILURE, "$Side: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ; + if ( ! $imap->starttls( ) ) + { + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_TLS_FAILURE, + "$Side: Can not go to tls encryption on $side [$host]:", + $imap->LastError, "\n" + ) ; + } myprint( "$Side: Socket successfuly converted to SSL\n" ) ; } return( $imap ) ; @@ -5180,9 +6316,15 @@ sub login_imap my $imap = init_imap( @allargs ) ; - $imap->connect() - or exit_clean( $mysync, $EXIT_CONNECTION_FAILURE, "$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" ) ; + if ( ! $imap->connect() ) + { + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EXIT_CONNECTION_FAILURE, + "$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] ; myprint( "$Side banner: $banner" ) ; @@ -5198,14 +6340,24 @@ sub login_imap $imap->Socket ; myprintf("%s: Assuming PREAUTH for %s\n", $Side, $imap->Server ) ; }else{ - exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, "$Side failure: error login on $side [$host] with user [$user] auth [PREAUTH]" ) ; + $mysync->{nb_errors}++ ; + exit_clean( + $mysync, $EXIT_AUTHENTICATION_FAILURE, + "$Side failure: error login on $side [$host] with user [$user] auth [PREAUTH]\n" + ) ; } } if ( $tls ) { set_tls( $imap, $h ) ; - $imap->starttls( ) - or exit_clean( $mysync, $EXIT_TLS_FAILURE, "$Side failure: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ; + if ( ! $imap->starttls( ) ) + { + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EXIT_TLS_FAILURE, + "$Side failure: Can not go to tls encryption on $side [$host]:", + $imap->LastError, "\n" + ) ; + } myprint( "$Side: Socket successfuly converted to SSL\n" ) ; } @@ -5248,20 +6400,32 @@ sub authenticate_imap $imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $authmech ) or ( 'EXTERNAL' eq $authmech ) ) ; - unless ( $authmech eq 'PREAUTH' or $authmech eq 'X-MASTERAUTH' or $imap->login( ) ) { + 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 ) { + if ( ( $authmech eq 'LOGIN' ) or $imap->IsUnconnected( ) or $authuser ) { + $authuser ||= "" ; + myprint( "$Side info: authmech [$authmech] user [$user] authuser [$authuser] IsUnconnected [", $imap->IsUnconnected( ), "]\n" ) ; + $mysync->{nb_errors}++ ; exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, $error ) ; }else{ myprint( $error ) ; } + # It is not secure to try plain text LOGIN when another authmech failed + # but I do it. + # I shell remove this code one day. myprint( "$Side info: trying LOGIN Auth mechanism on [$host] with user [$user]\n" ) ; $imap->Authmechanism(q{}) ; - $imap->login() or - exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, "$info [LOGIN]: ", $imap->LastError, "\n") ; + if ( ! $imap->login( ) ) + { + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, + "$info [LOGIN]: ", + $imap->LastError, "\n" + ) ; + } } if ( $proxyauth ) { @@ -5269,7 +6433,11 @@ sub authenticate_imap my $info = "$Side failure: Error doing proxyauth as user [$user] on [$host] using proxy-login as [$authuser]" ; my $einfo = $imap->LastError || @{$imap->History}[$LAST] ; chomp $einfo ; - exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, "$info: $einfo\n" ) ; + $mysync->{nb_errors}++ ; + exit_clean( $mysync, + $EXIT_AUTHENTICATION_FAILURE, + "$info: $einfo\n" + ) ; } } @@ -5368,7 +6536,7 @@ sub set_tls -sub init_imap +sub init_imap { my( $host, $port, $user, $domain, $password, @@ -5379,7 +6547,14 @@ sub init_imap my ( $imap ) ; $imap = Mail::IMAPClient->new() ; - + + if ( $mysync->{ tee } ) + { + # Well, it does not change anything, does it? + # It does when suppressing the hack with *STDERR + $imap->Debug_fh( $mysync->{ tee } ) ; + } + if ( $ssl ) { set_ssl( $imap, $h ) } if ( $tls ) { } # can not do set_tls() here because connect() will directly do a STARTTLS $imap->Clear(1); @@ -5460,20 +6635,29 @@ sub xoauth2 my ($iss,$key); - if( $imap->Password =~ /^(.*\.json)$/x ) { - my $json = JSON->new( ) ; - my $filename = $1; - $sync->{ debug } and myprint( "XOAUTH2 json file: $filename\n" ) ; - open( my $FILE, '<', $filename ) or exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "error [$filename]: $OS_ERROR " ) ; - my $jsonfile = $json->decode( join q{}, <$FILE> ) ; - close $FILE ; + if( $imap->Password =~ /^(.*\.json)$/x ) + { + my $json = JSON->new( ) ; + my $filename = $1; + $sync->{ debug } and myprint( "XOAUTH2 json file: $filename\n" ) ; + my $FILE ; + if ( ! open( $FILE, '<', $filename ) ) + { + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, + "error [$filename]: $OS_ERROR\n" + ) ; + } + my $jsonfile = $json->decode( join q{}, <$FILE> ) ; + close $FILE ; - $iss = $jsonfile->{client_id}; - $key = $jsonfile->{private_key}; - $sync->{ debug } and myprint( "Service account: $iss\n"); - $sync->{ debug } and myprint( "Private key:\n$key\n"); + $iss = $jsonfile->{client_id}; + $key = $jsonfile->{private_key}; + $sync->{ debug } and myprint( "Service account: $iss\n"); + $sync->{ debug } and myprint( "Private key:\n$key\n"); } - else { + 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 \_\-\.\/]+);?(.*)?/x ; @@ -5509,7 +6693,10 @@ sub xoauth2 assertion => $jwt } ) ; unless( $response->is_success( ) ) { - exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, $response->code, "\n", $response->content, "\n" ) ; + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, + $response->code, "\n", $response->content, "\n" + ) ; }else{ $sync->{ debug } and myprint( $response->content ) ; } @@ -5616,19 +6803,35 @@ sub xmasterauth my @challenge = $imap->tag_and_run( $authmech, "+" ) ; if ( not defined $challenge[0] ) { - exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Failure authenticate with $authmech: ", $imap->LastError, "\n") ; + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, + "Failure authenticate with $authmech: ", + $imap->LastError, "\n" + ) ; return ; # hahaha! } $sync->{ debug } and myprint( "X-MASTERAUTH challenge: [@challenge]\n" ) ; $challenge[1] =~ s/^\+ |^\s+|\s+$//g ; - $imap->_imap_command( { addcrlf => 1, addtag => 0, tag => $imap->Count }, md5_hex( $challenge[1] . $password ) ) - or exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Failure authenticate with $authmech: ", $imap->LastError, "\n") ; + if ( ! $imap->_imap_command( { addcrlf => 1, addtag => 0, tag => $imap->Count }, md5_hex( $challenge[1] . $password ) ) ) + { + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, + "Failure authenticate with $authmech: ", + $imap->LastError, "\n" + ) ; + } - $imap->tag_and_run( 'X-SETUSER ' . $user ) - or exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Failure authenticate with $authmech: ", "X-SETUSER ", $imap->LastError, "\n") ; + if ( ! $imap->tag_and_run( 'X-SETUSER ' . $user ) ) + { + $sync->{nb_errors}++ ; + exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, + "Failure authenticate with $authmech: ", + "X-SETUSER ", $imap->LastError, "\n" + ) ; + } - $imap->State( Mail::IMAPClient::Authenticated ) ; + $imap->State( Mail::IMAPClient::Authenticated ) ; # I comment this state because "Selected" state is usually done by SELECT or EXAMINE imap commands # $imap->State( Mail::IMAPClient::Selected ) ; @@ -5667,8 +6870,8 @@ sub banner_imapsync my $banner_imapsync = join q{}, q{$RCSfile: imapsync,v $ }, - q{$Revision: 1.937 $ }, - q{$Date: 2019/05/01 22:14:00 $ }, + q{$Revision: 1.977 $ }, + q{$Date: 2019/12/23 20:18:02 $ }, "\n", "Command line used, run by $EXECUTABLE_NAME:\n", "$PROGRAM_NAME ", command_line_nopassword( $mysync, @argv ), "\n" ; @@ -5709,16 +6912,23 @@ sub tests_match_a_pid_number note( 'Entering tests_match_a_pid_number()' ) ; is( undef, match_a_pid_number( ), 'match_a_pid_number: no args => undef' ) ; - is( undef, match_a_pid_number( '' ), 'match_a_pid_number: "" => undef' ) ; + is( undef, match_a_pid_number( q{} ), 'match_a_pid_number: "" => undef' ) ; is( undef, match_a_pid_number( 'lalala' ), 'match_a_pid_number: lalala => undef' ) ; is( 1, match_a_pid_number( 1 ), 'match_a_pid_number: 1 => 1' ) ; is( 1, match_a_pid_number( 123 ), 'match_a_pid_number: 123 => 1' ) ; + is( 1, match_a_pid_number( -123 ), 'match_a_pid_number: -123 => 1' ) ; is( 1, match_a_pid_number( '123' ), 'match_a_pid_number: "123" => 1' ) ; + is( 1, match_a_pid_number( '-123' ), 'match_a_pid_number: "-123" => 1' ) ; is( undef, match_a_pid_number( 'a123' ), 'match_a_pid_number: a123 => undef' ) ; + is( undef, match_a_pid_number( '-a123' ), 'match_a_pid_number: -a123 => undef' ) ; is( 1, match_a_pid_number( 99999 ), 'match_a_pid_number: 99999 => 1' ) ; + is( 1, match_a_pid_number( -99999 ), 'match_a_pid_number: -99999 => 1' ) ; is( undef, match_a_pid_number( 0 ), 'match_a_pid_number: 0 => undef' ) ; is( undef, match_a_pid_number( 100000 ), 'match_a_pid_number: 100000 => undef' ) ; is( undef, match_a_pid_number( 123456 ), 'match_a_pid_number: 123456 => undef' ) ; + is( undef, match_a_pid_number( '-0' ), 'match_a_pid_number: "-0" => undef' ) ; + is( undef, match_a_pid_number( -100000 ), 'match_a_pid_number: -100000 => undef' ) ; + is( undef, match_a_pid_number( -123456 ), 'match_a_pid_number: -123456 => undef' ) ; note( 'Leaving tests_match_a_pid_number()' ) ; return ; @@ -5727,11 +6937,15 @@ sub tests_match_a_pid_number sub match_a_pid_number { my $pid = shift @ARG ; - if ( ! $pid ) { return ; } - if ( ! match( $pid, '^\d+$' ) ) { return ; } - if ( 0 > $pid ) { return ; } + if ( ! defined $pid ) { return ; } + #print "$pid\n" ; + if ( ! match( $pid, '^-?\d+$' ) ) { return ; } + #print "$pid\n" ; + # can be negative on Windows + #if ( 0 > $pid ) { return ; } #if ( 65535 < $pid ) { return ; } - if ( 99999 < $pid ) { return ; } + if ( 99999 < abs( $pid ) ) { return ; } + if ( 0 == abs( $pid ) ) { return ; } return 1 ; } @@ -6073,22 +7287,42 @@ sub jux_utf8_list sub tests_jux_utf8_list { - note( 'Entering tests_jux_utf8_list()' ) ; + 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-' ) ; + use utf8 ; + is( q{}, jux_utf8_list( ), 'jux_utf8_list: void' ) ; + is( "[]\n", jux_utf8_list( q{} ), 'jux_utf8_list: empty string' ) ; + is( "[INBOX]\n", jux_utf8_list( 'INBOX' ), 'jux_utf8_list: INBOX' ) ; + is( "[&ANY-] = [Ö]\n", jux_utf8_list( '&ANY-' ), 'jux_utf8_list: [&ANY-] = [Ö]' ) ; - note( 'Leaving tests_jux_utf8_list()' ) ; + note( 'Leaving tests_jux_utf8_list()' ) ; return( 0 ) ; } -sub jux_utf8 +# editing utf8 can be tricky without an utf8 editor +sub tests_jux_utf8_old +{ + note( 'Entering tests_jux_utf8_old()' ) ; + + no utf8 ; + + is( '[]', jux_utf8_old( q{} ), 'jux_utf8_old: void => []' ) ; + is( '[INBOX]', jux_utf8_old( 'INBOX'), 'jux_utf8_old: INBOX => [INBOX]' ) ; + is( '[&ZTZO9nux-] = [收件箱]', jux_utf8_old( '&ZTZO9nux-'), 'jux_utf8_old: => [&ZTZO9nux-] = [收件箱]' ) ; + is( '[&ANY-] = [Ö]', jux_utf8_old( '&ANY-'), 'jux_utf8_old: &ANY- => [&ANY-] = [Ö]' ) ; + # +BD8EQAQ1BDQEOwQ+BDM- SHOULD stay as is! + is( '[+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]', jux_utf8_old( '+BD8EQAQ1BDQEOwQ+BDM-' ), 'jux_utf8_old: => [+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]' ) ; + is( '[&BB8EQAQ+BDUEOgRC-] = [Проект]', jux_utf8_old( '&BB8EQAQ+BDUEOgRC-' ), 'jux_utf8_old: => [&BB8EQAQ+BDUEOgRC-] = [Проект]' ) ; + + note( 'Leaving tests_jux_utf8_old()' ) ; + return ; +} + +sub jux_utf8_old { # juxtapose utf8 at the right if different my ( $s_utf7 ) = shift ; - my ( $s_utf8 ) = imap_utf7_decode( $s_utf7 ) ; + my ( $s_utf8 ) = imap_utf7_decode_old( $s_utf7 ) ; if ( $s_utf7 eq $s_utf8 ) { #myprint( "[$s_utf7]\n" ) ; @@ -6099,26 +7333,10 @@ sub jux_utf8 } } -# editing utf8 can be tricky without an utf8 editor -sub tests_jux_utf8 -{ - 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-] = [Проект]' ) ; - - note( 'Leaving tests_jux_utf8()' ) ; - return ; -} - # Copied from http://cpansearch.perl.org/src/FABPOT/Unicode-IMAPUtf7-2.01/lib/Unicode/IMAPUtf7.pm # and then fixed with # https://rt.cpan.org/Public/Bug/Display.html?id=11172 -sub imap_utf7_decode +sub imap_utf7_decode_old { my ( $s ) = shift ; @@ -6132,7 +7350,77 @@ sub imap_utf7_decode return( Unicode::String::utf7( $s )->utf8 ) ; } + + + + +sub tests_jux_utf8 +{ + note( 'Entering tests_jux_utf8()' ) ; + #no utf8 ; + use utf8 ; + + #binmode STDOUT, ":encoding(UTF-8)" ; + binmode STDERR, ":encoding(UTF-8)" ; + + # This test is because the binary can fail on it, a PAR.pm issue. + # The failure was with the underlying Encode::IMAPUTF7 module line 66 release 1.05 + # Was solved by including Encode in imapsync and using "pp -x". + ok( find_encoding( "UTF-16BE"), 'jux_utf8: Encode::find_encoding: UTF-16BE' ) ; + + # + is( '[]', jux_utf8( q{} ), 'jux_utf8: void => []' ) ; + is( '[INBOX]', jux_utf8( 'INBOX'), 'jux_utf8: INBOX => [INBOX]' ) ; + is( '[&ANY-] = [Ö]', jux_utf8( '&ANY-'), 'jux_utf8: &ANY- => [&ANY-] = [Ö]' ) ; + # +BD8EQAQ1BDQEOwQ+BDM- must stay as is + is( '[+BD8EQAQ1BDQEOwQ+BDM-]', jux_utf8( '+BD8EQAQ1BDQEOwQ+BDM-' ), 'jux_utf8: => [+BD8EQAQ1BDQEOwQ+BDM-] = [+BD8EQAQ1BDQEOwQ+BDM-]' ) ; + is( '[&BB8EQAQ+BDUEOgRC-] = [Проект]', jux_utf8( '&BB8EQAQ+BDUEOgRC-' ), 'jux_utf8: => [&BB8EQAQ+BDUEOgRC-] = [Проект]' ) ; + + is( '[R&AOk-ponses 1200+1201+1202] = [Réponses 1200+1201+1202]', jux_utf8( q{R&AOk-ponses 1200+1201+1202} ), 'jux_utf8: [R&AOk-ponses 1200+1201+1202] = [Réponses 1200+1201+1202]' ) ; + my $str = Encode::IMAPUTF7::encode("IMAP-UTF-7", 'Réponses 1200+1201+1202' ) ; + is( '[R&AOk-ponses 1200+1201+1202] = [Réponses 1200+1201+1202]', jux_utf8( $str ), "jux_utf8: [$str] = [Réponses 1200+1201+1202]" ) ; + + is( '[INBOX.&AOkA4ADnAPk-&-*] = [INBOX.éà çù&*]', jux_utf8( 'INBOX.&AOkA4ADnAPk-&-*' ), "jux_utf8: [INBOX.&AOkA4ADnAPk-&-*] = [INBOX.éà çù&*]" ) ; + + is( '[&ZTZO9nux-] = [收件箱]', jux_utf8( '&ZTZO9nux-'), 'jux_utf8: => [&ZTZO9nux-] = [收件箱]' ) ; + # + note( 'Leaving tests_jux_utf8()' ) ; + return ; +} + +sub jux_utf8 +{ + #use utf8 ; + # 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]" ) ; + }else{ + #myprint( "[$s_utf7] = [$s_utf8]\n" ) ; + return( "[$s_utf7] = [$s_utf8]" ) ; + } +} + +sub imap_utf7_decode +{ + #use utf8 ; + my ( $s ) = shift ; + return( Encode::IMAPUTF7::decode("IMAP-UTF-7", $s ) ) ; +} + sub imap_utf7_encode +{ + #use utf8 ; + my ( $s ) = shift ; + return( Encode::IMAPUTF7::encode("IMAP-UTF-7", $s ) ) ; +} + + + +sub imap_utf7_encode_old { my ( $s ) = @_ ; @@ -6757,12 +8045,18 @@ sub subfolder1 $mysync->{ automap } = undef ; myprint( "Sanitizing subfolder1: [$mysync->{ subfolder1 }] => [$subfolder1]\n" ) ; $mysync->{ subfolder1 } = $subfolder1 ; - add_subfolder1_to_folderrec( $mysync ) || exit_clean( $mysync, $EXIT_SUBFOLDER1_NO_EXISTS ) ; + if ( ! add_subfolder1_to_folderrec( $mysync ) ) + { + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EXIT_SUBFOLDER1_NO_EXISTS, "subfolder1 $subfolder1 does not exist\n" ) ; + } } else { $mysync->{ subfolder1 } = undef ; } + + return ; } sub subfolder2 @@ -6783,6 +8077,7 @@ sub subfolder2 $mysync->{ subfolder2 } = undef ; } + return ; } sub tests_sanitize_subfolder @@ -6790,7 +8085,7 @@ sub tests_sanitize_subfolder note( 'Entering tests_sanitize_subfolder()' ) ; is( undef, sanitize_subfolder( ), 'sanitize_subfolder: no args => undef' ) ; - is( undef, sanitize_subfolder( '' ), 'sanitize_subfolder: empty => undef' ) ; + is( undef, sanitize_subfolder( q{} ), 'sanitize_subfolder: empty => undef' ) ; is( undef, sanitize_subfolder( ' ' ), 'sanitize_subfolder: blank => undef' ) ; is( undef, sanitize_subfolder( ' ' ), 'sanitize_subfolder: blanks => undef' ) ; is( 'abcd', sanitize_subfolder( 'abcd' ), 'sanitize_subfolder: abcd => abcd' ) ; @@ -7095,7 +8390,7 @@ EOS # Global variables to remove: -# +# None? sub imap2_folder_name @@ -7124,7 +8419,7 @@ sub imap2_folder_name #myprint( "h1_fold=$h1_fold\n" ) ; } - if ( ( '' eq $h1_fold ) or ( $mysync->{ h1_prefix } eq $h1_fold ) ) + if ( ( q{} eq $h1_fold ) or ( $mysync->{ h1_prefix } eq $h1_fold ) ) { $h1_fold = 'INBOX' ; } @@ -7140,9 +8435,9 @@ sub tests_remove_last_char_if_is note( 'Entering tests_remove_last_char_if_is()' ) ; is( undef, remove_last_char_if_is( ), 'remove_last_char_if_is: no args => undef' ) ; - is( '', remove_last_char_if_is( '' ), 'remove_last_char_if_is: empty => empty' ) ; - is( '', remove_last_char_if_is( '', 'Z' ), 'remove_last_char_if_is: empty Z => empty' ) ; - is( '', remove_last_char_if_is( 'Z', 'Z' ), 'remove_last_char_if_is: Z Z => empty' ) ; + is( q{}, remove_last_char_if_is( q{} ), 'remove_last_char_if_is: empty => empty' ) ; + is( q{}, remove_last_char_if_is( q{}, 'Z' ), 'remove_last_char_if_is: empty Z => empty' ) ; + is( q{}, remove_last_char_if_is( 'Z', 'Z' ), 'remove_last_char_if_is: Z Z => empty' ) ; is( 'abc', remove_last_char_if_is( 'abcZ', 'Z' ), 'remove_last_char_if_is: abcZ Z => abc' ) ; is( 'abcY', remove_last_char_if_is( 'abcY', 'Z' ), 'remove_last_char_if_is: abcY Z => abcY' ) ; note( 'Leaving tests_remove_last_char_if_is()' ) ; @@ -7192,8 +8487,8 @@ sub tests_prefix_seperator_invertion is( '.....', prefix_seperator_invertion( undef, '.....' ), 'prefix_seperator_invertion: ..... => .....' ) ; my $mysync = { - h1_prefix => '', - h2_prefix => '', + h1_prefix => q{}, + h2_prefix => q{}, h1_sep => '/', h2_sep => '/', } ; @@ -7316,7 +8611,10 @@ sub regextrans2 my $ret = eval "\$h2_fold =~ $regextrans2 ; 1 " ; ( $mysync->{ debug } or $mysync->{debugfolders} ) and myprint( "[$h2_fold_before] -> [$h2_fold] using regextrans2 [$regextrans2]\n" ) ; if ( not ( defined $ret ) or $EVAL_ERROR ) { - exit_clean( $mysync, $EX_USAGE, "error: eval regextrans2 '$regextrans2': $EVAL_ERROR\n" ) ; + $mysync->{nb_errors}++ ; + exit_clean( $mysync, $EX_USAGE, + "error: eval regextrans2 '$regextrans2': $EVAL_ERROR\n" + ) ; } } return( $h2_fold ) ; @@ -7346,106 +8644,64 @@ sub decompose_regex } -sub foldersizes + +sub tests_timenext { + note( 'Entering tests_timenext()' ) ; - my ( $side, $imap, $search_cmd, $abletosearch, @folders ) = @_ ; - my $total_size = 0 ; - my $total_nb = 0 ; - my $biggest_in_all = 0 ; + is( undef, timenext( ), 'timenext: no args => undef' ) ; + my $mysync ; + is( undef, timenext( $mysync ), 'timenext: undef => undef' ) ; + $mysync = {} ; + ok( time - timenext( $mysync ) <= 1e-02, 'timenext: defined first time => ~ time' ) ; + ok( timenext( $mysync ) <= 1e-02, 'timenext: second time => less than 1e-02' ) ; + ok( timenext( $mysync ) <= 1e-02, 'timenext: third time => less than 1e-02' ) ; - 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 ; - } - if ( 'Host1' eq $side and not exists $h1_folders_all{ $folder } ) { - 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( ) ; - - 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: $EVAL_ERROR\n" ; - 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: $EVAL_ERROR\n" ; - errors_incr( $sync, $error ) ; - return ; - } - } - 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 ; - $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( ) ) ; - return( $total_nb, $total_size ) ; + note( 'Leaving tests_timenext()' ) ; + return ; } + sub timenext { + my $mysync = shift ; + + if ( ! defined $mysync ) + { + return ; + } my ( $timenow, $timediff ) ; - # $timebefore is global, beurk ! + + $mysync->{ timebefore } ||= 0; # epoch... $timenow = time ; - $timediff = $timenow - $timebefore ; - $timebefore = $timenow ; + $timediff = $timenow - $mysync->{ timebefore } ; + $mysync->{ timebefore } = $timenow ; + # myprint( "timenext: $timediff\n" ) ; return( $timediff ) ; } + +sub tests_timesince +{ + note( 'Entering tests_timesince()' ) ; + + ok( timesince( time - 1 ) - 1 <= 1e-02, 'timesince: time - 1 => <= 1 + 1e-02' ) ; + ok( timesince( time ) <= 1e-02, 'timesince: time => <= 1e-02' ) ; + ok( timesince( ) - time <= 1e-02, 'timesince: no args => <= time + 1e-02' ) ; + note( 'Leaving tests_timesince()' ) ; + return ; +} + + + sub timesince { my $timeinit = shift || 0 ; my ( $timenow, $timediff ) ; $timenow = time ; $timediff = $timenow - $timeinit ; - # Often used in a division so no 0 - return( max( 1, $timediff) ) ; + # Often used in a division so no 0 but a nano seconde. + return( max( $timediff, min( 1e-09, $timediff ) ) ) ; } @@ -7990,7 +9246,8 @@ sub copy_message # copy my ( $mysync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ; - ( $mysync->{ debug } or $mysync->{dry}) and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $mysync->{dry_message}\n" ) ; + ( $mysync->{ debug } or $mysync->{dry} ) + and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $mysync->{dry_message} " . eta( $mysync ) . "\n" ) ; my $h1_size = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'} || 0 ; my $h1_flags = $h1_fir_ref->{$h1_msg}->{'FLAGS'} || q{} ; @@ -8190,20 +9447,50 @@ sub message_for_host2 ${ $string_ref } = $header . "\r\n" . ${ $string_ref } ; } + if ( ( defined $mysync->{ truncmess } ) and is_an_integer( $mysync->{ truncmess } ) ) + { + ${ $string_ref } = truncmess( ${ $string_ref }, $mysync->{ truncmess } ) ; + } + $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" ) ; + "\nF message content ended on previous line\n", q{=} x $STD_CHAR_PER_LINE, "\n" ) ; myprint( debugmemory( $mysync, " at M3" ) ) ; return $string_len ; } +sub tests_truncmess +{ + note( 'Entering tests_truncmess()' ) ; + is( undef, truncmess( ), 'truncmess: no args => undef' ) ; + is( 'abc', truncmess( 'abc' ), 'truncmess: abc => abc' ) ; + is( 'ab', truncmess( 'abc', 2 ), 'truncmess: abc 2 => ab' ) ; + is( 'abc', truncmess( 'abc', 3 ), 'truncmess: abc 3 => abc' ) ; + is( 'abc', truncmess( 'abc', 4 ), 'truncmess: abc 4 => abc' ) ; + is( '12345', truncmess( "123456789\n", 5 ), 'truncmess: "123456789\n", 5 => 12345' ) ; + is( "123456789\n" x 5000, truncmess( "123456789\n" x 100000, 50000 ), 'truncmess: "123456789\n" x 100000, 50000 => "123456789\n" x 5000' ) ; + note( 'Leaving tests_truncmess()' ) ; + return ; +} + +sub truncmess +{ + my $string = shift ; + my $length = shift ; + + if ( not defined $string ) { return ; } + if ( not defined $length ) { return $string ; } + + $string = substr $string, 0, $length ; + return $string ; +} sub tests_message_for_host2 { @@ -8223,7 +9510,7 @@ sub tests_message_for_host2 $h1_msg = 1 ; $h1_fold = 'FoldFoo'; $h1_size = 9 ; - $h1_flags = '' ; + $h1_flags = q{} ; $h1_idate = '10-Jul-2015 09:00:00 +0200' ; $h1_fir_ref = {} ; $string_ref = \$string ; @@ -8275,7 +9562,7 @@ sub tests_message_for_host2 is( undef, $string, q{message_for_host2: --pipemess 'true', value} ) ; } - note( 'Leaving tests_message_for_host2()' ) ; + note( 'Leaving tests_message_for_host2()' ) ; return ; } @@ -8340,7 +9627,7 @@ sub labels_remove_subfolder1 else { # Remove surrounding quotes if any, to add them again in case of space - $label = join( '', quotewords('\s+', 0, $label ) ) ; + $label = join( q{}, quotewords('\s+', 0, $label ) ) ; $label =~ s{$subfolder1/?}{} ; if ( 'INBOX' eq $label ) { @@ -8371,9 +9658,9 @@ sub tests_labels_remove_special note( 'Entering tests_labels_remove_special()' ) ; is( undef, labels_remove_special( ), 'labels_remove_special: no parameters => undef' ) ; - is( '', labels_remove_special( '' ), 'labels_remove_special: empty string => empty string' ) ; - is( '', labels_remove_special( '"\\\\Inbox"' ), 'labels_remove_special:"\\\\Inbox" => empty string' ) ; - is( '', labels_remove_special( '"\\\\Inbox" "\\\\Starred"' ), 'labels_remove_special:"\\\\Inbox" "\\\\Starred" => empty string' ) ; + is( q{}, labels_remove_special( q{} ), 'labels_remove_special: empty string => empty string' ) ; + is( q{}, labels_remove_special( '"\\\\Inbox"' ), 'labels_remove_special:"\\\\Inbox" => empty string' ) ; + is( q{}, labels_remove_special( '"\\\\Inbox" "\\\\Starred"' ), 'labels_remove_special:"\\\\Inbox" "\\\\Starred" => empty string' ) ; is( 'Bar Foo', labels_remove_special( 'Foo Bar' ), 'labels_remove_special:Foo Bar => Bar Foo' ) ; is( 'Bar Foo', labels_remove_special( 'Foo Bar "\\\\Inbox"' ), 'labels_remove_special:Foo Bar "\\\\Inbox" => Bar Foo' ) ; note( 'Leaving tests_labels_remove_special()' ) ; @@ -8495,14 +9782,14 @@ sub labels_add_subfolder2 # \Seen \Deleted ... stay the same #push @labels_subfolder2, $label ; # Remove surrounding quotes if any, to add them again - $label = join( '', quotewords('\s+', 0, $label ) ) ; + $label = join( q{}, quotewords('\s+', 0, $label ) ) ; push @labels_subfolder2, qq{"$subfolder2/\\$label"} ; } else { # Remove surrounding quotes if any, to add them again in case of space - $label = join( '', quotewords('\s+', 0, $label ) ) ; + $label = join( q{}, quotewords('\s+', 0, $label ) ) ; if ( $label =~ m{ } ) { push @labels_subfolder2, qq{"$subfolder2/$label"} ; @@ -8900,7 +10187,7 @@ sub append_message_on_host2 my $new_id ; if ( ! $mysync->{dry} ) { - $max_msg_size_in_bytes = max( $h1_size, $max_msg_size_in_bytes ) ; + $max_msg_size_in_bytes = max( $string_len, $max_msg_size_in_bytes ) ; $new_id = $mysync->{imap2}->append_string( $h2_fold, ${ $string_ref }, $h1_flags, $h1_date ) ; myprint( debugmemory( $mysync, " at A2" ) ) ; if ( ! $new_id){ @@ -8920,14 +10207,13 @@ sub append_message_on_host2 } if ( $mysync->{ synclabels } ) { synclabels( $mysync, $h1_msg, $new_id ) } $h2_uidguess += 1 ; - $mysync->{total_bytes_transferred} += $h1_size ; - $mysync->{nb_msg_transferred} += 1 ; + $mysync->{ total_bytes_transferred } += $string_len ; + $mysync->{ nb_msg_transferred } += 1 ; $mysync->{ h1_nb_msg_processed } +=1 ; my $time_spent = timesince( $mysync->{begin_transfer_time} ) ; my $rate = bytes_display_string( $mysync->{total_bytes_transferred} / $time_spent ) ; - my $eta = eta( $time_spent, - $mysync->{ h1_nb_msg_processed }, $h1_nb_msg_start, $mysync->{nb_msg_transferred} ) ; + my $eta = eta( $mysync ) ; my $amount_transferred = bytes_display_string( $mysync->{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, $mysync->{nb_msg_transferred}/$time_spent, $rate, @@ -8949,12 +10235,13 @@ sub append_message_on_host2 } else{ $nb_msg_skipped_dry_mode += 1 ; - $mysync->{ h1_nb_msg_processed } +=1 ; + $mysync->{ h1_nb_msg_processed } += 1 ; } return ; } + sub tests_sleep_if_needed { note( 'Entering tests_sleep_if_needed()' ) ; @@ -9154,7 +10441,8 @@ sub delete_messages_on_any my $nb_deleted = $imap->delete_message( $imap->Range( @messages_part ) ) ; if ( defined $nb_deleted ) { - $mysync->{ h1_nb_msg_deleted } += $nb_deleted ; + # $nb_deleted is not accurate + $mysync->{ h1_nb_msg_deleted } += scalar @messages_part ; } else { @@ -9234,38 +10522,106 @@ sub uidexpunge_or_expunge return ; } +sub eta_print +{ + my $mysync = shift ; + if ( my $eta = eta( $mysync ) ) + { + myprint( "$eta\n" ) ; + } + return ; +} + +sub tests_eta +{ + note( 'Entering tests_eta()' ) ; + + is( q{}, eta( ), 'eta: no args => ""' ) ; + is( q{}, eta( undef ), 'eta: undef => ""' ) ; + my $mysync = {} ; + # No foldersizes + is( q{}, eta( $mysync ), 'eta: No foldersizes => ""' ) ; + + $mysync->{ foldersizes } = 1 ; + + $mysync->{ begin_transfer_time } = time ; # Now + $mysync->{ h1_nb_msg_processed } = 0 ; + + is( "ETA: " . localtime( time ) . " 0 s 0/0 msgs left", + eta( $mysync ), + 'eta: no args => ETA: "Now" 0 s 0/0 msgs left' ) ; + + $mysync->{ h1_nb_msg_processed } = 1 ; + $mysync->{ h1_nb_msg_start } = 2 ; + is( "ETA: " . localtime( time ) . " 0 s 1/2 msgs left", + eta( $mysync ), + 'eta: 1, 1, 2 => ETA: "Now" 0 s 1/2 msgs left' ) ; + + note( 'Leaving tests_eta()' ) ; + return ; +} + sub eta { - my( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) = @_ ; - return( q{} ) if not $foldersizes ; + my( $mysync ) = shift ; - 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 ; + if ( ! $mysync ) + { + return q{} ; + } + + return( q{} ) if not $mysync->{ foldersizes } ; + + my $h1_nb_msg_start = $mysync->{ h1_nb_msg_start } ; + my $h1_nb_processed = $mysync->{ h1_nb_msg_processed } ; + my $nb_msg_transferred = ( $mysync->{dry} ) ? $mysync->{ h1_nb_msg_processed } : $mysync->{ nb_msg_transferred } ; + my $time_spent = timesince( $mysync->{ begin_transfer_time } ) ; + $h1_nb_processed ||= 0 ; + $h1_nb_msg_start ||= 0 ; + $time_spent ||= 0 ; + + my $time_remaining = time_remaining( $time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_msg_transferred ) ; + $mysync->{ debug } and myprint( "time_spent: $time_spent time_remaining: $time_remaining\n" ) ; + my $nb_msg_remaining = $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, $my_h1_nb_msg_start ) ) ; + return( mysprintf( 'ETA: %s %1.0f s %s/%s msgs left', + $eta_date, $time_remaining, $nb_msg_remaining, $h1_nb_msg_start ) ) ; } + + + sub time_remaining { - my( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) = @_ ; + my( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) = @_ ; - my $time_remaining = ( $my_time_spent / $nb_transferred ) * ( $my_h1_nb_msg_start - $h1_nb_processed ) ; + $nb_transferred ||= 1 ; # At least one is done (no division by zero) + $h1_nb_processed ||= 0 ; + $h1_nb_msg_start ||= $h1_nb_processed ; + $my_time_spent ||= 0 ; + + my $time_remaining = ( $my_time_spent / $nb_transferred ) * ( $h1_nb_msg_start - $h1_nb_processed ) ; return( $time_remaining ) ; } sub tests_time_remaining { - note( 'Entering tests_time_remaining()' ) ; + note( 'Entering tests_time_remaining()' ) ; + # time_spent, nb_processed, nb_to_do_total, nb_transferred + is( 0, time_remaining( ), 'time_remaining: no args -> 0' ) ; + is( 0, time_remaining( 0, 0, 0, 0 ), 'time_remaining: 0, 0, 0, 0 -> 0' ) ; + is( 1, time_remaining( 1, 1, 2, 1 ), 'time_remaining: 1, 1, 2, 1 -> 1' ) ; + is( 1, time_remaining( 9, 9, 10, 9 ), 'time_remaining: 9, 9, 10, 9 -> 1' ) ; + is( 9, time_remaining( 1, 1, 10, 1 ), 'time_remaining: 1, 1, 10, 1 -> 9' ) ; + is( 5, time_remaining( 5, 5, 10, 5 ), 'time_remaining: 5, 5, 10, 5 -> 5' ) ; + is( 25, time_remaining( 5, 5, 10, 0 ), 'time_remaining: 5, 5, 10, 0 -> ( 5 / 1 ) * ( 10 - 5) = 25' ) ; + is( 25, time_remaining( 5, 5, 10, 1 ), 'time_remaining: 5, 5, 10, 1 -> ( 5 / 1 ) * ( 10 - 5) = 25' ) ; - 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()' ) ; + note( 'Leaving tests_time_remaining()' ) ; return ; } @@ -10470,11 +11826,59 @@ EOM ), 'regexmess: 17 Delete header Disposition-Notification-To:'); + @regexmess = ( 's/.{11}\K.*//gs' ) ; + is( "0123456789\n", regexmess( "0123456789\n" x 100 ), 'regexmess, truncate whole message after 11 characters' ) ; + is( "0123456789\n", regexmess( "0123456789\n" x 100_000 ), 'regexmess, truncate whole message after 11 characters ~ 1MB' ) ; + + @regexmess = ( 's/.{10000}\K.*//gs' ) ; + is( "123456789\n" x 1000, regexmess( "123456789\n" x 100_000 ), 'regexmess, truncate whole message after 10000 characters ~ 1MB' ) ; + +@regexmess = ( 's/^(X-Ham-Report.*?\n)^X-/X-/sm' ) ; + +is( +<<'EOM' +X-Spam-Score: -1 +X-Spam-Bar: / +X-Spam-Flag: NO +Date: Sat, 10 Jul 2010 05:34:45 -0700 +From: + +Hello, + +Bye. +EOM +, +regexmess( +<<'EOM' +X-Spam-Score: -1 +X-Spam-Bar: / +X-Ham-Report: =?utf-8?Q?Spam_detection_software=2C_running?= + =?utf-8?Q?_on_the_system_=22ohp-ag006.int200?= +_has_NOT_identified_thi?= + =?utf-8?Q?s_incoming_email_as_spam.__The_o?= +_message_has_been_attac?= + =?utf-8?Q?hed_to_this_so_you_can_view_it_o?= +___________________________?= + =?utf-8?Q?__author's_domain +X-Spam-Flag: NO +Date: Sat, 10 Jul 2010 05:34:45 -0700 +From: + +Hello, + +Bye. +EOM +), + 'regexmess: 1 Delete header X-Ham-Report:'); # regex to play with Date: from the FAQ #@regexmess = 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}gxms' + + + + note( 'Leaving tests_regexmess()' ) ; return ; @@ -10877,7 +12281,7 @@ sub stats 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( "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 : $mysync->{ nb_msg_skipped }\n" ) ; @@ -10912,11 +12316,11 @@ sub stats $max_msg_size_in_bytes, bytes_display_string( $max_msg_size_in_bytes) ) ; myprint( "Memory/biggest message ratio : $memory_ratio\n" ) ; - if ( $foldersizesatend and $foldersizes ) { + if ( $mysync->{ foldersizesatend } and $mysync->{ 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 ) ; + my $nb_msg_start_diff = diff_or_NA( $mysync->{ h2_nb_msg_start }, $mysync->{ h1_nb_msg_start } ) ; + my $bytes_start_diff = diff_or_NA( $mysync->{ h2_bytes_start }, $mysync->{ h1_bytes_start } ) ; myprintf("Start difference host2 - host1 : %s messages, %s bytes (%s)\n", $nb_msg_start_diff, $bytes_start_diff, @@ -11046,7 +12450,7 @@ sub parse_header_msg $mysync->{ debug } and myprint( "$side: uid $m_uid number of headers, 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" ) ; + $mysync->{ debug } and 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 ; @@ -11065,7 +12469,7 @@ sub parse_header_msg if ( ( ! $headstr ) and ( $mysync->{addheader} ) and ( $side eq 'Host1' ) ) { my $header = add_header( $m_uid ) ; - myprint( "$side: uid $m_uid no header found so adding our own [$header]\n" ) ; + $mysync->{ debug } and myprint( "$side: uid $m_uid no header found so adding our own [$header]\n" ) ; $headstr .= uc $header ; $s_fir->{$m_uid}->{NO_HEADER} = 1; } @@ -11283,7 +12687,6 @@ sub nthline chomp $line ; return $line ; } - } @@ -11571,10 +12974,12 @@ sub imapsync_version_public my $local_version = imapsync_version( $sync ) ; my $imapsync_basename = imapsync_basename( ) ; + my $context = imapsync_context( ) ; my $agent_info = "$OSNAME system, perl " . mysprintf( '%vd', $PERL_VERSION) . ", Mail::IMAPClient $Mail::IMAPClient::VERSION" - . " $imapsync_basename" ; + . " $imapsync_basename" + . " $context" ; my $sock = IO::Socket::INET->new( PeerAddr => 'imapsync.lamiral.info', PeerPort => 80, @@ -11701,6 +13106,42 @@ sub tests_check_last_release return ; } +sub tests_imapsync_context +{ + note( 'Entering tests_imapsync_context()' ) ; + + like( imapsync_context( ), qr/^CGI|^Docker|^DockerCGI|^Standard/, 'imapsync_context: CGI or Docker or DockerCGI or Standard' ) ; + note( 'Leaving tests_imapsync_context()' ) ; + return ; +} + +sub imapsync_context +{ + my $mysync = shift ; + + my $context = q{} ; + + if ( under_docker_context( $mysync ) && under_cgi_context( $mysync ) ) + { + $context = 'DockerCGI' ; + } + elsif ( under_docker_context( $mysync ) ) + { + $context = 'Docker' ; + } + elsif ( under_cgi_context( $mysync ) ) + { + $context = 'CGI' ; + } + else + { + $context = 'Standard' ; + } + + return $context ; + +} + sub imapsync_version { my $mysync = shift ; @@ -12373,6 +13814,7 @@ sub search_dyn_lib_locale { return search_dyn_lib_locale_MSWin32( ) ; } + } sub search_dyn_lib_locale_darwin @@ -12675,11 +14117,15 @@ sub list_keys_in_2_not_in_1 my @list; foreach my $key ( sort keys %{ $hash_2_ref } ) { - #$debug and print "$folder\n" ; - next if exists $hash_1_ref->{$key} ; + #$sync->{ debug } and print "$key\n" ; + if ( exists $hash_1_ref->{$key} ) + { + next ; + } + #$sync->{ debug } and print "list_keys_in_2_not_in_1: $key\n" ; push @list, $key ; } - #$debug and print "@list\n" ; + #$sync->{ debug } and print "@list\n" ; return( @list ) ; } @@ -12691,7 +14137,7 @@ sub list_folders_in_2_not_in_1 @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 ) ; - + #$sync->{ debug } and print "h2_folders_not_in_h1: @h2_folders_not_in_h1\n" ; return( reverse @h2_folders_not_in_h1 ) ; } @@ -12775,16 +14221,28 @@ sub comment_on_final_diff_in_1_not_in_2 if ( 0 == $mysync->{ nb_messages_in_1_not_in_2 } ) { - myprint( "The sync looks good, all $nb_identified_h1_messages identified messages in host1 are on host2.\n" ) ; + myprint( "The sync looks good, all ", + $nb_identified_h1_messages, + " identified messages in host1 are on host2.\n" ) ; } else { - myprint( "The sync is not finished, there are $mysync->{ nb_messages_in_1_not_in_2 } identified messages in host1 that are not on host2.\n" ) ; + myprint( "The sync is not finished, there are ", + $mysync->{ nb_messages_in_1_not_in_2 }, + " identified messages in host1 that are not on host2.\n" ) ; } + if ( 1 <= $mysync->{ h1_nb_msg_noheader } ) { - myprint( "There are $mysync->{ h1_nb_msg_noheader } unidentified messages (usually Sent or Draft messages). To sync them add option --addheader\n" ) ; + myprint( "There are ", + $mysync->{ h1_nb_msg_noheader }, + " unidentified messages (usually Sent or Draft messages).", + " To sync them add option --addheader\n" ) ; + } + else + { + myprint( "There is no unidentified message\n" ) ; } return ; @@ -12803,7 +14261,7 @@ sub comment_on_final_diff_in_2_not_in_1 } my $nb_identified_h2_messages = scalar( keys %{ $mysync->{ h2_folders_of_md5 } } ) ; - # Calculate if not yet done + # Calculate if not done yet if ( not defined $mysync->{ nb_messages_in_2_not_in_1 } ) { nb_messages_in_2_not_in_1( $mysync ) ; @@ -12811,14 +14269,17 @@ sub comment_on_final_diff_in_2_not_in_1 if ( 0 == $mysync->{ nb_messages_in_2_not_in_1 } ) { - myprint( "The sync is strict, all $nb_identified_h2_messages identified messages in host2 are on host1.\n" ) ; + myprint( "The sync is strict, all ", + $nb_identified_h2_messages, + " identified messages in host2 are on host1.\n" ) ; } else { myprint( "The sync is not strict, there are ", $mysync->{ nb_messages_in_2_not_in_1 }, " messages in host2 that are not on host1.", - " Use --delete2 to delete them and have a strict sync.\n" ) ; + " Use --delete2 to delete them and have a strict sync.", + " ($nb_identified_h2_messages identified messages in host2)\n" ) ; } return ; } @@ -12944,7 +14405,7 @@ sub notmatch sub delete_folders_in_2_not_in_1 { - foreach my $folder (@h2_folders_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 ; @@ -13597,10 +15058,11 @@ sub setlogfile # proxy mode is not done yet my $remote_suffix = ( $mysync->{remote} ) ? '_remote' : q{} ; - my $suffix = ( filter_forbidden_characters( move_slash( $mysync->{user1} ) ) || q{} ) - . '_' - . ( filter_forbidden_characters( move_slash( $mysync->{user2} ) ) || q{} ) - . $remote_suffix . $abort_suffix ; + my $suffix = ( + filter_forbidden_characters( slash_to_underscore( $mysync->{user1} ) ) || q{} ) + . '_' + . ( filter_forbidden_characters( slash_to_underscore( $mysync->{user2} ) ) || q{} ) + . $remote_suffix . $abort_suffix ; $mysync->{logdir} = defined $mysync->{logdir} ? $mysync->{logdir} : $DEFAULT_LOGDIR ; @@ -13659,7 +15121,7 @@ sub logfile my $sep_dir = ( $dir ) ? '/' : q{} ; 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 + # Because of ab tests or web accesses, more than one sync withing one second is possible # so we add also milliseconds $date_str .= sprintf "_%03d", ($time - int( $time ) ) * 1000 ; # without rounding my $logfile = "${dir}${sep_dir}${date_str}${sep_suffix}${suffix}.txt" ; @@ -13668,18 +15130,18 @@ sub logfile -sub tests_move_slash +sub tests_slash_to_underscore { - note( 'Entering tests_move_slash()' ) ; + note( 'Entering tests_slash_to_underscore()' ) ; - 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()' ) ; + is( undef, slash_to_underscore( ), 'slash_to_underscore: no parameters => undef' ) ; + is( '_', slash_to_underscore( '/' ), 'slash_to_underscore: / => _' ) ; + is( '_abc_def_', slash_to_underscore( '/abc/def/' ), 'slash_to_underscore: /abc/def/ => _abc_def_' ) ; + note( 'Leaving tests_slash_to_underscore()' ) ; return ; } -sub move_slash +sub slash_to_underscore { my $string = shift ; @@ -13763,7 +15225,7 @@ sub tests_teelaunch is( undef, teelaunch( ), 'teelaunch: no args => undef' ) ; my $mysync = {} ; is( undef, teelaunch( $mysync ), 'teelaunch: arg empty {} => undef' ) ; - $mysync->{logfile} = '' ; + $mysync->{logfile} = q{} ; is( undef, teelaunch( $mysync ), 'teelaunch: logfile empty string => undef' ) ; $mysync->{logfile} = 'W/tmp/tests/tests_teelaunch.txt' ; isa_ok( my $tee = teelaunch( $mysync ), 'IO::Tee' , 'teelaunch: logfile W/tmp/tests/tests_teelaunch.txt' ) ; @@ -13798,6 +15260,7 @@ sub teelaunch ## no critic (InputOutput::RequireBriefOpen) open my $logfile_handle, '>', $logfile or croak( "Can not open $logfile for write: $OS_ERROR" ) ; + binmode $logfile_handle, ":encoding(UTF-8)" ; my $tee = IO::Tee->new( $logfile_handle, \*STDOUT ) ; $tee->autoflush( 1 ) ; $mysync->{logfile_handle} = $logfile_handle ; @@ -13821,8 +15284,8 @@ sub simulong my $division = 5 ; my $last_count = $division * $max_seconds ; foreach my $i ( 1 .. ( $last_count ) ) { - myprint( "Are you still here $i/$last_count\n" ) ; - #myprint( "Are you still here $i/$last_count\n" . ( "Ah" x 40 . "\n") x 4000 ) ; + myprint( "Are you still here ETA: " . ($last_count - $i) . "/$last_count msgs left\n" ) ; + #myprint( "Are you still here ETA: " . ($last_count - $i) . "/$last_count msgs left\n" . ( "Ah" x 40 . "\n") x 4000 ) ; sleep( 1 / $division ) ; } @@ -13841,27 +15304,27 @@ sub printenv sub testsexit { - my $mysync = shift ; + my $mysync = shift ; if ( ! ( $mysync->{ tests } or $mysync->{ testsdebug } or $mysync->{ testsunit } ) ) { - return ; - } + return ; + } my $test_builder = Test::More->builder ; tests( $mysync ) ; testsdebug( $mysync ) ; - testunitsession( $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", + 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 $EXIT_TESTS_FAILED ; + } cleanup_mess_from_tests( ) ; # Cover is larger with --tests --testslive @@ -13869,8 +15332,7 @@ sub testsexit { exit ; } - # $eeee ; - return ; + return ; } sub cleanup_mess_from_tests @@ -14005,7 +15467,7 @@ sub easyany return ; } -# From https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt +# From and for https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt sub gmail12 { my $mysync = shift ; @@ -14020,7 +15482,7 @@ sub gmail12 $mysync->{maxsleep} = ( defined $mysync->{maxsleep} ) ? $mysync->{maxsleep} : $MAX_SLEEP ; ; $skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 0 ; $mysync->{ synclabels } = ( defined $mysync->{ synclabels } ) ? $mysync->{ synclabels } : 1 ; - $mysync->{ reynclabels } = ( defined $mysync->{ reynclabels } ) ? $mysync->{ reynclabels } : 1 ; + $mysync->{ resynclabels } = ( defined $mysync->{ resynclabels } ) ? $mysync->{ resynclabels } : 1 ; push @exclude, '\[Gmail\]$' ; push @folderlast, '[Gmail]/All Mail' ; return ; @@ -14053,10 +15515,10 @@ sub gmail2 $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 - #$mysync->{ maxsize } ||= 25_000_000 ; + $mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ; #$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ; - $mysync->{ expunge1 } = ( defined $mysync->{ expunge1 } ) ? $mysync->{ expunge1 } : 1 ; + $mysync->{ expunge1 } = ( defined $mysync->{ expunge1 } ) ? $mysync->{ expunge1 } : 1 ; $mysync->{addheader} = ( defined $mysync->{addheader} ) ? $mysync->{addheader} : 1 ; $mysync->{maxsleep} = ( defined $mysync->{maxsleep} ) ? $mysync->{maxsleep} : $MAX_SLEEP ; ; @@ -14083,17 +15545,17 @@ sub gmail2 # From https://imapsync.lamiral.info/FAQ.d/FAQ.Exchange.txt sub office1 { - # Office 365 at host1 - my $mysync = shift ; + # Office 365 at host1 + my $mysync = shift ; - output( $mysync, q{Option --office1 is like: --host1 outlook.office365.com --ssl1 --exclude "^Files$"} . "\n" ) ; + output( $mysync, q{Option --office1 is like: --host1 outlook.office365.com --ssl1 --exclude "^Files$"} . "\n" ) ; output( $mysync, "Option --office1 (cont) : unless overrided with --host1 otherhost --nossl1 --noexclude\n" ) ; - $mysync->{host1} ||= 'outlook.office365.com' ; - $mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ; + $mysync->{host1} ||= 'outlook.office365.com' ; + $mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ; if ( ! $mysync->{noexclude} ) { push @exclude, '^Files$' ; } - return ; + return ; } @@ -14114,7 +15576,7 @@ sub office2 # I dislike double negation but here is one if ( ! $mysync->{noregexmess} ) { - push @regexmess, 's,(.{10500}),$1\r\n,g' ; + push @regexmess, 's,(.{10239}),$1\r\n,g' ; } # and another... if ( ! $mysync->{nof1f2} ) @@ -14148,7 +15610,7 @@ sub exchange2 push @regexflag, 's/\\\\Flagged//g' ; } if ( ! $mysync->{noregexmess} ) { - push @regexmess, 's,(.{10500}),$1\r\n,g' ; + push @regexmess, 's,(.{10239}),$1\r\n,g' ; } return ; } @@ -14183,7 +15645,7 @@ sub tests_resolv # is( , resolv( ), 'resolv: => ' ) ; is( undef, resolv( ), 'resolv: no args => undef' ) ; - is( undef, resolv( '' ), 'resolv: empty string => undef' ) ; + is( undef, resolv( q{} ), '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' ) ; @@ -14261,7 +15723,7 @@ sub tests_resolvrev # is( , resolvrev( ), 'resolvrev: => ' ) ; is( undef, resolvrev( ), 'resolvrev: no args => undef' ) ; - is( undef, resolvrev( '' ), 'resolvrev: empty string => undef' ) ; + is( undef, resolvrev( q{} ), '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' ) ; @@ -14500,7 +15962,7 @@ sub sslcheck } -sub testslive +sub testslive_init { my $mysync = shift ; $mysync->{host1} ||= 'test1.lamiral.info' ; @@ -14512,7 +15974,7 @@ sub testslive return ; } -sub testslive6 +sub testslive6_init { my $mysync = shift ; $mysync->{host1} ||= 'ks2ipv6.lamiral.info' ; @@ -14574,6 +16036,7 @@ sub split_around_equal } + sub tests_sig_install { note( 'Entering tests_sig_install()' ) ; @@ -14594,13 +16057,14 @@ sub tests_sig_install $mysync->{ debugsig } = 1 ; # Assign USR1 to call sub tototo # Surely a better value than undef should be returned when doing real signal stuff - is( undef, sig_install( $mysync, \&tototo, 'USR1' ), 'sig_install: USR1 tototo' ) ; + is( undef, sig_install( $mysync, 'tototo', 'USR1' ), 'sig_install: USR1 tototo' ) ; is( 1, kill( 'USR1', $PROCESS_ID ), 'sig_install: kill USR1 myself 1' ) ; is( 1, $mysync->{ tototo_calls }, 'sig_install: tototo call nb 1' ) ; + #return ; # Assign USR2 to call sub tototo - is( undef, sig_install( $mysync, \&tototo, 'USR2' ), 'sig_install: USR2 tototo' ) ; + is( undef, sig_install( $mysync, 'tototo', 'USR2' ), 'sig_install: USR2 tototo' ) ; is( 1, kill( 'USR2', $PROCESS_ID ), 'sig_install: kill USR2 myself 1' ) ; is( 2, $mysync->{ tototo_calls }, 'sig_install: tototo call nb 2' ) ; @@ -14614,7 +16078,7 @@ sub tests_sig_install is( 3, $mysync->{ tototo_calls }, 'sig_install: tototo call still nb 3' ) ; # Assign USR1 + USR2 to call sub tototo - is( undef, sig_install( $mysync, \&tototo, 'USR1', 'USR2' ), 'sig_install: USR1 USR2 tototo' ) ; + is( undef, sig_install( $mysync, 'tototo', 'USR1', 'USR2' ), 'sig_install: USR1 USR2 tototo' ) ; is( 1, kill( 'USR1', $PROCESS_ID ), 'sig_install: kill USR1 myself 4' ) ; is( 4, $mysync->{ tototo_calls }, 'sig_install: tototo call now nb 4' ) ; @@ -14633,22 +16097,26 @@ sub sig_install { my $mysync = shift ; if ( ! $mysync ) { return ; } - my $mysub = shift ; - if ( ! $mysub ) { return ; } + my $mysubname = shift ; + if ( ! $mysubname ) { return ; } + + if ( ! @ARG ) { return ; } my @signals = @ARG ; - $mysync->{ debugsig } and myprint( "In sig_install with $mysync and $mysub\n" ) ; + my $mysub = \&$mysubname ; + #$mysync->{ debugsig } = 1 ; + $mysync->{ debugsig } and myprint( "In sig_install with sub $mysubname and signal @ARG\n" ) ; my $subsignal = sub { my $signame = shift ; - $mysync->{ debugsig } and myprint( "In subsignal with $signame and $mysync\n" ) ; + $mysync->{ debugsig } and myprint( "In subsignal with $signame and $mysubname\n" ) ; &$mysub( $mysync, $signame ) ; } ; foreach my $signal ( @signals ) { - $mysync->{ debugsig } and myprint( "Installing signal $signal for $subsignal\n") ; - output( $mysync, "kill -$signal $PROCESS_ID # special behavior\n" ) ; + $mysync->{ debugsig } and myprint( "Installing signal $signal to call sub $mysubname\n") ; + output( $mysync, "kill -$signal $PROCESS_ID # special behavior: call to sub $mysubname\n" ) ; ## no critic (RequireLocalizedPunctuationVars) $SIG{ $signal } = $subsignal ; } @@ -14921,7 +16389,7 @@ sub myGetOptions } if ( ( $3 || q{} ) eq '@' ) { @{ ${$val} } = @values ; - my @option = map +( "--$name", "$_" ), @values ; + my @option = map { +( "--$name", "$_" ) } @values ; push @{ $mysync->{ cmdcgi } }, @option ; } elsif ( ref( $val ) eq 'ARRAY' ) { @@ -14987,7 +16455,7 @@ sub tests_get_options_cgi_context is( undef, get_options( $mysync ), 'get_options cgi context: no CGI module => undef' ) ; require CGI ; - CGI->import( qw( -no_debug ) ) ; + CGI->import( qw( -no_debug -utf8 ) ) ; is( undef, get_options( $mysync ), 'get_options cgi context: no CGI param => undef' ) ; # Testing boolean @@ -15078,10 +16546,10 @@ sub get_options_cgi $mysync, \@arguments, 'abort' => \$mysync->{abort}, - 'host1=s' => \$mysync->{host1}, - 'host2=s' => \$mysync->{host2}, - 'user1=s' => \$mysync->{user1}, - 'user2=s' => \$mysync->{user2}, + '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}, @@ -15169,14 +16637,14 @@ sub get_options_cmd 'debuglabels!' => \$mysync->{debuglabels}, 'simulong=i' => \$mysync->{simulong}, 'abort' => \$mysync->{abort}, - 'host1=s' => \$mysync->{host1}, - 'host2=s' => \$mysync->{host2}, + '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}, + 'user1=s' => \$mysync->{ user1 }, + 'user2=s' => \$mysync->{ user2 }, 'gmail1' => \$mysync->{gmail1}, 'gmail2' => \$mysync->{gmail2}, 'office1' => \$mysync->{office1}, @@ -15212,7 +16680,7 @@ sub get_options_cmd 'fixInboxINBOX!' => \$fixInboxINBOX, 'regextrans2=s@' => \$mysync->{ regextrans2 }, 'mixfolders!' => \$mixfolders, - 'skipemptyfolders!' => \$skipemptyfolders, + 'skipemptyfolders!' => \$mysync->{ skipemptyfolders }, 'regexmess=s' => \@regexmess, 'noregexmess' => \$mysync->{noregexmess}, 'skipmess=s' => \@skipmess, @@ -15235,16 +16703,18 @@ sub get_options_cmd 'delete2foldersbutnot=s' => \$delete2foldersbutnot, 'syncinternaldates!' => \$syncinternaldates, 'idatefromheader!' => \$idatefromheader, - 'syncacls!' => \$syncacls, - 'maxsize=i' => \$mysync->{ maxsize }, - 'minsize=i' => \$minsize, - 'maxage=i' => \$maxage, - 'minage=i' => \$minage, - 'search=s' => \$search, - 'search1=s' => \$search1, - 'search2=s' => \$search2, - 'foldersizes!' => \$foldersizes, - 'foldersizesatend!' => \$foldersizesatend, + 'syncacls!' => \$syncacls, + 'maxsize=i' => \$mysync->{ maxsize }, + 'appendlimit=i' => \$mysync->{ appendlimit }, + 'truncmess=i' => \$mysync->{ truncmess }, + 'minsize=i' => \$minsize, + 'maxage=f' => \$maxage, + 'minage=f' => \$minage, + 'search=s' => \$search, + 'search1=s' => \$mysync->{ search1 }, + 'search2=s' => \$mysync->{ search2 }, + 'foldersizes!' => \$mysync->{ foldersizes }, + 'foldersizesatend!' => \$mysync->{ foldersizesatend }, 'dry!' => \$mysync->{dry}, 'expunge1|expunge!' => \$mysync->{ expunge1 }, 'expunge2!' => \$mysync->{ expunge2 }, @@ -15579,8 +17049,15 @@ sub testsdebug } note( 'Entering testsdebug()' ) ; - ok( ( ( not -d 'W/tmp/tests' ) or rmtree( 'W/tmp/tests/' ) ), 'testsdebug: rmtree W/tmp/tests' ) ; - tests_check_binary_embed_all_dyn_libs( ) ; + #ok( ( ( not -d 'W/tmp/tests' ) or rmtree( 'W/tmp/tests/' ) ), 'testsdebug: rmtree W/tmp/tests' ) ; + #tests_check_binary_embed_all_dyn_libs( ) ; + #tests_killpid_by_parent( ) ; + #tests_killpid_by_brother( ) ; + #tests_kill_zero( ) ; + #tests_connect_socket( ) ; + tests_probe_imapssl( ) ; + #tests_always_fail( ) ; + note( 'Leaving testsdebug()' ) ; done_testing( ) ; } @@ -15645,6 +17122,7 @@ sub tests tests_sleep_max_bytes( ) ; tests_logfile( ) ; tests_setlogfile( ) ; + tests_jux_utf8_old( ) ; tests_jux_utf8( ) ; tests_pipemess( ) ; tests_jux_utf8_list( ) ; @@ -15693,16 +17171,13 @@ sub tests tests_umask_str( ) ; tests_set_umask( ) ; tests_createhashfileifneeded( ) ; - tests_move_slash( ) ; + tests_slash_to_underscore( ) ; tests_testsunit( ) ; tests_count_0s( ) ; tests_report_failures( ) ; tests_min( ) ; - #tests_resolv( ) ; + #tests_connect_socket( ) ; #tests_resolvrev( ) ; - tests_connect_socket( ) ; - tests_probe_imapssl( ) ; - tests_mailimapclient_connect( ) ; tests_usage( ) ; tests_version_from_rcs( ) ; tests_backslash_caret( ) ; @@ -15748,9 +17223,26 @@ sub tests tests_nthline( ) ; tests_secondline( ) ; tests_tail( ) ; - #tests_always_fail( ) ; - done_testing( 1441 ) ; - note( 'Leaving tests()' ) ; + tests_truncmess( ) ; + tests_eta( ) ; + tests_timesince( ) ; + tests_timenext( ) ; + tests_foldersize( ) ; + tests_imapsync_context( ) ; + tests_abort( ) ; + tests_probe_imapssl( ) ; + tests_mailimapclient_connect( ) ; + #tests_resolv( ) ; + + # Those three are for later use, when webserver will be inside imapsync + # or will be deleted them if I abandon the project. + #tests_killpid_by_parent( ) ; + #tests_killpid_by_brother( ) ; + #tests_kill_zero( ) ; + + #tests_always_fail( ) ; + done_testing( 1496 ) ; + note( 'Leaving tests()' ) ; } return ; } @@ -15759,7 +17251,7 @@ sub tests_template { note( 'Entering tests_template()' ) ; - is( undef, undef, 'template: undef is undef' ) ; + is( undef, undef, 'template: no args => undef' ) ; is_deeply( {}, {}, 'template: a hash is a hash' ) ; is_deeply( [], [], 'template: an array is an array' ) ; note( 'Leaving tests_template()' ) ; @@ -15767,5 +17259,3 @@ sub tests_template } - -