diff --git a/.gitignore b/.gitignore index 0d081fc4..69c24f9e 100644 --- a/.gitignore +++ b/.gitignore @@ -17,8 +17,9 @@ data/conf/rspamd/local.d/* data/conf/rspamd/override.d/* !data/conf/nginx/dynmaps.conf !data/conf/nginx/site.conf +!data/conf/nginx/meta_exporter.conf data/conf/nginx/*.conf data/conf/nginx/*.custom data/conf/nginx/*.bak data/conf/dovecot/extra.conf -data/conf/rspamd/custom/* +data/conf/rspamd/override.d/worker-controller-password.inc diff --git a/.travis.yml b/.travis.yml index e07dde21..c7614088 100644 --- a/.travis.yml +++ b/.travis.yml @@ -9,7 +9,7 @@ script: - docker-compose push branches: only: - - dev + - master env: global: - secure: MpxpTwD7f0CNEVLitSpVmocK7O9r+BwFE1deEHK4AlQo/oc9cOlhGe1EL3mx9zbglPmjlDg/8kMUGv6vSirIabfBo9Szjps76bHckFr9lr2Ykkg0e29oC8pgPpSXD1eY/1ZIN/FvIkxpUFLETo1okS/j9q/A0DCGFmti0n3EoMORsgRz9CpNAiEh0zpSd6+euPAGHuczuCrDuO84my9bIOCjA/+aPunHNeXiuM8yIM2SxCSyGtIKT0+jvquIvLF58VxivysXBlRfhDn8fhB09nXA2Ru/derYQACfcmNSn9Pd4bDpebPJW5B9H/XA8xjb58uKinUlncbAMB/QnxoT75j9YRWJZRSQ+34XNYP6ZgK9soZ2TC6djQyEKTUu45Kp/1s+poSn42m9jytJJTmmK0KxsZTRcC8JD5nrjIMZWPUNNTwC5L4+I7ZRWg2WooK3LNyq1Ng8Hn6W77wSgsvAJw2HD3Lx58AprGUhHuBeaIZRuSN9aKwZrl9vKQJLqPnOp/nF2EC6kot5HYYtcotGtETXPUDih21gWD5ZM2BqVqYfQQnJnNMgeYmMdj6QQuTFqhuNJf7hXRIRkTnD3j1gDOLKQZazW0+N2JE8XWDFwi6fKScDsxT85lJti9HmzHa7+k4RVHmUYuDgRoPuzUgjWHvPsiz3/Z8WQ9JYpH84S8w= diff --git a/data/Dockerfiles/acme/Dockerfile b/data/Dockerfiles/acme/Dockerfile index 44e7030b..5c99cbf9 100644 --- a/data/Dockerfiles/acme/Dockerfile +++ b/data/Dockerfiles/acme/Dockerfile @@ -3,20 +3,21 @@ FROM alpine:3.6 LABEL maintainer "Andre Peters " RUN apk add --update --no-cache \ - bash \ - curl \ - openssl \ - bind-tools \ - jq \ + bash \ + curl \ + openssl \ + bind-tools \ + jq \ libressl-dev \ libbsd-dev \ libseccomp-dev \ - mariadb-client \ + mariadb-client \ tini \ make \ gcc \ libressl \ libc-dev \ + redis \ linux-headers \ ca-certificates \ && curl -s https://kristaps.bsd.lv/acme-client/snapshots/acme-client-portable.tgz | tar xfvz - \ diff --git a/data/Dockerfiles/acme/docker-entrypoint.sh b/data/Dockerfiles/acme/docker-entrypoint.sh index d29d812e..8d910e5d 100755 --- a/data/Dockerfiles/acme/docker-entrypoint.sh +++ b/data/Dockerfiles/acme/docker-entrypoint.sh @@ -2,16 +2,30 @@ set -o pipefail exec 5>&1 +log_f() { + if [[ ${2} == "no_nl" ]]; then + echo -n "$(date) - ${1}" + elif [[ ${2} == "no_date" ]]; then + echo "${1}" + elif [[ ${2} != "redis_only" ]]; then + echo "$(date) - ${1}" + fi + redis-cli -h redis LPUSH ACME_LOG "{\"time\":\"$(date +%s)\",\"message\":\"$(printf '%s' "${1}" | \ + tr '%&;$"_[]{}-\r\n' ' ')\"}" > /dev/null + redis-cli -h redis LTRIM ACME_LOG 0 9999 > /dev/null +} + if [[ "${SKIP_LETS_ENCRYPT}" =~ ^([yY][eE][sS]|[yY])+$ ]]; then log_f "SKIP_LETS_ENCRYPT=y, skipping Let's Encrypt..." sleep 365d exec $(readlink -f "$0") fi -echo "Waiting for Docker API..." +log_f "Waiting for Docker API..." no_nl until ping dockerapi -c1 > /dev/null; do sleep 1 done +log_f "Found Docker API" no_date ACME_BASE=/var/lib/acme SSL_EXAMPLE=/var/lib/ssl-example @@ -20,21 +34,12 @@ mkdir -p ${ACME_BASE}/acme/private restart_containers(){ for container in $*; do - echo "Restarting ${container}..." - curl -X POST http://dockerapi:8080/containers/${container}/restart + log_f "Restarting ${container}..." no_nl + C_REST_OUT=$(curl -X POST http://dockerapi:8080/containers/${container}/restart | jq -r '.msg') + log_f "${C_REST_OUT}" no_date done } -log_f() { - if [[ ${2} == "no_nl" ]]; then - echo -n "$(date) - ${1}" - elif [[ ${2} == "no_date" ]]; then - echo "${1}" - else - echo "$(date) - ${1}" - fi -} - array_diff() { # https://stackoverflow.com/questions/2312762, Alex Offshore eval local ARR1=\(\"\${$2[@]}\"\) @@ -127,12 +132,13 @@ while true; do # Container ids may have changed CONTAINERS_RESTART=($(curl --silent http://dockerapi:8080/containers/json | jq -r '.[] | {name: .Config.Labels["com.docker.compose.service"], id: .Id}' | jq -rc 'select( .name | tostring | contains("nginx-mailcow") or contains("postfix-mailcow") or contains("dovecot-mailcow")) | .id' | tr "\n" " ")) - log_f "Waiting for domain tables... " no_nl + log_f "Waiting for domain table... " no_nl while [[ -z ${DOMAIN_TABLE} ]]; do + curl --silent http://nginx/ >/dev/null 2>&1 DOMAIN_TABLE=$(mysql -h mysql-mailcow -u ${DBUSER} -p${DBPASS} ${DBNAME} -e "SHOW TABLES LIKE 'domain'" -Bs) [[ -z ${DOMAIN_TABLE} ]] && sleep 10 done - log_f "OK" no_date + log_f "Found domain tables." no_date while read domains; do SQL_DOMAIN_ARR+=("${domains}") @@ -226,6 +232,7 @@ while true; do case "$?" in 0) # new certs + log_f "${ACME_RESPONSE}" redis_only # cp the new certificates and keys cp ${ACME_BASE}/acme/fullchain.pem ${ACME_BASE}/cert.pem cp ${ACME_BASE}/acme/private/privkey.pem ${ACME_BASE}/key.pem @@ -239,6 +246,7 @@ while true; do restart_containers ${CONTAINERS_RESTART[*]} ;; 1) # failure + log_f "${ACME_RESPONSE}" redis_only if [[ $ACME_RESPONSE =~ "No registration exists" ]]; then log_f "Registration keys are invalid, deleting old keys and restarting..." rm ${ACME_BASE}/acme/private/account.key @@ -268,6 +276,7 @@ while true; do exec $(readlink -f "$0") ;; 2) # no change + log_f "${ACME_RESPONSE}" redis_only if ! diff ${ACME_BASE}/acme/fullchain.pem ${ACME_BASE}/cert.pem; then log_f "Certificate was not changed, but active certificate does not match the verified certificate, fixing and restarting containers..." cp ${ACME_BASE}/acme/fullchain.pem ${ACME_BASE}/cert.pem @@ -280,9 +289,11 @@ while true; do cp ${ACME_BASE}/acme/private/privkey.pem ${ACME_BASE}/key.pem TRIGGER_RESTART=1 fi + log_f "Certificate was not changed" [[ ${TRIGGER_RESTART} == 1 ]] && restart_containers ${CONTAINERS_RESTART[*]} ;; *) # unspecified + log_f "${ACME_RESPONSE}" redis_only if [[ -f ${ACME_BASE}/acme/private/${DATE}.bak/fullchain.pem ]] && [[ -f ${ACME_BASE}/acme/private/${DATE}.bak/privkey.pem ]]; then log_f "Error requesting certificate, restoring previous certificate from backup and restarting containers...." cp ${ACME_BASE}/acme/private/${DATE}.bak/fullchain.pem ${ACME_BASE}/cert.pem diff --git a/data/Dockerfiles/dockerapi/server.py b/data/Dockerfiles/dockerapi/server.py index b406b5ee..25969681 100644 --- a/data/Dockerfiles/dockerapi/server.py +++ b/data/Dockerfiles/dockerapi/server.py @@ -6,8 +6,11 @@ from threading import Thread import docker import signal import time +import os +import re +import sys -docker_client = docker.DockerClient(base_url='unix://var/run/docker.sock') +docker_client = docker.DockerClient(base_url='unix://var/run/docker.sock', version='auto') app = Flask(__name__) api = Api(app) @@ -76,6 +79,18 @@ class container_post(Resource): return container.exec_run(["/bin/bash", "-c", "/usr/local/bin/doveadm sieve get -u '" + request.json['username'].replace("'", "'\\''") + "' '" + request.json['script_name'].replace("'", "'\\''") + "'"], user='vmail') except Exception as e: return jsonify(type='danger', msg=e) + elif request.json['cmd'] == 'worker_password' and request.json['raw']: + try: + for container in docker_client.containers.list(filters={"id": container_id}): + hash = container.exec_run(["/bin/bash", "-c", "/usr/bin/rspamadm pw -e -p '" + request.json['raw'].replace("'", "'\\''") + "'"], user='_rspamd') + f = open("/access.inc", "w") + f.write('enable_password = "' + re.sub('[^0-9a-zA-Z\$]+', '', hash.rstrip()) + '";\n') + f.close() + container.restart() + return jsonify(type='success', msg='command completed successfully') + except Exception as e: + return jsonify(type='danger', msg=e) + else: return jsonify(type='danger', msg='Unknown command') @@ -95,7 +110,7 @@ class GracefulKiller: self.kill_now = True def startFlaskAPI(): - app.run(debug=False, host='0.0.0.0', port='8080', threaded=True) + app.run(debug=False, host='0.0.0.0', port=8080, threaded=True) api.add_resource(containers_get, '/containers/json') api.add_resource(container_get, '/containers//json') @@ -111,3 +126,4 @@ if __name__ == '__main__': if killer.kill_now: break print "Stopping dockerapi-mailcow" + diff --git a/data/Dockerfiles/dovecot/Dockerfile b/data/Dockerfiles/dovecot/Dockerfile index d2cdd0e3..1da6678a 100644 --- a/data/Dockerfiles/dovecot/Dockerfile +++ b/data/Dockerfiles/dovecot/Dockerfile @@ -14,6 +14,16 @@ RUN apt-get update && apt-get -y install \ cpanminus \ curl \ default-libmysqlclient-dev \ + libjson-webtoken-perl \ + libcgi-pm-perl \ + libcrypt-openssl-rsa-perl \ + libdata-uniqid-perl \ + libhtml-parser-perl \ + libmail-imapclient-perl \ + libparse-recdescent-perl \ + libsys-meminfo-perl \ + libtest-mockobject-perl \ + libwww-perl \ libauthen-ntlm-perl \ libbz2-dev \ libcrypt-ssleay-perl \ diff --git a/data/Dockerfiles/dovecot/imapsync b/data/Dockerfiles/dovecot/imapsync index 8df547c6..c31abb18 100755 --- a/data/Dockerfiles/dovecot/imapsync +++ b/data/Dockerfiles/dovecot/imapsync @@ -1,6 +1,6 @@ #!/usr/bin/perl -# $Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ +# $Id: imapsync,v 1.836 2017/09/05 16:14:53 gilles Exp gilles $ # structure # pod documentation # pragmas @@ -11,7 +11,7 @@ # folder loop # subroutines # sub usage { -# IMAPClient 3.xx ads + # pod documentation @@ -19,15 +19,15 @@ =head1 NAME -imapsync - Email IMAP tool for syncing, copying and migrating email mailboxes. +imapsync - Email IMAP tool for syncing, copying and migrating +email mailboxes between two imap servers, one way, +and without duplicates. -The imapsync command synchronises mailboxes between two imap servers. -More than 69 different IMAP server softwares supported with success, -few failures. +=head1 VERSION -$Revision: 1.727 $ +This documentation refers to Imapsync $Revision: 1.836 $ -=head1 SYNOPSIS +=head1 USAGE To synchronize the source imap account "test1" on server "test1.lamiral.info" with password "secret1" @@ -39,12 +39,547 @@ $Revision: 1.727 $ --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ --host2 test2.lamiral.info --user2 test2 --password2 secret2 -=head1 REQUIRED ARGUMENTS +=head1 DESCRIPTION -The required argmuments are the six values, three on each sides, -needed to login into the IMAP servers, +We sometimes need to transfer mailboxes from one imap server to +another. + +Imapsync command is a tool allowing incremental and +recursive imap transfers from one mailbox to another. + +By default all folders are transferred, recursively, meaning +the whole folder hierarchy is taken, all messages in them, +and all messages flags (\Seen \Answered \Flagged etc.) +are synced too. + +Imapsync reduces the amount +of data transferred by not transferring a given message +if it resides already on both sides. Same specific headers +and the transfer is done only once (by default it's +"Message-Id:" and "Received:" lines but it can be changed with +--useheader option). + +All flags are preserved, unread will stay unread, read will stay read, +deleted will stay deleted. + +You can stop the transfer at any +time and restart it later, imapsync works well with bad +connections and interruptions. + +You can decide to delete the messages from the source mailbox +after a successful transfer, it can be a good feature when migrating +live mailboxes since messages will be only on one side. +In that case, use the --delete1 option. Option --delete1 implies +also option --expunge1 so all messages marked deleted on host1 +will be really deleted. + +A different scenario is synchronizing a mailbox B from another mailbox A +in case you just want to keep a "live" copy of A in B. +In that case --delete2 has to be used, it deletes messages in host2 +folder B that are not in host1 folder A. If you also need to destroy +host2 folders that are not in host1 then use --delete2folders (see also +--delete2foldersonly and --delete2foldersbutnot). + +Imapsync is not adequate for maintaining two active imap accounts +in synchronization when the user plays independently on both sides. +Use offlineimap (written by John Goerzen) or mbsync (written by +Michael R. Elkins) for a 2 ways synchronization. + + +=head1 OPTIONS + + usage: imapsync [options] + +Mandatory options are the six values, three on each sides, +needed to log in into the IMAP servers, ie, a host, a username, and a password, two times. +Conventions used: + + str means string + int means integer + reg means regular expression + cmd means command + + --dry : Makes imapsync doing nothing for real, just print what + would be done without --dry. + +=head2 OPTIONS/credentials + + + --host1 str : Source or "from" imap server. Mandatory. + --port1 int : Port to connect on host1. Default is 143, 993 if --ssl1 + --user1 str : User to login on host1. Mandatory. + --password1 str : Password for the user1. + --host2 str : "destination" imap server. Mandatory. + --port2 int : Port to connect on host2. Default is 143, 993 if --ssl2 + --user2 str : User to login on host2. Mandatory. + --password2 str : Password for the user2. + + --showpasswords : Shows passwords on output instead of "MASKED". + Useful to restart a complete run by just reading the log, + or to debug passwords. It's not a secure practice. + + --passfile1 str : Password file for the user1. It must contain the + password on the first line. This option avoids to show + the password on the command line like --password1 does. + --passfile2 str : Password file for the user2. Contains the password. + +=head2 OPTIONS/encryption + + --nossl1 : Do not use a SSL connection on host1. + --ssl1 : Use a SSL connection on host1. On by default if possible. + --nossl2 : Do not use a SSL connection on host2. + --ssl2 : Use a SSL connection on host2. On by default if possible. + --notls1 : Do not use a TLS connection on host1. + --tls1 : Use a TLS connection on host1. On by default if possible. + --notls2 : Do not use a TLS connection on host2. + --tls2 : Use a TLS connection on host2. On by default if possible. + --debugssl int : SSL debug mode from 0 to 4. + --sslargs1 str : Pass any ssl parameter for host1 ssl or tls connection. Example: + --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3 + See all possibilities in the new() method of IO::Socket::SSL + http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods + --sslargs2 str : Pass any ssl parameter for host2 ssl or tls connection. + See --sslargs1 + + --timeout1 int : Connection timeout in seconds for host1. + Default is 120 and 0 means no timeout at all. + --timeout2 int : Connection timeout in seconds for host2. + Default is 120 and 0 means no timeout at all. + + +=head2 OPTIONS/authentication + + --authmech1 str : Auth mechanism to use with host1: + PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. + --authmech2 str : Auth mechanism to use with host2. See --authmech1 + + --authuser1 str : User to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. + --authuser2 str : User to auth with on host2 (admin user). + --proxyauth1 : Use proxyauth on host1. Requires --authuser1. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user. + --proxyauth2 : Use proxyauth on host2. Requires --authuser2. + + --authmd51 : Use MD5 authentication for host1. + --authmd52 : Use MD5 authentication for host2. + --domain1 str : Domain on host1 (NTLM authentication). + --domain2 str : Domain on host2 (NTLM authentication). + + +=head2 OPTIONS/folders + + + --folder str : Sync this folder. + --folder str : and this one, etc. + --folderrec str : Sync this folder recursively. + --folderrec str : and this one, etc. + + --folderfirst str : Sync this folder first. --folderfirst "Work" + --folderfirst str : then this one, etc. + --folderlast str : Sync this folder last. --folderlast "[Gmail]/All Mail" + --folderlast str : then this one, etc. + + --nomixfolders : Do not merge folders when host1 is case-sensitive + while host2 is not (like Exchange). Only the first + similar folder is synced (ex: Sent SENT sent -> Sent). + + --skipemptyfolders : Empty host1 folders are not created on host2. + + --include reg : Sync folders matching this regular expression + --include reg : or this one, etc. + If both --include --exclude options are used, then + include is done before. + --exclude reg : Skips folders matching this regular expression + Several folders to avoid: + --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. + --exclude reg : or this one, etc. + + --subfolder2 str : Move whole host1 folders hierarchy under this + host2 folder str . + It does it by adding two --regextrans2 options before + all others. Add --debug to see what's really going on. + + --automap : guesses folders mapping, for folders like + "Sent", "Junk", "Drafts", "All", "Archive", "Flagged". + --f1f2 str1=str2 : Force folder str1 to be synced to str2, + --f1f2 overrides --automap and --regextrans2. + + --nomixfolders : Avoid merging folders that are considered different on + host1 but the same on destination host2 because of + case sensitivities and insensitivities. + + --subscribed : Transfers subscribed folders. + --subscribe : Subscribe to the folders transferred on the + host2 that are subscribed on host1. On by default. + --subscribeall : Subscribe to the folders transferred on the + host2 even if they are not subscribed on host1. + + --prefix1 str : Remove prefix str to all destination folders, + usually INBOX. or INBOX/ or an empty string "". + imapsync guesses the prefix if host1 imap server + does not have NAMESPACE capability. This option + should not be used, most of the time. + --prefix2 str : Add prefix to all host2 folders. See --prefix1 + --sep1 str : Host1 separator in case NAMESPACE is not supported. + --sep2 str : Host2 separator in case NAMESPACE is not supported. + + --regextrans2 reg : Apply the whole regex to each destination folders. + --regextrans2 reg : and this one. etc. + When you play with the --regextrans2 option, first + add also the safe options --dry --justfolders + Then, when happy, remove --dry, remove --justfolders. + Have in mind that --regextrans2 is applied after prefix + and separator inversion. For examples see + http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt + +=head2 OPTIONS/folders sizes + + --nofoldersizes : Do not calculate the size of each folder at the + beginning of the sync. Default is to calculate them. + --nofoldersizesatend: Do not calculate the size of each folder at the + end of the sync. Default is to calculate them. + --justfoldersizes : Exit after having printed the initial folder sizes. + + +=head2 OPTIONS/tmp + + + --tmpdir str : Where to store temporary files and subdirectories. + Will be created if it doesn't exist. + Default is system specific, Unix is /tmp but + /tmp is often too small and deleted at reboot. + --tmpdir /var/tmp should be better. + --pidfile str : The file where imapsync pid is written, + it can be dirname/filename. + Default name is imapsync.pid in tmpdir. + --pidfilelocking : Abort if pidfile already exists. Useful to avoid + concurrent transfers on the same mailbox. + + +=head2 OPTIONS/log + + --nolog : Turn off logging on file + --logfile str : Change the default log filename (can be dirname/filename). + --logdir str : Change the default log directory. Default is LOG_imapsync/ + + +=head2 OPTIONS/messages + + --skipmess reg : Skips messages matching the regex. + Example: 'm/[\x80-ff]/' # to avoid 8bits messages. + --skipmess is applied before --regexmess + --skipmess reg : or this one, etc. + + --pipemess cmd : Apply this cmd command to each message content + before the copy. + --pipemess cmd : and this one, etc. + + --disarmreadreceipts : Disarms read receipts (host2 Exchange issue) + + --regexmess reg : Apply the whole regex to each message before transfer. + Example: 's/\000/ /g' # to replace null by space. + --regexmess reg : and this one, etc. + + +=head2 OPTIONS/flags + + --regexflag reg : Apply the whole regex to each flags list. + Example: 's/"Junk"//g' # to remove "Junk" flag. + --regexflag reg : then this one, etc. + + +=head2 OPTIONS/deletions + + --delete1 : Deletes messages on host1 server after a successful + transfer. Option --delete1 has the following behavior: + it marks messages as deleted with the IMAP flag + \Deleted, then messages are really deleted with an + EXPUNGE IMAP command. If expunging after each message + slows down too much the sync then use + --noexpungeaftereach to speed up. + --expunge1 : Expunge messages on host1 just before syncing a folder. + Expunge is done per folder. + Expunge aims is to really delete messages marked deleted. + An expunge is also done after each message copied + if option --delete1 is set. + --noexpunge1 : Do not expunge messages on host1. + --delete1emptyfolders : Deletes empty folders on host1, INBOX excepted. + Useful with --delete1 since what remains on host1 + is only what failed to be synced. + + --delete2 : Delete messages in host2 that are not in + host1 server. Useful for backup or pre-sync. + --delete2duplicates : Delete messages in host2 that are duplicates. + Works only without --useuid since duplicates are + detected with an header part of each message. + + --delete2folders : Delete folders in host2 that are not in host1 server. + For safety, first try it like this (it is safe): + --delete2folders --dry --justfolders --nofoldersizes + --delete2foldersonly reg : Deleted only folders matching regex. + Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" + --delete2foldersbutnot reg : Do not delete folders matching regex. + Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" + + --expunge2 : Expunge messages on host2 after messages transfer. + --uidexpunge2 : uidexpunge messages on the host2 account + that are not on the host1 account, requires --delete2 + + +=head2 OPTIONS/dates + + --syncinternaldates : Sets the internal dates on host2 same as host1. + Turned on by default. Internal date is the date + a message arrived on a host (mtime). + --idatefromheader : Sets the internal dates on host2 same as the + "Date:" headers. + + +=head2 OPTIONS/message selection + + --maxsize int : Skip messages larger (or equal) than int bytes + --minsize int : Skip messages smaller (or equal) than int bytes + --maxage int : Skip messages older than int days. + final stats (skipped) don't count older messages + see also --minage + --minage int : Skip messages newer than int days. + final stats (skipped) don't count newer messages + You can do (+ are the messages selected): + past|----maxage+++++++++++++++>now + past|+++++++++++++++minage---->now + past|----maxage+++++minage---->now (intersection) + past|++++minage-----maxage++++>now (union) + + --search str : Selects only messages returned by this IMAP SEARCH + command. Applied on both sides. + --search1 str : Same as --search for selecting host1 messages only. + --search2 str : Same as --search for selecting host2 messages only. + --search CRIT equals --search1 CRIT --search2 CRIT + + --maxlinelength int : skip messages with a line length longer than int bytes. + RFC 2822 says it must be no more than 1000 bytes. + + + --useheader str : Use this header to compare messages on both sides. + Ex: Message-ID or Subject or Date. + --useheader str and this one, etc. + + --usecache : Use cache to speed up the sync. + --nousecache : Do not use cache. Caveat: --useuid --nousecache creates + duplicates on multiple runs. + --useuid : Use uid instead of header as a criterium to recognize + messages. Option --usecache is then implied unless + --nousecache is used. + + +=head2 OPTIONS/miscelaneous + + --syncacls : Synchronizes acls (Access Control Lists). + --nosyncacls : Does not synchronize acls. This is the default. + Acls in IMAP are not standardized, be careful. + + + +=head2 OPTIONS/debugging + + --debug : Debug mode. + --debugfolders : Debug mode for the folders part only. + --debugcontent : Debug content of the messages transferred. Huge output. + --debugflags : Debug mode for flags. + --debugimap1 : IMAP debug mode for host1. Very verbose. + --debugimap2 : IMAP debug mode for host2. Very verbose. + --debugimap : IMAP debug mode for host1 and host2. + --debugmemory : Debug mode showing memory consumption after each copy. + + --errorsmax int : Exit when int number of errors is reached. Default is 50. + + --tests : Run local non-regression tests. Exit code 0 means all ok. + --testslive : Run a live test with test1.lamiral.info imap server. + Useful to check the basics. Needs internet connexion. + --testslive6 : Run a live test with ks2ipv6.lamiral.info imap server. + Useful to check the ipv6 connectivity. Needs internet. + + +=head2 OPTIONS/specific + + --gmail1 : sets --host1 to Gmail and options from FAQ.Gmail.txt + --gmail2 : sets --host2 to Gmail and options from FAQ.Gmail.txt + + --office1 : sets --host1 to Office365 options from FAQ.Exchange.txt + --office2 : sets --host2 to Office365 options from FAQ.Exchange.txt + + --exchange1 : sets options from FAQ.Exchange.txt, account1 part + --exchange2 : sets options from FAQ.Exchange.txt, account2 part + + --domino1 : sets options from FAQ.Domino.txt, account1 part + --domino2 : sets options from FAQ.Domino.txt, account2 part + + + + +=head2 OPTIONS/behavior + + --maxmessagespersecond int : limits the number of messages transferred per second. + + --maxbytespersecond int : limits the average transfer rate per second. + --maxbytesafter int : starts --maxbytespersecond limitation only after + --maxbytesafter amount of data transferred. + + --maxsleep int : do not sleep more than int seconds. + On by default, 2 seconds max, like --maxsleep 2 + + --abort : terminates a previous call still running. + It uses the pidfile to know what processus to abort. + + --exitwhenover int : Stop syncing when total bytes transferred reached. + + --version : Print only software version. + --noreleasecheck : Do not check for new imapsync release (a http request). + --releasecheck : Check for new imapsync release (a http request). + --noid : Do not send/receive ID command to imap servers. + --justconnect : Just connect to both servers and print useful + information. Need only --host1 and --host2 options. + --justlogin : Just login to both host1 and host2 with users + credentials, then exit. + --justfolders : Do only things about folders (ignore messages). + + --help : print this help. + + Example: to synchronize imap account "test1" on "test1.lamiral.info" + to imap account "test2" on "test2.lamiral.info" + with test1 password "secret1" + and test2 password "secret2" + + imapsync \ + --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ + --host2 test2.lamiral.info --user2 test2 --password2 secret2 + + +=cut +# comment + +=pod + + + +=head1 SECURITY + +You can use --passfile1 instead of --password1 to give the +password since it is safer. With --password1 option any user +on your host can see the password by using the 'ps auxwwww' +command. Using a variable (like $PASSWORD1) is also +dangerous because of the 'ps auxwwwwe' command. So, saving +the password in a well protected file (600 or rw-------) is +the best solution. + +Imapsync activates ssl or tls encryption by default, if possible. +What details are under this "if possible"? +Imapsync activates ssl if the well known port imaps port (993) is open +on the imap servers. If the imaps port is closed then it open a +normal (clear) connection on port 143 but it looks for TLS support +in the CAPABILITY list of the servers. If TLS is supported +then imapsync goes to encryption. + +If the automatic ssl/tls detection fails then imapsync will +not protect against sniffing activities on the +network, especially for passwords. + +See also the document FAQ.Security.txt in the FAQ.d/ directory +or at https://imapsync.lamiral.info/FAQ.d/FAQ.Security.txt + +=head1 EXIT STATUS + +Imapsync will exit with a 0 status (return code) if everything went good. +Otherwise, it exits with a non-zero status. + + + +=head1 LICENSE AND COPYRIGHT + +Imapsync is free, open, public but not always gratis software +cover by the NOLIMIT Public License. +See the LICENSE file included in the distribution or just read this +simple sentence as it IS the licence text: + + "No limit to do anything with this work and this license." + +In case it is not long enough, I repeat: + + "No limit to do anything with this work and this license." + +https://imapsync.lamiral.info/LICENSE + +=head1 AUTHOR + +Gilles LAMIRAL + +Feedback good or bad is very often welcome. + +Gilles LAMIRAL earns his living by writing, installing, +configuring and teaching free, open and often gratis +software. Imapsync used to be "always gratis" but now it is +only "often gratis" because imapsync is sold by its author, +a good way to maintain and support free open public +software over decades. + +=head1 BUGS AND LIMITATIONS + +See https://imapsync.lamiral.info/FAQ.d/FAQ.Reporting_Bugs.txt + +=head1 IMAP SERVERS supported + +See https://imapsync.lamiral.info/S/imapservers.shtml + +=head1 HUGE MIGRATION + +Pay special attention to options +--subscribed +--subscribe +--delete1 +--delete2 +--delete2folders +--maxage +--minage +--maxsize +--useuid +--usecache + +If you have many mailboxes to migrate think about a little +shell program. Write a file called file.txt (for example) +containing users and passwords. +The separator used in this example is ';' + +The file.txt file contains: + +user001_1;password001_1;user001_2;password001_2 +user002_1;password002_1;user002_2;password002_2 +user003_1;password003_1;user003_2;password003_2 +user004_1;password004_1;user004_2;password004_2 +user005_1;password005_1;user005_2;password005_2 +... + +On Unix the shell program can be: + + { while IFS=';' read u1 p1 u2 p2; do + imapsync --host1 imap.side1.org --user1 "$u1" --password1 "$p1" \ + --host2 imap.side2.org --user2 "$u2" --password2 "$p2" ... + done ; } < file.txt + +On Windows the batch program can be: + + FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO imapsync ^ + --host1 imap.side1.org --user1 %%G --password1 %%H ^ + --host2 imap.side2.org --user2 %%I --password2 %%J ... + +The ... have to be replaced by nothing or any imapsync option. +Welcome in shell or batch programming ! + +You will find already written scripts at +http://imapsync.lamiral.info/examples/ + =head1 INSTALL Imapsync works under any Unix with perl. @@ -72,598 +607,14 @@ a host, a username, and a password, two times. =head1 CONFIGURATION There is no specific configuration file for imapsync, -everything is specified by the command line parameteres +everything is specified by the command line parameters and the default behavior. -=head1 USAGE - -To get a description of each option just run imapsync -with no argument, like this: - - imapsync - -This description of options is also available at -http://imapsync.lamiral.info/OPTIONS and is -reproduced here: - - usage: ./imapsync [options] - - Several options are mandatory. - str means string - int means integer - reg means regular expression - cmd means command - - --dry : Makes imapsync doing nothing, just print what would - be done without --dry. - - --host1 str : Source or "from" imap server. Mandatory. - --port1 int : Port to connect on host1. Default is 143, 993 if --ssl1 - --user1 str : User to login on host1. Mandatory. - --showpasswords : Shows passwords on output instead of "MASKED". - Useful to restart a complete run by just reading the log. - --password1 str : Password for the user1. - --host2 str : "destination" imap server. Mandatory. - --port2 int : Port to connect on host2. Default is 143, 993 if --ssl2 - --user2 str : User to login on host2. Mandatory. - --password2 str : Password for the user2. - - --passfile1 str : Password file for the user1. It must contain the - password on the first line. This option avoids to show - the password on the command line like --password1 does. - --passfile2 str : Password file for the user2. Contains the password. - - --ssl1 : Use a SSL connection on host1. - --ssl2 : Use a SSL connection on host2. - --tls1 : Use a TLS connection on host1. - --tls2 : Use a TLS connection on host2. - --debugssl int : SSL debug mode from 0 to 4. - --sslargs1 str : Pass any ssl parameter for host1 ssl or tls connection. Example: - --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3 - See all possibilities in the new() method of IO::Socket::SSL - http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods - --sslargs2 str : Pass any ssl parameter for host2 ssl or tls connection. - See --sslargs1 - - --timeout1 int : Connection timeout in seconds for host1. - Default is 120 and 0 means no timeout at all. - --timeout2 int : Connection timeout in seconds for host2. - Default is 120 and 0 means no timeout at all. - - --authmech1 str : Auth mechanism to use with host1: - PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. - --authmech2 str : Auth mechanism to use with host2. See --authmech1 - - --authuser1 str : User to auth with on host1 (admin user). - Avoid using --authmech1 SOMETHING with --authuser1. - --authuser2 str : User to auth with on host2 (admin user). - --proxyauth1 : Use proxyauth on host1. Requires --authuser1. - Required by Sun/iPlanet/Netscape IMAP servers to - be able to use an administrative user. - --proxyauth2 : Use proxyauth on host2. Requires --authuser2. - - --authmd51 : Use MD5 authentification for host1. - --authmd52 : Use MD5 authentification for host2. - --domain1 str : Domain on host1 (NTLM authentication). - --domain2 str : Domain on host2 (NTLM authentication). - - - --folder str : Sync this folder. - --folder str : and this one, etc. - --folderrec str : Sync this folder recursively. - --folderrec str : and this one, etc. - - --folderfirst str : Sync this folder first. --folderfirst "Work" - --folderfirst str : then this one, etc. - --folderlast str : Sync this folder last. --folderlast "[Gmail]/All Mail" - --folderlast str : then this one, etc. - - --nomixfolders : Do not merge folders when host1 is case sensitive - while host2 is not (like Exchange). Only the first - similar folder is synced (ex: Sent SENT sent -> Sent). - - --skipemptyfolders : Empty host1 folders are not created on host2. - - --f1f2 str1=str2 : Force folder str1 to be synced to str2. - --include reg : Sync folders matching this regular expression - --include reg : or this one, etc. - in case both --include --exclude options are - use, include is done before. - --exclude reg : Skips folders matching this regular expression - Several folders to avoid: - --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. - --exclude reg : or this one, etc. - - --subfolder2 str : Move whole host1 folders hierarchy under this - host2 folder str . - It does it by adding two --regextrans2 options before - all others. Add --debug to see what's really going on. - - --regextrans2 reg : Apply the whole regex to each destination folders. - --regextrans2 reg : and this one. etc. - When you play with the --regextrans2 option, first - add also the safe options --dry --justfolders - Then, when happy, remove --dry, remove --justfolders. - Have in mind that --regextrans2 is applied after prefix - and separator inversion. - - --tmpdir str : Where to store temporary files and subdirectories. - Will be created if it doesn't exist. - Default is system specific, Unix is /tmp but - it's often small and deleted at reboot. - --tmpdir /var/tmp should be better. - --pidfile str : The file where imapsync pid is written. - --pidfilelocking : Abort if pidfile already exists. Usefull to avoid - concurrent transfers on the same mailbox. - - --nolog : Turn off logging on file - --logfile str : Change the default log filename (can be dirname/filename). - --logdir str : Change the default log directory. Default is LOG_imapsync - - --prefix1 str : Remove prefix to all destination folders - (usually INBOX. or INBOX/ or an empty string "") - you have to use --prefix1 if host1 imap server - does not have NAMESPACE capability, so imapsync - suggests to use it. All other cases are bad. - --prefix2 str : Add prefix to all host2 folders. See --prefix1 - --sep1 str : Host1 separator in case NAMESPACE is not supported. - --sep2 str : Host2 separator in case NAMESPACE is not supported. - - --skipmess reg : Skips messages maching the regex. - Example: 'm/[\x80-ff]/' # to avoid 8bits messages. - --skipmess is applied before --regexmess - --skipmess reg : or this one, etc. - - --pipemess cmd : Apply this cmd command to each message content - before the copy. - --pipemess cmd : and this one, etc. - - --disarmreadreceipts : Disarms read receipts (host2 Exchange issue) - - --regexmess reg : Apply the whole regex to each message before transfer. - Example: 's/\000/ /g' # to replace null by space. - --regexmess reg : and this one, etc. - - --regexflag reg : Apply the whole regex to each flags list. - Example: 's/"Junk"//g' # to remove "Junk" flag. - --regexflag reg : and this one, etc. - - --delete : Deletes messages on host1 server after a successful - transfer. Option --delete has the following behavior: - it marks messages as deleted with the IMAP flag - \Deleted, then messages are really deleted with an - EXPUNGE IMAP command. - - --delete2 : Delete messages in host2 that are not in - host1 server. Useful for backup or pre-sync. - --delete2duplicates : Delete messages in host2 that are duplicates. - Works only without --useuid since duplicates are - detected with an header part of each message. - - --delete2folders : Delete folders in host2 that are not in host1 server. - For safety, first try it like this (it is safe): - --delete2folders --dry --justfolders --nofoldersizes - --delete2foldersonly reg : Deleted only folders matching regex. - Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/" - --delete2foldersbutnot reg : Do not delete folders matching regex. - Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/" - --noexpunge : Do not expunge messages on host1. - Expunge really deletes messages marked deleted. - Expunge is made at the beginning, on host1 only. - Newly transferred messages are also expunged if - option --delete is given. - No expunge is done on host2 account (unless --expunge2) - --expunge1 : Expunge messages on host1 after messages transfer. - --expunge2 : Expunge messages on host2 after messages transfer. - --uidexpunge2 : uidexpunge messages on the host2 account - that are not on the host1 account, requires --delete2 - --nomixfolders : Avoid merging folders that are considered different on - host1 but the same on destination host2 because of - case sensitivities and insensitivities. - - --syncinternaldates : Sets the internal dates on host2 same as host1. - Turned on by default. Internal date is the date - a message arrived on a host (mtime). - --idatefromheader : Sets the internal dates on host2 same as the - "Date:" headers. - - --maxsize int : Skip messages larger (or equal) than int bytes - --minsize int : Skip messages smaller (or equal) than int bytes - --maxage int : Skip messages older than int days. - final stats (skipped) don't count older messages - see also --minage - --minage int : Skip messages newer than int days. - final stats (skipped) don't count newer messages - You can do (+ are the messages selected): - past|----maxage+++++++++++++++>now - past|+++++++++++++++minage---->now - past|----maxage+++++minage---->now (intersection) - past|++++minage-----maxage++++>now (union) - - --search str : Selects only messages returned by this IMAP SEARCH - command. Applied on both sides. - --search1 str : Same as --search for selecting host1 messages only. - --search2 str : Same as --search for selecting host2 messages only. - --search CRIT equals --search1 CRIT --search2 CRIT - - --exitwhenover int : Stop syncing when total bytes transferred reached. - Gmail per day allows - 2500000000 = 2.5 GB downloaded from Gmail as host2 - 500000000 = 500 MB uploaded to Gmail as host1. - - --maxlinelength int : skip messages with a line length longer than int bytes. - RFC 2822 says it must be no more than 1000 bytes. - - --useheader str : Use this header to compare messages on both sides. - Ex: Message-ID or Subject or Date. - --useheader str and this one, etc. - - --subscribed : Transfers subscribed folders. - --subscribe : Subscribe to the folders transferred on the - host2 that are subscribed on host1. On by default. - --subscribeall : Subscribe to the folders transferred on the - host2 even if they are not subscribed on host1. - - --nofoldersizes : Do not calculate the size of each folder in bytes - and message counts. Default is to calculate them. - --nofoldersizesatend: Do not calculate the size of each folder in bytes - and message counts at the end. Default is on. - --justfoldersizes : Exit after having printed the folder sizes. - - --syncacls : Synchronises acls (Access Control Lists). - --nosyncacls : Does not synchronize acls. This is the default. - Acls in IMAP are not standardized, be careful. - - --usecache : Use cache to speedup. - --nousecache : Do not use cache. Caveat: --useuid --nousecache creates - duplicates on multiple runs. - --useuid : Use uid instead of header as a criterium to recognize - messages. Option --usecache is then implied unless - --nousecache is used. - - --debug : Debug mode. - --debugfolders : Debug mode for the folders part only. - --debugcontent : Debug content of the messages transfered. Huge ouput. - --debugflags : Debug mode for flags. - --debugimap1 : IMAP debug mode for host1. Very verbose. - --debugimap2 : IMAP debug mode for host2. Very verbose. - --debugimap : IMAP debug mode for host1 and host2. - --debugmemory : Debug mode showing memory consumption after each copy. - - --errorsmax int : Exit when int number of errors is reached. Default is 50. - - --tests : Run local non-regression tests. Exit code 0 means all ok. - --testslive : Run a live test with test1.lamiral.info imap server. - Useful to check the basics. Needs internet connexion. - - --version : Print only software version. - --noreleasecheck : Do not check for new imapsync release (a http request). - --releasecheck : Check for new imapsync release (a http request). - --noid : Do not send/receive ID command to imap servers. - --justconnect : Just connect to both servers and print useful - information. Need only --host1 and --host2 options. - --justlogin : Just login to both host1 and host2 with users - credentials, then exit. - --justfolders : Do only things about folders (ignore messages). - - --help : print this help. - - Example: - To synchronize the source imap account - "test1" on server "test1.lamiral.info" with password "secret1" - to the destination imap account - "test2" on server "test2.lamiral.info" with password "secret2" - do: - - imapsync \ - --host1 test1.lamiral.info --user1 test1 --password1 secret1 \ - --host2 test2.lamiral.info --user2 test2 --password2 secret2 - -=cut -# comment - -=pod - -=head1 DESCRIPTION - -Imapsync command is a tool allowing incremental and -recursive imap transfers from one mailbox to another. - -By default all folders are transferred, recursively, all -possible flags (\Seen \Answered \Flagged etc.) are synced too. - -We sometimes need to transfer mailboxes from one imap server to -another. This is called migration. - -Imapsync reduces the amount -of data transferred by not transferring a given message -if it resides already on both sides. Same specific headers -and the transfer is done only once; taken into account are by default -Message-Id and Received header lines. -All flags are -preserved, unread will stay unread, read will stay read, -deleted will stay deleted. You can stop the transfer at any -time and restart it later, imapsync works well with bad -connections and interruptions. - -You can decide to delete the messages from the source mailbox -after a successful transfer, it can be a good feature when migrating -live mailboxes since messages will be only on one side. -In that case, use the --delete option. Option --delete implies -also option --expunge so all messages marked deleted on host1 -will be really deleted. -(you can use --noexpunge to avoid this but I don't see any -good real world scenario for the combination --delete --noexpunge). - -A different scenario is synchronizing a mailbox B from another mailbox A -in case you just want to keep a "live" copy of A in B. -In that case --delete2 has to be used, it deletes messages in host2 -folder B that are not in host1 folder A. If you also need to destroy -host2 folders that are not in host1 then use --delete2folders (see also ---delete2foldersonly and --delete2foldersbutnot). - -Imapsync is not adequate for maintaining two active imap accounts -in synchronization when the user plays independently on both sides. -Use offlineimap (written by John Goerzen) or mbsync (written by -Michael R. Elkins) for 2 ways synchronizations. - - -=head1 OPTIONS - -To get a description of each option just invoke: - - imapsync - -or read the previous section named USAGE, - -or read http://imapsync.lamiral.info/OPTIONS - -=head1 HISTORY - -I wrote imapsync because an enterprise (basystemes) paid me to install -a new imap server without losing huge old mailboxes located on a far -away remote imap server accessible by a low bandwidth link. The tool -imapcp (written in python) could not help me because I had to verify -every mailbox was well transferred and delete it after a good -transfer. imapsync started its life as a copy_folder.pl patch. -The tool copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl -module tarball source (in the examples/ directory of the tarball). - -=head1 EXAMPLE - -While working on imapsync parameters please run imapsync in -dry mode (no modification induced) with the --dry -option. Nothing bad can be done this way. - -To synchronize the imap account "buddy" (with password "secret1") -on host "imap.src.fr" to the imap account "max" (with password "secret2") -on host "imap.dest.fr": - - imapsync --host1 imap.src.fr --user1 buddy --password1 secret1 \ - --host2 imap.dest.fr --user2 max --password2 secret2 - -Then you will have max's mailbox updated from buddy's -mailbox. - -=head1 SECURITY - -You can use --passfile1 instead of --password1 to give the -password since it is safer. With --password1 option any user -on your host can see the password by using the 'ps auxwwww' -command. Using a variable (like $PASSWORD1) is also -dangerous because of the 'ps auxwwwwe' command. So, saving -the password in a well protected file (600 or rw-------) is -the best solution. - -imasync is not totally protected against sniffers on the -network since passwords may be transferred in plain text -if CRAM-MD5 is not supported by your imap servers. Use ---ssl1 (or --tls1) and --ssl2 (or --tls2) to enable -encryption on host1 and host2. - -You may authenticate as one user (typically an admin user), -but be authorized as someone else, which means you don't -need to know every user's personal password. Specify ---authuser1 "adminuser" to enable this on host1. In this -case, --authmech1 PLAIN will be used by default since it -is the only way to go for now. So don't use --authmech1 SOMETHING -with --authuser1 "adminuser", it will not work. -Same behavior with the --authuser2 option. -Authenticate with an admin account must be supported by your -imap server to work with imapsync. - -When working on Sun/iPlanet/Netscape IMAP servers you must use ---proxyauth1 to enable administrative user to masquerade as another user. -Can also be used on destination server with --proxyauth2 - -You can authenticate with OAUTH when transfering from Google Apps. -The consumer key will be the domain part of the --user, and the ---password will be used as the consumer secret. It does not work -with Google Apps free edition. - -=head1 EXIT STATUS - -imapsync will exit with a 0 status (return code) if everything went good. -Otherwise, it exits with a non-zero status. - -So if you have an unreliable internet connection, you can use this loop -in a Bourne shell: - - while ! imapsync ...; do - echo imapsync not complete - done - -=head1 LICENSE AND COPYRIGHT - -imapsync is free, open, public but not always gratis software -cover by the NOLIMIT Public License. -See the LICENSE file included in the distribution or just read this -simple sentence as it is the licence text: - - "No limit to do anything with this work and this license." - -In case it is not long enough I repeat: - - "No limit to do anything with this work and this license." - -=head1 MAILING-LIST - -The public mailing-list may be the best way to get free support. - -To write on the mailing-list, the address is: - - -To subscribe, send any message (even empty) to: - -then just reply to the confirmation message. - -To unsubscribe, send a message to: - - -To contact the person in charge for the list: - - -The list archives are available at: -http://www.linux-france.org/prj/imapsync_list/ -So consider that the list is public, anyone -can see your post. Use a pseudonym or do not -post to this list if you want to stay private. - -Thank you for your participation. - -=head1 AUTHOR - -Gilles LAMIRAL - -Feedback good or bad is very often welcome. - -Gilles LAMIRAL earns his living by writing, installing, -configuring and teaching free, open and often gratis -softwares. It used to be "always gratis" but now it is -"often" because imapsync is sold by its author, a good -way to stay maintening and supporting free open public -softwares (see the license) over decades. - -=head1 BUGS AND LIMITATIONS - -Help me to help you: follow the following guidelines. - -Report any bugs or feature requests to the public mailing-list -or to the author. - -Before reporting bugs, read the FAQs, the README and the -TODO files. http://imapsync.lamiral.info/ - -Upgrade to last imapsync release, maybe the bug -is already fixed. - -Upgrade to last Mail-IMAPClient Perl module. -http://search.cpan.org/dist/Mail-IMAPClient/ -maybe the bug is already fixed there. - -Make a good title with word "imapsync" in it (my spam filters won't filter it), -Try to write an email title with more words than just "imapsync" or "problem", -a good title is made of keywords summary, but not too long (one visible line). - -Help us to help you: in your report, please include: - - - imapsync version. - - - output near the first failures, a few lines before is good to get the context - of the issue. First failures messages are often more significant than - the last ones. - - - if the issue is always related to the same messages, include the output - with --debug --debugimap, near the failure point. For example, - Isolate a buggy message or two in a folder 'BUG' and use - - imapsync ... --folder 'BUG' --debug --debugimap - - - imap server softwares on both sides and their version number. - - - imapsync with all the options you use, the full command line - you use (except the passwords of course). - - - IMAPClient.pm version. - - - the run context. Do you run imapsync.exe, a unix binary - or the perl script imapsync. - - - operating system running imapsync. - - - virtual software context (vmware, xen etc.) - - - operating systems on both sides and the third side in case - you run imapsync on a foreign host from the both. - -Most of those values can be found as a copy/paste at the begining of the output, -so a carbon copy of the output is a very easy and very good debug report for me. - -One time in your life, read the paper -"How To Ask Questions The Smart Way" -http://www.catb.org/~esr/faqs/smart-questions.html -and then forget it. - -=head1 IMAP SERVERS - -See http://imapsync.lamiral.info/S/imapservers.shtml - -=head1 HUGE MIGRATION - -Pay special attention to options ---subscribed ---subscribe ---delete ---delete2 ---delete2folders ---maxage ---minage ---maxsize ---useuid ---usecache - -If you have many mailboxes to migrate think about a little -shell program. Write a file called file.txt (for example) -containing users and passwords. -The separator used in this example is ';' - -The file.txt file contains: - -user001_1;password001_1;user001_2;password001_2 -user002_1;password002_1;user002_2;password002_2 -user003_1;password003_1;user003_2;password003_2 -user004_1;password004_1;user004_2;password004_2 -user005_1;password005_1;user005_2;password005_2 -... - -On Unix the shell program can be: - - { while IFS=';' read u1 p1 u2 p2; do - imapsync --host1 imap.side1.org --user1 "$u1" --password1 "$p1" \ - --host2 imap.side2.org --user2 "$u2" --password2 "$p2" ... - done ; } < file.txt - -On Windows the batch program can be: - - FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO imapsync ^ - --host1 imap.side1.org --user1 %%G --password1 %%H ^ - --host2 imap.side2.org --user2 %%I --password2 %%J ... - -The ... have to be replaced by nothing or any imapsync option. -Welcome in shell programming ! - -You will find already written scripts at -http://imapsync.lamiral.info/examples/ - =head1 HACKING Feel free to hack imapsync as the NOLIMIT license permits it. -=head1 LINKS - -Entries for imapsync: -https://web.archive.org/web/20070202005121/http://www.imap.org/products/showall.php =head1 SIMILAR SOFTWARES @@ -686,7 +637,18 @@ https://web.archive.org/web/20070202005121/http://www.imap.org/products/showall. Feedback (good or bad) will often be welcome. -$Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ +=head1 HISTORY + +I wrote imapsync because an enterprise (basystemes) paid me to install +a new imap server without losing huge old mailboxes located in a far +away remote imap server, accessible by a low-bandwidth link. The tool +imapcp (written in python) could not help me because I had to verify +every mailbox was well transferred, and then delete it after a good +transfer. Imapsync started its life as a patch of the copy_folder.pl +script. The script copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl +module tarball source (more precisely in the examples/ directory of the +Mail-IMAPClient tarball). + =cut @@ -695,11 +657,9 @@ $Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ use strict ; use warnings ; -++$| ; - use Carp ; use Data::Dumper ; -use Digest::HMAC_SHA1 qw( hmac_sha1 ) ; +use Digest::HMAC_SHA1 qw( hmac_sha1 hmac_sha1_hex ) ; use Digest::MD5 qw( md5 md5_hex md5_base64 ) ; use English qw( -no_match_vars ) ; use Errno qw(EAGAIN EPIPE ECONNRESET) ; @@ -710,15 +670,18 @@ use File::Glob qw( :glob ) ; use File::Path qw( mkpath rmtree ) ; use File::Spec ; use File::stat ; -#use Imapsync::Getopt::Long ; +use Getopt::Long ( ) ; use IO::File ; -use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE) ; -#use IO::Socket::SSL ; +use IO::Socket qw( :crlf SOL_SOCKET SO_KEEPALIVE ) ; +use IO::Socket::INET6 ; +use IO::Socket::SSL ; use IO::Tee ; use IPC::Open3 'open3' ; use Mail::IMAPClient 3.30 ; use MIME::Base64 ; +use Pod::Usage qw(pod2usage) ; use POSIX qw(uname SIGALRM) ; +use Sys::Hostname ; use Term::ReadKey ; use Test::More ; use Time::HiRes qw( time sleep ) ; @@ -726,6 +689,10 @@ use Time::Local ; use Unicode::String ; use Cwd ; use Readonly ; +#use Net::Ping ; +use Sys::MemInfo ; + +local $OUTPUT_AUTOFLUSH = 1 ; # constants @@ -735,10 +702,10 @@ use Readonly ; Readonly my $EX_OK => 0 ; #/* successful termination */ Readonly my $EX_USAGE => 64 ; #/* command line usage error */ #Readonly my $EX_DATAERR => 65 ; #/* data format error */ -#Readonly my $EX_NOINPUT => 66 ; #/* cannot open input */ +Readonly my $EX_NOINPUT => 66 ; #/* cannot open input */ #Readonly my $EX_NOUSER => 67 ; #/* addressee unknown */ #Readonly my $EX_NOHOST => 68 ; #/* host name unknown */ -#Readonly my $EX_UNAVAILABLE => 69 ; #/* service unavailable */ +Readonly my $EX_UNAVAILABLE => 69 ; #/* service unavailable */ Readonly my $EX_SOFTWARE => 70 ; #/* internal software error */ #Readonly my $EX_OSERR => 71 ; #/* system error (e.g., can't fork) */ #Readonly my $EX_OSFILE => 72 ; #/* critical OS file missing */ @@ -752,11 +719,17 @@ Readonly my $EX_SOFTWARE => 70 ; #/* internal software error */ # Mine Readonly my $EXIT_BY_SIGNAL => 6 ; Readonly my $EXIT_PID_FILE_ALREADY_EXIST => 8 ; + Readonly my $EXIT_WITH_ERRORS => 111 ; Readonly my $EXIT_WITH_ERRORS_MAX => 112 ; Readonly my $EXIT_UNKNOWN => 126 ; -Readonly my $ERRORS_MAX => 50 ; # exit after 50 errors. +Readonly my $EXIT_TESTS_FAILED => 254 ; # Like Test::More API + + + +Readonly my $ERRORS_MAX => 50 ; # exit after 50 errors. +Readonly my $ERRORS_MAX_CGI => 20 ; # exit after 20 errors in CGI context. Readonly my $INTERVAL_TO_EXIT => 2 ; # interval max to exit instead of reconnect @@ -768,18 +741,20 @@ Readonly my $SPLIT_FACTOR => 10 ; # init_imap() calls Maxcommandlength( $SPLIT_ Readonly my $IMAP_PORT => 143 ; # Well know port for IMAP Readonly my $IMAP_SSL_PORT => 993 ; # Well know port for IMAP over SSL -Readonly my $LAST => -1 ; -Readonly my $MINUS_ONE => -1 ; +Readonly my $LAST => -1 ; +Readonly my $MINUS_ONE => -1 ; -Readonly my $RELEASE_NUMBER_EXAMPLE_1 => '1.351' ; +Readonly my $RELEASE_NUMBER_EXAMPLE_1 => '1.351' ; Readonly my $RELEASE_NUMBER_EXAMPLE_2 => 42.4242 ; - +Readonly my $TCP_PING_TIMEOUT => 5 ; Readonly my $DEFAULT_TIMEOUT => 120 ; Readonly my $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND => 3 ; -Readonly my $DEFAULT_UIDNEXT => 999999 ; +Readonly my $DEFAULT_UIDNEXT => 999_999 ; Readonly my $DEFAULT_BUFFER_SIZE => 4096 ; +Readonly my $MAX_SLEEP => 2 ; # 2 seconds max for limiting too long sleeps from --maxbytespersecond and --maxmessagespersecond + Readonly my $DEFAULT_EXPIRATION_TIME_OAUTH2_PK12 => 3600 ; Readonly my $PERMISSION_FILTER => 7777 ; @@ -796,11 +771,11 @@ Readonly my $NUMBER_20_000 => 20_000 ; Readonly my $QUOTA_PERCENT_LIMIT => 90 ; -Readonly my $NUMBER_104857600 => 104857600 ; +Readonly my $NUMBER_104_857_600 => 104_857_600 ; Readonly my $SIZE_MAX_STR => 64 ; -Readonly my $NB_SECONDS_IN_A_DAY => 86400 ; +Readonly my $NB_SECONDS_IN_A_DAY => 86_400 ; Readonly my $STD_CHAR_PER_LINE => 80 ; @@ -809,20 +784,22 @@ Readonly my $FALSE => 0 ; Readonly my $LAST_RESSORT_SEPARATOR => q{/} ; +Readonly my $CGI_TMPDIR_TOP => '/var/tmp/imapsync_cgi' ; +Readonly my $CGI_HASHFILE => '/var/tmp/imapsync_hash' ; +Readonly my $UMASK_PARANO => '0077' ; + # global variables my( - $sync, - $rcs, + $sync, $debug, $debugimap, $debugimap1, $debugimap2, $debugcontent, $debugflags, $debuglist, $debugdev, $debugmaxlinelength, @debugbasket, $debugcgi, - $host1, $host2, $port1, $port2, - $user1, $user2, $domain1, $domain2, - $password1, $password2, $passfile1, $passfile2, + $domain1, $domain2, + $passfile1, $passfile2, @folder, @include, @exclude, @folderrec, @folderfirst, @folderlast, $prefix1, $prefix2, - $subfolder2, + $subfolder2, @regextrans2, @regexmess, @regexflag, @skipmess, @pipemess, $pipemesscheck, $flagscase, $filterflags, $syncflagsaftercopy, $sep1, $sep2, @@ -835,19 +812,16 @@ my( $search, $search1, $search2, $skipheader, @useheader, $skipsize, $allowsizemismatch, $foldersizes, $foldersizesatend, $buffersize, - $delete, $delete2, $delete2duplicates, - $expunge, $expunge1, $expunge2, $uidexpunge2, $dry, + $delete1, $delete2, $delete2duplicates, + $expunge1, $expunge2, $uidexpunge2, $justfoldersizes, $authmd5, $authmd51, $authmd52, $subscribed, $subscribe, $subscribeall, $version, $help, $justconnect, $justfolders, $justbanner, $fast, - - $total_bytes_transferred, $total_bytes_skipped, $total_bytes_error, - $nb_msg_transferred, $nb_msg_skipped, $nb_msg_skipped_dry_mode, $h1_nb_msg_duplicate, @@ -867,18 +841,14 @@ my( $h2_nb_msg_end, $h2_bytes_end, $timeout, - $timestart_int, $timeend, + $timestart_int, $timebefore, - $ssl1, $ssl2, - $ssl1_ssl_version, $ssl2_ssl_version, - $tls1, $tls2, $uid1, $uid2, $authuser1, $authuser2, $proxyauth1, $proxyauth2, $authmech1, $authmech2, $split1, $split2, $reconnectretry1, $reconnectretry2, - $tests, $test_builder, $testsdebug, $testslive, $justlogin, $tmpdir, $releasecheck, @@ -891,8 +861,6 @@ my( %h1, %h2, $checkselectable, $checkmessageexists, $expungeaftereach, - $abletosearch, - $showpasswords, $fixslash2, $messageidnodomain, $fixInboxINBOX, @@ -901,24 +869,36 @@ my( $uidnext_default, $fixcolonbug, $create_folder_old, - $maxmessagespersecond, - $maxbytespersecond, $skipcrossduplicates, $debugcrossduplicates, $disarmreadreceipts, $mixfolders, $skipemptyfolders, - $fetch_hash_set, + $fetch_hash_set, ); -# main program +# main program # global variables initialisation -$rcs = q{$Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $} ; +# Currently removing all global variables except $sync +# passing each of them under $sync->{variable_name} -$total_bytes_transferred = 0; +$sync->{timestart} = time ; # Is a float because of use Time::HiRres + +$sync->{rcs} = q{$Id: imapsync,v 1.836 2017/09/05 16:14:53 gilles Exp gilles $} ; + + + +my @loadavg = loadavg( ) ; +$sync->{cpu_number} = cpu_number( ) ; +$sync->{loaddelay} = load_and_delay( $sync->{cpu_number}, @loadavg ) ; +$sync->{loadavg} = join( q{ }, @loadavg ) . " on $sync->{cpu_number} cores." ; + + + +$sync->{total_bytes_transferred} = 0 ; $total_bytes_skipped = 0; $total_bytes_error = 0; -$nb_msg_transferred = 0; +$sync->{nb_msg_transferred} = 0; $nb_msg_skipped = $nb_msg_skipped_dry_mode = 0; $h1_nb_msg_deleted = $h2_nb_msg_deleted = 0; $h1_nb_msg_duplicate = $h2_nb_msg_duplicate = 0; @@ -952,30 +932,54 @@ my %month_abrev = ( ); +my $cgidir ; +# CGI environment in case +cgibegin( $sync ) ; +# In cgi context, printing must start by the header so we delay other prints by using output() storage +my $options_good = get_options( $sync, @ARGV ) ; +docker_context( $sync ) ; +cgibuildheader( $sync ) ; +myprint( output( $sync ) ) ; +output_reset_with( $sync ) ; -# @ARGV will be eat by get_options() -my @argv_copy = @ARGV; +# Can break here if load is too heavy +cgiload( $sync ) ; -my $cgi_dir = '/var/tmp/imapsync_cgi' ; +# don't go on if options are not all known. +if ( ! defined $options_good ) { exit $EX_USAGE ; } -# Under CGI environment -if ( $ENV{SERVER_SOFTWARE} ) { - myprint( "\n" ) ; - myprint( "
\n" ) ;
-        -d $cgi_dir or mkpath $cgi_dir or die "Can not create $cgi_dir: $!\n" ;
-        chdir  $cgi_dir or die "Can not cd to $cgi_dir: $!\n" ;
+# just the version
+myprint( imapsync_version( $sync ), "\n" ) and exit 0 if ( $version ) ;
+
+$sync->{debugenv} and printenv( $sync ) ; # if option --debugenv
+load_modules(  ) ;
+
+# after_get_options call usage and exit if --help or options were not well got
+after_get_options( $options_good ) ;
+
+# Under CGI environment, fix caveat emptor potentiel issues
+cgisetcontext( $sync ) ;
+
+easyany( $sync ) ;
+
+$tmpdir ||= File::Spec->tmpdir(  ) ;
+
+# Unit tests
+testsexit( $sync ) ;
+
+# init live varaiables
+testslive( $sync ) if ( $sync->{testslive} ) ;
+testslive6( $sync ) if ( $sync->{testslive6} )  ;
+
+#
+$sync->{pidfile} =  defined  $sync->{pidfile}  ? $sync->{pidfile} : $tmpdir . '/imapsync.pid' ;
+$sync->{pidfilelocking} = defined  $sync->{pidfilelocking}  ? $sync->{pidfilelocking} : 0 ;
+
+if ( $sync->{abort} ) {
+	abort( $sync ) ;
 }
 
-get_options(  ) ;
-unsetunsafe(  ) if ( $ENV{SERVER_SOFTWARE} ) ;
-
-# Under CGI environment
-if ( $ENV{SERVER_SOFTWARE} ) {
-        myprint( 'Current directory is ' . getcwd(  ) . "\n" ) ;
-        myprint( 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
-        myprint( 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;
-}
 
 local $SIG{ INT } = sub {
         my $signame = shift ;
@@ -983,18 +987,15 @@ local $SIG{ INT } = sub {
 } ;
 
 local $SIG{ QUIT } = local $SIG{ TERM } = sub {
-	my $signame = shift ;
+        my $signame = shift ;
         catch_exit( $sync, $signame ) ;
 } ;
 
 
-$sync->{timestart} = $BASETIME ; # Never too let reading books and perlvar
-
 $sync->{log}        = defined $sync->{log}        ? $sync->{log}        :  1 ;
 $sync->{errorsdump} = defined $sync->{errorsdump} ? $sync->{errorsdump} :  1 ;
 $sync->{errorsmax}  = defined $sync->{errorsmax}  ? $sync->{errorsmax}  : $ERRORS_MAX ;
 
-$sync->{user2} = $user2 ;
 
 if ( $sync->{log} ) {
         setlogfile( $sync ) ;
@@ -1008,23 +1009,23 @@ my $timestart_str = localtime( $sync->{timestart} ) ;
 myprint( "Transfer started at $timestart_str\n" ) ;
 myprint( "PID is $PROCESS_ID\n" ) ;
 myprint( "Log file is $sync->{logfile} ( to change it, use --logfile path ; or use --nolog to turn off logging )\n" ) if ( $sync->{log} ) ;
+myprint( "Load is " . ( join( q{ }, loadavg(  ) ) || 'unknown' ), " on $sync->{cpu_number} cores\n" ) ;
+myprint( 'Current directory is ' . getcwd(  ) . "\n" ) ;
+myprint( 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
+myprint( 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;
+
 $modulesversion = defined  $modulesversion  ? $modulesversion : 1 ;
 
 # If you want releasecheck not to be done by default (like the github maintainer),
-# then uncomment the first "$releasecheck =" line, the line ending with "0 ;".
-# The second line (ending with "1 ;") can stay active or be commented,
-# the result will be the same: no releasecheck by default.
+# then just uncomment the first "$releasecheck =" line, the line ending with "0 ;",
+# the second line (ending with "1 ;") can then stay active or be commented,
+# the result will be the same: no releasecheck by default (because 0 is then defined value).
 
 $releasecheck = defined  $releasecheck  ? $releasecheck : 0 ;
 #$releasecheck = defined  $releasecheck  ? $releasecheck : 1 ;
 
 my $warn_release = ( $releasecheck ) ? check_last_release(  ) : q{} ;
 
-# default values
-
-$sync->{pidfile} =  defined  $sync->{pidfile}  ? $sync->{pidfile} : $tmpdir . '/imapsync.pid' ;
-
-$sync->{pidfilelocking} = defined  $sync->{pidfilelocking}  ? $sync->{pidfilelocking} : 0 ;
 
 $wholeheaderifneeded  = defined  $wholeheaderifneeded   ? $wholeheaderifneeded  : 1;
 
@@ -1047,9 +1048,15 @@ $cacheaftercopy = 1 if ( $usecache and ( ! defined  $cacheaftercopy  ) ) ;
 $checkselectable    = defined  $checkselectable  ? $checkselectable : 1 ;
 $checkmessageexists = defined  $checkmessageexists  ? $checkmessageexists : 0 ;
 $expungeaftereach   = defined  $expungeaftereach  ? $expungeaftereach : 1 ;
-$abletosearch       = defined  $abletosearch  ? $abletosearch : 1 ;
-$checkmessageexists = 0 if ( not $abletosearch ) ;
-$showpasswords      = defined  $showpasswords  ? $showpasswords : 0 ;
+
+# abletosearch is on by default
+$sync->{abletosearch}    = defined  $sync->{abletosearch}   ? $sync->{abletosearch} : 1 ;
+$sync->{abletosearch1}   = defined  $sync->{abletosearch1}  ? $sync->{abletosearch1} : $sync->{abletosearch} ;
+$sync->{abletosearch2}   = defined  $sync->{abletosearch2}  ? $sync->{abletosearch2} : $sync->{abletosearch} ;
+$checkmessageexists      = 0 if ( not $sync->{abletosearch1} ) ;
+
+
+$sync->{showpasswords}   = defined  $sync->{showpasswords}  ? $sync->{showpasswords} : 0 ;
 $fixslash2          = defined  $fixslash2  ? $fixslash2 : 1 ;
 $fixInboxINBOX      = defined  $fixInboxINBOX  ? $fixInboxINBOX : 1 ;
 $create_folder_old  = defined  $create_folder_old  ? $create_folder_old : 0 ;
@@ -1058,62 +1065,49 @@ $sync->{automap}    = defined  $sync->{automap}  ? $sync->{automap} : 0 ;
 
 $delete2duplicates = 1 if ( $delete2 and ( ! defined  $delete2duplicates  ) ) ;
 
-$maxmessagespersecond = defined  $maxmessagespersecond  ? $maxmessagespersecond : 0 ;
-$maxbytespersecond    = defined  $maxbytespersecond     ? $maxbytespersecond    : 0 ;
+$sync->{maxmessagespersecond} = defined  $sync->{maxmessagespersecond}  ? $sync->{maxmessagespersecond} : 0 ;
+$sync->{maxbytespersecond}    = defined  $sync->{maxbytespersecond}     ? $sync->{maxbytespersecond}    : 0 ;
 
-myprint( banner_imapsync( @argv_copy ) ) ;
+$sync->{sslcheck} = defined $sync->{sslcheck} ? $sync->{sslcheck} : 1 ;
+
+myprint( banner_imapsync( @ARGV ) ) ;
 
 myprint( "Temp directory is $tmpdir  ( to change it use --tmpdir dirpath )\n") ;
+myprint( output( $sync ) ) ;
 
-is_valid_directory( $tmpdir ) || croak "Error creating tmpdir $tmpdir : $!" ;
+do_valid_directory( $tmpdir ) || croak "Error creating tmpdir $tmpdir : $OS_ERROR" ;
 
 if ( $sync->{pidfile} ) {
         write_pidfile( $sync->{pidfile}, $sync->{pidfilelocking} ) ;
 }
 
+if ( $sync->{simulong} ) { simulong( $sync->{simulong} ) ; }
+
+
+
 $fixcolonbug = defined  $fixcolonbug  ? $fixcolonbug : 1 ;
 
 if ( $usecache and $fixcolonbug ) { tmpdir_fix_colon_bug(  ) } ;
 
 $modulesversion and myprint( "Modules version list:\n", modulesversion(), "( use --no-modulesversion to turn off printing this Perl modules list )\n" ) ;
 
-my $DEFAULT_SSL_VERIFY ;
-my %SSL_VERIFY_STR ;
-
-if ( $ssl1 or $ssl2 or $tls1 or $tls2) {
-        Readonly $DEFAULT_SSL_VERIFY => IO::Socket::SSL::SSL_VERIFY_NONE(  ) ;
-        Readonly %SSL_VERIFY_STR => (
-                IO::Socket::SSL::SSL_VERIFY_NONE(  ) => 'SSL_VERIFY_NONE' ,
-                IO::Socket::SSL::SSL_VERIFY_PEER(  ) => 'SSL_VERIFY_PEER' ,
-        ) ;
-        $IO::Socket::SSL::DEBUG = $sync->{debugssl} || 1 ;
-        myprint( "SSL debug mode level is --debugssl $IO::Socket::SSL::DEBUG (can be set from 0 meaning no debug to 4 meaning max debug)\n" ) ;
-}
-
-if ( $ssl1 ) {
-        myprint( 'Host1: SSL default mode is like --sslargs1 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host1 (do not check the certificate server)\n" ) ;
-        myprint( 'Host1: Use --sslargs1 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host1\n" ) ;
-}
-if ( $ssl2 ) {
-        myprint( 'Host2: SSL default mode is like --sslargs2 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host2 (do not check the certificate server)\n" ) ;
-        myprint( 'Host2: Use --sslargs2 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host2\n" ) ;
-}
-
 
 check_lib_version(  ) or
   croak "imapsync needs perl lib Mail::IMAPClient release 3.30 or superior.\n";
 
 exit_clean( $sync, $EX_OK ) if ( $justbanner ) ;
 
+sslcheck( $sync ) ;
+
 
 $split1 ||= $SPLIT ;
 $split2 ||= $SPLIT ;
 
-$host1 || missing_option( '--host1' ) ;
-$port1 ||= ( $ssl1 ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
+$sync->{host1} || missing_option( '--host1' ) ;
+$sync->{port1} ||= ( $sync->{ssl1} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
 
-$host2 || missing_option( '--host2' ) ;
-$port2 ||= ( $ssl2 ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
+$sync->{host2} || missing_option( '--host2' ) ;
+$sync->{port2} ||= ( $sync->{ssl2} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
 
 $debugimap1 = $debugimap2 = 1 if ( $debugimap ) ;
 $debug = 1 if ( $debugimap1 or $debugimap2 ) ;
@@ -1129,30 +1123,60 @@ $subscribe = defined $subscribe ? $subscribe : 1;
 # Allow size mismatch by default
 $allowsizemismatch = defined $allowsizemismatch ? $allowsizemismatch : 1;
 
-$delete2folders = 1
-    if ( defined  $delete2foldersbutnot  or defined  $delete2foldersonly  ) ;
 
-if ( $justconnect ) {
-	justconnect(  ) ;
-	exit_clean( $sync, $EX_OK ) ;
+if ( defined  $delete2foldersbutnot  or defined  $delete2foldersonly  ) {
+	$delete2folders = 1 ;
 }
 
-$user1 || missing_option( '--user1' ) ;
-$user2 || missing_option( '--user2' ) ;
+my $DEFAULT_SSL_VERIFY ;
+my %SSL_VERIFY_STR ;
+
+Readonly $DEFAULT_SSL_VERIFY => IO::Socket::SSL::SSL_VERIFY_NONE(  ) ;
+Readonly %SSL_VERIFY_STR => (
+	IO::Socket::SSL::SSL_VERIFY_NONE(  ) => 'SSL_VERIFY_NONE' ,
+	IO::Socket::SSL::SSL_VERIFY_PEER(  ) => 'SSL_VERIFY_PEER' ,
+) ;
+$IO::Socket::SSL::DEBUG = $sync->{debugssl} || 1 ;
+
+
+
+if ( $sync->{ssl1} or $sync->{ssl2} or $sync->{tls1} or $sync->{tls2}) {
+        myprint( "SSL debug mode level is --debugssl $IO::Socket::SSL::DEBUG (can be set from 0 meaning no debug to 4 meaning max debug)\n" ) ;
+}
+
+if ( $sync->{ssl1} ) {
+        myprint( 'Host1: SSL default mode is like --sslargs1 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host1 (do not check the certificate server)\n" ) ;
+        myprint( 'Host1: Use --sslargs1 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host1\n" ) ;
+}
+
+if ( $sync->{ssl2} ) {
+        myprint( 'Host2: SSL default mode is like --sslargs2 SSL_verify_mode=' . $DEFAULT_SSL_VERIFY . " meaning $SSL_VERIFY_STR{$DEFAULT_SSL_VERIFY} on host2 (do not check the certificate server)\n" ) ;
+        myprint( 'Host2: Use --sslargs2 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " for $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} on host2\n" ) ;
+}
+
+
+
+if ( $justconnect ) {
+        justconnect(  ) ;
+        exit_clean( $sync, $EX_OK ) ;
+}
+
+$sync->{user1} || missing_option( '--user1' ) ;
+$sync->{user2} || missing_option( '--user2' ) ;
 
 $syncinternaldates = defined $syncinternaldates ? $syncinternaldates : 1;
 
-# Turn on expunge if there is not explicit option --noexpunge and option
-# --delete is given.
-# Done because --delete --noexpunge is very dangerous on the second run:
-# the Deleted flag is then synced to all previously transfered messages.
-# So --delete implies --expunge is a better usability default behaviour.
-if ( $delete ) {
-	if ( ! defined  $expunge  ) {
-		myprint( "Info: turning on --expunge1 because --delete --noexpunge1 is very dangerous on the second run.\n" ) ;
-		$expunge = 1 ;
-	}
-		myprint( "Info: if expunging after each message slows down too much the sync then use --noexpungeaftereach to speed up\n" ) ;
+# Turn on expunge if there is not explicit option --noexpunge1 and option
+# --delete1 is given.
+# Done because --delete1 --noexpunge1 is very dangerous on the second run:
+# the Deleted flag is then synced to all previously transferred messages.
+# So --delete1 implies --expunge1 is a better usability default behavior.
+if ( $delete1 ) {
+        if ( ! defined  $expunge1  ) {
+                myprint( "Info: turning on --expunge1 because --delete1 --noexpunge1 is very dangerous on the second run.\n" ) ;
+                $expunge1 = 1 ;
+        }
+                myprint( "Info: if expunging after each message slows down too much the sync then use --noexpungeaftereach to speed up\n" ) ;
 }
 
 if ( $uidexpunge2 and not Mail::IMAPClient->can( 'uidexpunge' ) ) {
@@ -1163,48 +1187,48 @@ if ( $uidexpunge2 and not Mail::IMAPClient->can( 'uidexpunge' ) ) {
 if ( ( $delete2 or $delete2duplicates ) and not defined  $uidexpunge2  ) {
         if ( Mail::IMAPClient->can( 'uidexpunge' ) ) {
                 myprint( "Info: will act as --uidexpunge2\n" ) ;
-		$uidexpunge2 = 1 ;
+                $uidexpunge2 = 1 ;
         }elsif ( not defined  $expunge2  ) {
                  myprint( "Info: will act as --expunge2 (no uidexpunge support)\n" ) ;
                 $expunge2 = 1 ;
         }
 }
 
-if ( $delete and $delete2 ) {
-	myprint( "Warning: using --delete and --delete2 together is almost always a bad idea, exiting imapsync\n" ) ;
-	exit_clean( $sync, $EX_USAGE ) ;
+if ( $delete1 and $delete2 ) {
+        myprint( "Warning: using --delete1 and --delete2 together is almost always a bad idea, exiting imapsync\n" ) ;
+        exit_clean( $sync, $EX_USAGE ) ;
 }
 
 if ( $idatefromheader ) {
-	myprint( 'Turned ON idatefromheader, ',
-	      "will set the internal dates on host2 from the 'Date:' header line.\n" ) ;
-	$syncinternaldates = 0 ;
+        myprint( 'Turned ON idatefromheader, ',
+              "will set the internal dates on host2 from the 'Date:' header line.\n" ) ;
+        $syncinternaldates = 0 ;
 }
 
 if ( $syncinternaldates ) {
-	myprint( 'Info: turned ON syncinternaldates, ',
-	      "will set the internal dates (arrival dates) on host2 same as host1.\n" ) ;
+        myprint( 'Info: turned ON syncinternaldates, ',
+              "will set the internal dates (arrival dates) on host2 same as host1.\n" ) ;
 }else{
         myprint( "Info: turned OFF syncinternaldates\n" ) ;
 }
 
 if ( defined $authmd5 and $authmd5 ) {
-	$authmd51 = 1 ;
-	$authmd52 = 1 ;
+        $authmd51 = 1 ;
+        $authmd52 = 1 ;
 }
 
 if ( defined $authmd51 and $authmd51 ) {
-	$authmech1 ||= 'CRAM-MD5';
+        $authmech1 ||= 'CRAM-MD5';
 }
 else{
-	$authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN';
+        $authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN';
 }
 
 if ( defined $authmd52 and $authmd52 ) {
-	$authmech2 ||= 'CRAM-MD5';
+        $authmech2 ||= 'CRAM-MD5';
 }
 else{
-	$authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN';
+        $authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN';
 }
 
 $authmech1 = uc $authmech1;
@@ -1218,8 +1242,8 @@ if (defined $proxyauth2 && !$authuser2) {
         missing_option( 'With --proxyauth2, --authuser2' ) ;
 }
 
-$authuser1 ||= $user1;
-$authuser2 ||= $user2;
+$authuser1 ||= $sync->{user1};
+$authuser2 ||= $sync->{user2};
 
 myprint( "Host1: will try to use $authmech1 authentication on host1\n") ;
 myprint( "Host2: will try to use $authmech2 authentication on host2\n") ;
@@ -1249,7 +1273,7 @@ $reconnectretry2 = defined  $reconnectretry2  ? $reconnectretry2 : $DEFAULT_NB_R
 # then $uidnext_default is never used. So I have to remove it.
 $uidnext_default = $DEFAULT_UIDNEXT ;
 
-@useheader = qw( Message-Id Received ) unless ( @useheader ) ;
+if ( ! @useheader ) { @useheader = qw( Message-Id Received )  ; }
 
 my %useheader ;
 
@@ -1259,44 +1283,18 @@ for ( @useheader ) { $useheader{ uc  $_  } = undef } ;
 #myprint( Data::Dumper->Dump( [ \%useheader ] )  ) ;
 #exit ;
 
-myprint( "Host1: IMAP server [$host1] port [$port1] user [$user1]\n" ) ;
-myprint( "Host2: IMAP server [$host2] port [$port2] user [$user2]\n" ) ;
+myprint( "Host1: IMAP server [$sync->{host1}] port [$sync->{port1}] user [$sync->{user1}]\n" ) ;
+myprint( "Host2: IMAP server [$sync->{host2}] port [$sync->{port2}] user [$sync->{user2}]\n" ) ;
 
-$password1 || $passfile1 || 'PREAUTH' eq $authmech1 || 'EXTERNAL' eq $authmech1 || do {
-	myprint( << 'FIN_PASSFILE'  ) ;
-
-If you are afraid of giving password on the command line arguments, you can put the
-password of user1 in a file named file1 and use "--passfile1 file1" instead of typing it.
-Then give this file restrictive permissions with the command "chmod 600 file1".
-FIN_PASSFILE
-
-	$password1 = ask_for_password( $authuser1 || $user1, $host1 ) ;
-} ;
-
-$password1 = ( defined  $passfile1  ) ? firstline ( $passfile1 ) : $password1 ;
+get_password1( $sync ) ;
+get_password2( $sync ) ;
 
 
-$password2 || $passfile2 || 'PREAUTH' eq $authmech2 || 'EXTERNAL' eq $authmech2 || do {
-	myprint( << 'FIN_PASSFILE'  ) ;
 
-If you are afraid of giving password on the command line arguments, you can put the
-password of user2 in a file named file2 and use "--passfile2 file2" instead of typing it.
-Then give this file restrictive permissions with the command "chmod 600 file2".
-FIN_PASSFILE
-
-	$password2 = ask_for_password( $authuser2 || $user2, $host2 ) ;
-} ;
-
-$password2 = ( defined  $passfile2  ) ? firstline ( $passfile2 ) : $password2 ;
-
-
-# need clean up => write methods dry() and dry_message()
-$sync->{dry} = $dry ;
-my $dry_message = q{} ;
+$sync->{dry_message} = q{} ;
 if( $sync->{dry} ) {
-        $dry_message = "\t(not really since --dry mode)" ;
+        $sync->{dry_message} = "\t(not really since --dry mode)" ;
 }
-$sync->{dry_message} = $dry_message ;
 
 
 $search1 ||= $search if ( $search ) ;
@@ -1305,95 +1303,97 @@ $search2 ||= $search if ( $search ) ;
 
 
 if ( $disarmreadreceipts ) {
-	push @regexmess, q{s{\A((?:[^\n]+\r\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims} ;
+        push @regexmess, q{s{\A((?:[^\n]+\r\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims} ;
 }
 
 $pipemesscheck = ( defined  $pipemesscheck  ) ? $pipemesscheck : 1 ;
 
 if ( @pipemess and $pipemesscheck ) {
-	myprint( 'Checking each --pipemess command, ' 
-                . join( q{, }, @pipemess ) 
+        myprint( 'Checking each --pipemess command, '
+                . join( q{, }, @pipemess )
                 . ", with an space string. ( Can avoid this check with --nopipemesscheck )\n" ) ;
-	my $string = pipemess( q{ }, @pipemess ) ;
+        my $string = pipemess( q{ }, @pipemess ) ;
         # string undef means something was bad.
         if ( not ( defined  $string  ) ) {
-        	die_clean( "Error: one of --pipemess command is bad, check it\n" ) ;
+                die_clean( "Error: one of --pipemess command is bad, check it\n" ) ;
         }
-	myprint( "Ok with each --pipemess @pipemess\n"  ) ;
+        myprint( "Ok with each --pipemess @pipemess\n"  ) ;
 }
 
 if ( $maxlinelengthcmd ) {
-	myprint( "Checking  --maxlinelengthcmd command,  $maxlinelengthcmd, with an space string.\n"  ) ;
-	my $string = pipemess( q{ }, $maxlinelengthcmd ) ;
+        myprint( "Checking  --maxlinelengthcmd command,  $maxlinelengthcmd, with an space string.\n"  ) ;
+        my $string = pipemess( q{ }, $maxlinelengthcmd ) ;
         # string undef means something was bad.
         if ( not ( defined  $string  ) ) {
-        	die_clean( "Error: --maxlinelengthcmd command is bad, check it\n" ) ;
+                die_clean( "Error: --maxlinelengthcmd command is bad, check it\n" ) ;
         }
-	myprint( "Ok with --maxlinelengthcmd $maxlinelengthcmd\n"  ) ;
+        myprint( "Ok with --maxlinelengthcmd $maxlinelengthcmd\n"  ) ;
 }
 
 if ( @regexmess ) {
-	my $string = regexmess( q{ } ) ;
-	myprint( "Checking each --regexmess command with an space string.\n"  ) ;
+        my $string = regexmess( q{ } ) ;
+        myprint( "Checking each --regexmess command with an space string.\n"  ) ;
         # string undef means one of the eval regex was bad.
         if ( not ( defined  $string  ) ) {
-        	die_clean( 'Error: one of --regexmess option is bad, check it' ) ;
+                die_clean( 'Error: one of --regexmess option is bad, check it' ) ;
         }
-	myprint( "Ok with each --regexmess\n"  ) ;
+        myprint( "Ok with each --regexmess\n"  ) ;
 }
 
 if ( @skipmess ) {
-	myprint( "Checking each --skipmess command with an space string.\n"  ) ;
-	my $match = skipmess( q{ } ) ;
+        myprint( "Checking each --skipmess command with an space string.\n"  ) ;
+        my $match = skipmess( q{ } ) ;
         # match undef means one of the eval regex was bad.
         if ( not ( defined  $match  ) ) {
-        	die_clean( 'Error: one of --skipmess option is bad, check it' ) ;
+                die_clean( 'Error: one of --skipmess option is bad, check it' ) ;
         }
-	myprint( "Ok with each --skipmess\n"  ) ;
+        myprint( "Ok with each --skipmess\n"  ) ;
 }
 
 if ( @regexflag ) {
-	myprint( "Checking each --regexflag command with an space string.\n"  ) ;
-	my $string = flags_regex( q{ } ) ;
-	# string undef means one of the eval regex was bad.
-	if ( not ( defined  $string  ) ) {
-		die_clean( 'Error: one of --regexflag option is bad, check it' ) ;
-	}
-	myprint( "Ok with each --regexflag\n"  ) ;
+        myprint( "Checking each --regexflag command with an space string.\n"  ) ;
+        my $string = flags_regex( q{ } ) ;
+        # string undef means one of the eval regex was bad.
+        if ( not ( defined  $string  ) ) {
+                die_clean( 'Error: one of --regexflag option is bad, check it' ) ;
+        }
+        myprint( "Ok with each --regexflag\n"  ) ;
 }
 
-$sync->{imap1} = my $imap1 = login_imap($host1, $port1, $user1, $domain1, $password1,
-		   $debugimap1, $sync->{h1}->{timeout}, $fastio1, $ssl1, $tls1,
-		   $authmech1, $authuser1, $reconnectretry1,
-		   $proxyauth1, $uid1, $split1, 'Host1', $sync->{h1} ) ;
+$sync->{imap1} = my $imap1 = login_imap( $sync->{host1}, $sync->{port1}, $sync->{user1}, $domain1, $sync->{password1},
+                   $debugimap1, $sync->{h1}->{timeout}, $fastio1, $sync->{ssl1}, $sync->{tls1},
+                   $authmech1, $authuser1, $reconnectretry1,
+                   $proxyauth1, $uid1, $split1, 'Host1', $sync->{h1}, $sync ) ;
 
-$sync->{imap2} = my $imap2 = login_imap($host2, $port2, $user2, $domain2, $password2,
-		 $debugimap2, $sync->{h2}->{timeout}, $fastio2, $ssl2, $tls2,
-		 $authmech2, $authuser2, $reconnectretry2,
-		 $proxyauth2, $uid2, $split2, 'Host2', $sync->{h2} ) ;
+$sync->{imap2} = my $imap2 = login_imap( $sync->{host2}, $sync->{port2}, $sync->{user2}, $domain2, $sync->{password2},
+                 $debugimap2, $sync->{h2}->{timeout}, $fastio2, $sync->{ssl2}, $sync->{tls2},
+                 $authmech2, $authuser2, $reconnectretry2,
+                 $proxyauth2, $uid2, $split2, 'Host2', $sync->{h2}, $sync ) ;
 
 
 $debug and myprint( 'Host1 Buffer I/O: ', $imap1->Buffer(), "\n" ) ;
 $debug and myprint( 'Host2 Buffer I/O: ', $imap2->Buffer(), "\n" ) ;
 
 
-die_clean( 'Not authenticated on host1' ) unless $imap1->IsAuthenticated( ) ;
+if ( ! $imap1->IsAuthenticated( ) ) { die_clean( 'Not authenticated on host1' )  ; }
 myprint( "Host1: state Authenticated\n" ) ;
-die_clean( 'Not authenticated on host2' ) unless   $imap2->IsAuthenticated( ) ;
+if ( ! $imap2->IsAuthenticated( ) ) { die_clean( 'Not authenticated on host2' )  ; }
 myprint( "Host2: state Authenticated\n" ) ;
 
-myprint( 'Host1 capability: ', join(q{ }, @{ $imap1->capability_update() || [] }), "\n" ) ;
-myprint( 'Host2 capability: ', join(q{ }, @{ $imap2->capability_update() || [] }), "\n" ) ;
+myprint( 'Host1 capability once authenticated: ', join(q{ }, @{ $imap1->capability() || [] }), "\n" ) ;
+myprint( 'Host2 capability once authenticated: ', join(q{ }, @{ $imap2->capability() || [] }), "\n" ) ;
 
+# ID on by default since 1.832
+$sync->{id} = defined  $sync->{id}  ? $sync->{id} : 1 ;
 imap_id_stuff( $sync ) ;
 
-#quota( $imap1, 'host1' ) ; # quota on host1 is useless and pollute host2 output.
-quota( $imap2, 'host2', $sync ) ;
+#quota( $imap1, 'h1', $sync ) ; # quota on host1 is useless and pollute host2 output.
+quota( $imap2, 'h2', $sync )  ;
 
 if ( $justlogin ) {
-	$imap1->logout(  ) ;
-	$imap2->logout(  ) ;
-	exit_clean( $sync, $EX_OK ) ;
+        $imap1->logout(  ) ;
+        $imap2->logout(  ) ;
+        exit_clean( $sync, $EX_OK ) ;
 }
 
 
@@ -1410,7 +1410,7 @@ my (
         %h2_folders_from_1_all ,
 ) ;
 
-my $h1_folders_wanted_nb = 0 ; 
+my $h1_folders_wanted_nb = 0 ;
 my $h1_folders_wanted_ct = 0 ; # counter of folders done.
 
 # All folders on host1 and host2
@@ -1421,11 +1421,13 @@ my $h1_folders_wanted_ct = 0 ; # counter of folders done.
 myprint( 'Host1: found ', scalar  @h1_folders_all , " folders.\n"  ) ;
 myprint( 'Host2: found ', scalar  @h2_folders_all , " folders.\n"  ) ;
 
-for ( @h1_folders_all ) { $h1_folders_all{ $_ } = 1 } ;
-for ( @h2_folders_all ) {
-	$h2_folders_all{ $_ } = 1 ;
-	$h2_folders_all_UPPER{ uc  $_  } = 1 ;
-} ;
+foreach my $f ( @h1_folders_all ) { 
+	$h1_folders_all{ $f } = 1 
+}
+foreach my $f ( @h2_folders_all ) {
+        $h2_folders_all{ $f } = 1 ;
+        $h2_folders_all_UPPER{ uc  $f  } = 1 ;
+}
 
 $sync->{h1_folders_all} = \%h1_folders_all ;
 $sync->{h2_folders_all} = \%h2_folders_all ;
@@ -1438,59 +1440,59 @@ for ( $imap2->subscribed(  ) ) { $h2_subscribed_folder{ $_ } = 1 } ;
 
 
 if ( defined  $subfolder2  ) {
-	unshift @regextrans2,
-		q's,^${h2_prefix}(.*),${h2_prefix}${subfolder2}${h2_sep}$1,',
-		q's,^INBOX$,${h2_prefix}${subfolder2}${h2_sep}INBOX,' ;
+        unshift @regextrans2,
+                q(s,^${h2_prefix}(.*),${h2_prefix}${subfolder2}${h2_sep}$1,),
+                q(s,^INBOX$,${h2_prefix}${subfolder2}${h2_sep}INBOX,) ;
 
 }
 
 if ( $fixInboxINBOX and ( my $reg = fix_Inbox_INBOX_mapping( \%h1_folders_all, \%h2_folders_all ) ) ) {
-	push @regextrans2, $reg ;
+        push @regextrans2, $reg ;
 }
 
 if (scalar @folder or $subscribed or scalar @folderrec) {
-	# folders given by option --folder
-	if (scalar @folder) {
-		add_to_requested_folders(@folder);
-	}
+        # folders given by option --folder
+        if (scalar @folder) {
+                add_to_requested_folders(@folder);
+        }
 
-	# option --subscribed
-	if ( $subscribed ) {
-		add_to_requested_folders( keys  %h1_subscribed_folder  ) ;
-	}
+        # option --subscribed
+        if ( $subscribed ) {
+                add_to_requested_folders( keys  %h1_subscribed_folder  ) ;
+        }
 
-	# option --folderrec
-	if (scalar @folderrec) {
-		foreach my $folderrec (@folderrec) {
-			add_to_requested_folders($imap1->folders($folderrec));
-		}
-	}
+        # option --folderrec
+        if (scalar @folderrec) {
+                foreach my $folderrec (@folderrec) {
+                        add_to_requested_folders($imap1->folders($folderrec));
+                }
+        }
 }
 else {
-	# no include, no folder/subscribed/folderrec options => all folders
-	if (not scalar @include) {
-		myprint( "Including all folders found by default. Use --subscribed or --folder or --folderrec or --include to select specific folders. Use --exclude to unselect specific folders.\n"  ) ;
-		add_to_requested_folders(@h1_folders_all);
-	}
+        # no include, no folder/subscribed/folderrec options => all folders
+        if (not scalar @include) {
+                myprint( "Including all folders found by default. Use --subscribed or --folder or --folderrec or --include to select specific folders. Use --exclude to unselect specific folders.\n"  ) ;
+                add_to_requested_folders(@h1_folders_all);
+        }
 }
 
 
 # consider (optional) includes and excludes
 if ( scalar  @include  ) {
-	foreach my $include ( @include ) {
-		my @included_folders = grep { /$include/ } @h1_folders_all ;
-		add_to_requested_folders( @included_folders ) ;
-		myprint( "Including folders matching pattern $include\n" . jux_utf8_list( @included_folders )  . "\n"  ) ;
-	}
+        foreach my $include ( @include ) {
+                my @included_folders = grep { /$include/ } @h1_folders_all ;
+                add_to_requested_folders( @included_folders ) ;
+                myprint( "Including folders matching pattern $include\n" . jux_utf8_list( @included_folders )  . "\n"  ) ;
+        }
 }
 
 if ( scalar  @exclude  ) {
-	foreach my $exclude ( @exclude ) {
-		my @requested_folder = sort keys %requested_folder ;
-		my @excluded_folders = grep { /$exclude/ } @requested_folder ;
-		remove_from_requested_folders( @excluded_folders ) ;
-		myprint( "Excluding folders matching pattern $exclude\n" . jux_utf8_list( @excluded_folders ) . "\n"  ) ;
-	}
+        foreach my $exclude ( @exclude ) {
+                my @requested_folder = sort keys %requested_folder ;
+                my @excluded_folders = grep { /$exclude/ } @requested_folder ;
+                remove_from_requested_folders( @excluded_folders ) ;
+                myprint( "Excluding folders matching pattern $exclude\n" . jux_utf8_list( @excluded_folders ) . "\n"  ) ;
+        }
 }
 
 
@@ -1504,13 +1506,13 @@ if ( scalar  @exclude  ) {
 my @h1_folders_wanted_exist ;
 myprint( "Host1: checking all wanted folders exist.\n"  ) ;
 foreach my $folder ( @h1_folders_wanted ) {
-	( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder exists on host1\n"  ) ;
-	if ( ! exists  $h1_folders_all{ $folder }  ) {
+        ( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder exists on host1\n"  ) ;
+        if ( ! exists  $h1_folders_all{ $folder }  ) {
                 myprint( "Host1: warning! ignoring folder $folder because it is not in host1 whole folders list.\n" ) ;
-		next ;
-	}else{
-		push  @h1_folders_wanted_exist, $folder  ;
-	}
+                next ;
+        }else{
+                push  @h1_folders_wanted_exist, $folder  ;
+        }
 }
 
 @h1_folders_wanted = @h1_folders_wanted_exist ;
@@ -1518,17 +1520,17 @@ foreach my $folder ( @h1_folders_wanted ) {
 
 
 $checkselectable and do {
-	my @h1_folders_wanted_selectable ;
+        my @h1_folders_wanted_selectable ;
         myprint( "Host1: checking all wanted folders are selectable. Use --nocheckselectable to avoid this check.\n"  ) ;
-	foreach my $folder ( @h1_folders_wanted ) {
-        	( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder is selectable on host1\n"  ) ;
-        	if ( ! $imap1->selectable( $folder ) ) {
+        foreach my $folder ( @h1_folders_wanted ) {
+                ( $debug or $sync->{debugfolders} ) and myprint( "Checking $folder is selectable on host1\n"  ) ;
+                if ( ! $imap1->selectable( $folder ) ) {
                                 myprint( "Host1: warning! ignoring folder $folder because it is not selectable\n" ) ;
-        	}else{
-			push  @h1_folders_wanted_selectable, $folder  ;
-		}
-	}
-	@h1_folders_wanted = @h1_folders_wanted_selectable ;
+                }else{
+                        push  @h1_folders_wanted_selectable, $folder  ;
+                }
+        }
+        @h1_folders_wanted = @h1_folders_wanted_selectable ;
         ( $debug or $sync->{debugfolders} ) and myprint( 'Host1: checking folders took ', timenext(  ), " s\n"  ) ;
 } ;
 
@@ -1554,19 +1556,19 @@ automap( $sync ) ;
 
 
 foreach my $h1_fold ( @h1_folders_wanted ) {
-	my $h2_fold ;
-	$h2_fold = imap2_folder_name( $h1_fold ) ;
-	$h2_folders_from_1_wanted{ $h2_fold }++ ;
+        my $h2_fold ;
+        $h2_fold = imap2_folder_name( $h1_fold ) ;
+        $h2_folders_from_1_wanted{ $h2_fold }++ ;
         if ( 1 < $h2_folders_from_1_wanted{ $h2_fold } ) {
-        	$h2_folders_from_1_several{ $h2_fold }++ ;
+                $h2_folders_from_1_several{ $h2_fold }++ ;
         }
 }
 @h2_folders_from_1_wanted = sort keys %h2_folders_from_1_wanted;
 
 foreach my $h1_fold ( @h1_folders_all ) {
-	my $h2_fold ;
-	$h2_fold = imap2_folder_name( $h1_fold ) ;
-	$h2_folders_from_1_all{ $h2_fold }++ ;
+        my $h2_fold ;
+        $h2_fold = imap2_folder_name( $h1_fold ) ;
+        $h2_folders_from_1_all{ $h2_fold }++ ;
 }
 
 
@@ -1583,12 +1585,17 @@ Y is the uft8 output just printed for convenience, to recognize it.
 END_LISTING
 
 print
-  "Host1 folders list:\n",
+  "Host1 folders list (first the raw imap format then the [X] = [Y]):\n",
+  $imap1->list(  ),
+  "\n",
   jux_utf8_list( @h1_folders_all ),
   "\n",
-  "Host2 folders list:\n",
+  "Host2 folders list (first the raw imap format then the [X] = [Y]):\n",
+  $imap2->list(  ),
+  "\n",
   jux_utf8_list( @h2_folders_all ),
-  "\n" ;
+  "\n", 
+  q{} ;
 
 print
   'Host1 subscribed folders list: ',
@@ -1599,31 +1606,31 @@ my @h2_folders_not_in_1;
 @h2_folders_not_in_1 = list_folders_in_2_not_in_1(  ) ;
 
 if ( @h2_folders_not_in_1 ) {
-	myprint( "Folders in host2 not in host1:\n",
-	jux_utf8_list( @h2_folders_not_in_1 ), "\n" ) ;
+        myprint( "Folders in host2 not in host1:\n",
+        jux_utf8_list( @h2_folders_not_in_1 ), "\n" ) ;
 }
 
 
-if ( defined  $sync->{f1f2auto}  ) {
-	myprint( "Folders mapping from --automap feature (use --f1f2 to override any mapping):\n"  ) ;
-	foreach my $h1_fold ( keys %{$sync->{f1f2auto}} ) {
-        	my $h2_fold = $sync->{f1f2auto}{$h1_fold} ;
-		myprintf( "%-40s -> %-40s\n",
-		       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
+if ( keys %{ $sync->{f1f2auto} } ) {
+        myprint( "Folders mapping from --automap feature (use --f1f2 to override any mapping):\n"  ) ;
+        foreach my $h1_fold ( keys %{ $sync->{f1f2auto} } ) {
+                my $h2_fold = $sync->{f1f2auto}{$h1_fold} ;
+                myprintf( "%-40s -> %-40s\n",
+                       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
         }
         myprint( "\n"  ) ;
 }
 
-if ( defined  $sync->{f1f2}  ) {
-	myprint( "Folders mapping from --f1f2 options, it overrides --automap:\n"  ) ;
-	foreach my $h1_fold ( keys %{$sync->{f1f2}} ) {
-        	my $h2_fold = $sync->{f1f2}{$h1_fold} ;
+if ( keys %{ $sync->{f1f2} } ) {
+        myprint( "Folders mapping from --f1f2 options, it overrides --automap:\n"  ) ;
+        foreach my $h1_fold ( keys %{ $sync->{f1f2} } ) {
+                my $h2_fold = $sync->{f1f2}{$h1_fold} ;
                 my $warn = q{} ;
                 if ( not exists  $h1_folders_all{ $h1_fold }  ) {
                         $warn = "BUT $h1_fold does NOT exist on host1!" ;
                 }
-		myprintf( "%-40s -> %-40s %s\n",
-		       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ), $warn ) ;
+                myprintf( "%-40s -> %-40s %s\n",
+                       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ), $warn ) ;
         }
         myprint( "\n"  ) ;
 }
@@ -1653,7 +1660,7 @@ $h1_folders_wanted_nb = scalar  @h1_folders_wanted  ;
 
 myprint( "++++ Looping on each one of $h1_folders_wanted_nb folders to sync\n" ) ;
 
-my $begin_transfer_time = time ;
+$sync->{begin_transfer_time} = time ;
 
 my %uid_candidate_for_deletion ;
 my %uid_candidate_no_deletion ;
@@ -1662,234 +1669,235 @@ my %h2_folders_of_md5 = (  ) ;
 
 FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) {
 
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-	my $h2_fold = imap2_folder_name( $h1_fold ) ;
+        my $h2_fold = imap2_folder_name( $h1_fold ) ;
 
-	$h1_folders_wanted_ct++ ;
-	myprintf( "Folder %7s %-35s -> %-35s\n", "$h1_folders_wanted_ct/$h1_folders_wanted_nb",
-		jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
+        $h1_folders_wanted_ct++ ;
+        myprintf( "Folder %7s %-35s -> %-35s\n", "$h1_folders_wanted_ct/$h1_folders_wanted_nb",
+                jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
         if ( $sync->{debugmemory} ) {
                 myprintf("FL: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
-	# host1 can not be fetched read only, select is needed because of expunge.
-	select_folder( $imap1, $h1_fold, 'Host1' ) or next FOLDER ;
+        # host1 can not be fetched read only, select is needed because of expunge.
+        select_folder( $imap1, $h1_fold, 'Host1' ) or next FOLDER ;
 
         debugsleep( $sync ) ;
 
-	my $h1_fold_nb_messages = count_from_select( $imap1->History ) ;
+        my $h1_fold_nb_messages = count_from_select( $imap1->History ) ;
         myprint( "Host1 folder [$h1_fold] has $h1_fold_nb_messages messages in total (mentioned by SELECT)\n" ) ;
 
         if ( $skipemptyfolders and 0 == $h1_fold_nb_messages ) {
-        	myprint( "Skipping empty host1 folder [$h1_fold]\n"  ) ;
+                myprint( "Skipping empty host1 folder [$h1_fold]\n"  ) ;
                 next FOLDER ;
         }
 
-	if ( ! exists  $h2_folders_all{ $h2_fold }  ) {
-		create_folder( $imap2, $h2_fold, $h1_fold ) or next FOLDER ;
-	}
+        if ( ! exists  $h2_folders_all{ $h2_fold }  ) {
+                create_folder( $imap2, $h2_fold, $h1_fold ) or next FOLDER ;
+        }
 
-	acls_sync( $h1_fold, $h2_fold ) ;
+        acls_sync( $h1_fold, $h2_fold ) ;
 
         # Sometimes the folder on host2 is listed (it exists) but is
         # not selectable but becomes selectable by a create (Gmail)
-	select_folder( $imap2, $h2_fold, 'Host2' )
+        select_folder( $imap2, $h2_fold, 'Host2' )
         or ( create_folder( $imap2, $h2_fold, $h1_fold )
              and select_folder( $imap2, $h2_fold, 'Host2' ) )
         or next FOLDER ;
-	my @select_results = $imap2->Results(  ) ;
+        my @select_results = $imap2->Results(  ) ;
 
-	my $h2_fold_nb_messages = count_from_select( @select_results ) ;
+        my $h2_fold_nb_messages = count_from_select( @select_results ) ;
         myprint( "Host2 folder [$h2_fold] has $h2_fold_nb_messages messages in total (mentioned by SELECT)\n" ) ;
 
-	my $permanentflags2 = permanentflags( @select_results ) ;
-	( $debug or $debugflags ) and myprint( "Host2 folder [$h2_fold] permanentflags: $permanentflags2\n"  ) ;
+        my $permanentflags2 = permanentflags( @select_results ) ;
+        myprint( "Host2 folder [$h2_fold] permanentflags: $permanentflags2\n"  ) ;
 
-	if ( $expunge or $expunge1 ){
-		myprint( "Host1: Expunging $h1_fold $dry_message\n"  ) ;
-		unless( $dry ) { $imap1->expunge(  ) } ;
-	}
+        if ( $expunge1 ){
+                myprint( "Host1: Expunging $h1_fold $sync->{dry_message}\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap1->expunge(  ) } ;
+        }
 
-	if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribeall )
+        if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribeall )
              and not exists  $h2_subscribed_folder{ $h2_fold }  ) {
-		myprint( "Host2: Subscribing to folder $h2_fold\n"  ) ;
-		unless( $dry ) { $imap2->subscribe( $h2_fold ) } ;
-	}
+                myprint( "Host2: Subscribing to folder $h2_fold\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap2->subscribe( $h2_fold ) } ;
+        }
 
-	next FOLDER if ( $justfolders ) ;
+        next FOLDER if ( $justfolders ) ;
 
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
         my $h1_msgs_all_hash_ref = {  } ;
-	my @h1_msgs = select_msgs( $imap1, $h1_msgs_all_hash_ref, $search1, $h1_fold );
-	last FOLDER if $imap1->IsUnconnected(  ) ;
+        my @h1_msgs = select_msgs( $imap1, $h1_msgs_all_hash_ref, $search1, $sync->{abletosearch1}, $h1_fold );
+
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
         my $h1_msgs_nb = scalar  @h1_msgs  ;
         $h1{ $h1_fold }{ 'messages_nb' } = $h1_msgs_nb ;
 
-	myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages\n"  ) ;
-	( $debug or $debuglist ) and myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages, LIST gives: @h1_msgs\n" ) ;
+        myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages\n"  ) ;
+        ( $debug or $debuglist ) and myprint( "Host1 folder [$h1_fold] considering $h1_msgs_nb messages, LIST gives: @h1_msgs\n" ) ;
         $debug and myprint( "Host1 selecting messages of folder [$h1_fold] took ", timenext(), " s\n" ) ;
 
         my $h2_msgs_all_hash_ref = {  } ;
-	my @h2_msgs = select_msgs( $imap2, $h2_msgs_all_hash_ref, $search2, $h2_fold ) ;
-	last FOLDER if $imap2->IsUnconnected(  ) ;
+        my @h2_msgs = select_msgs( $imap2, $h2_msgs_all_hash_ref, $search2, $sync->{abletosearch2}, $h2_fold ) ;
+
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
         my $h2_msgs_nb = scalar  @h2_msgs  ;
         $h2{ $h2_fold }{ 'messages_nb' } = $h2_msgs_nb ;
 
-	myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages\n" ) ;
-	( $debug or $debuglist ) and myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages, LIST gives: @h2_msgs\n" ) ;
+        myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages\n" ) ;
+        ( $debug or $debuglist ) and myprint( "Host2 folder [$h2_fold] considering $h2_msgs_nb messages, LIST gives: @h2_msgs\n" ) ;
         $debug and myprint( "Host2 selecting messages of folder [$h2_fold] took ", timenext(), " s\n" ) ;
 
-	my $cache_base = "$tmpdir/imapsync_cache/" ;
-	my $cache_dir = cache_folder( $cache_base, "$host1/$user1/$host2/$user2", $h1_fold, $h2_fold ) ;
-	my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ) ;
+        my $cache_base = "$tmpdir/imapsync_cache/" ;
+        my $cache_dir = cache_folder( $cache_base, "$sync->{host1}/$sync->{user1}/$sync->{host2}/$sync->{user2}", $h1_fold, $h2_fold ) ;
+        my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ) ;
 
-	my $h1_uidvalidity = $imap1->uidvalidity(  ) || q{} ;
-	my $h2_uidvalidity = $imap2->uidvalidity(  ) || q{} ;
+        my $h1_uidvalidity = $imap1->uidvalidity(  ) || q{} ;
+        my $h2_uidvalidity = $imap2->uidvalidity(  ) || q{} ;
 
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-	if ( $usecache ) {
-		myprint( "cache directory: $cache_dir\n"  ) ;
-		mkpath( "$cache_dir" ) ;
-		( $cache_1_2_ref, $cache_2_1_ref )
+        if ( $usecache ) {
+                myprint( "cache directory: $cache_dir\n"  ) ;
+                mkpath( "$cache_dir" ) ;
+                ( $cache_1_2_ref, $cache_2_1_ref )
                 = get_cache( $cache_dir, \@h1_msgs, \@h2_msgs, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
-		myprint( 'CACHE h1 h2: ', scalar  keys %{ $cache_1_2_ref } , " files\n"  ) ;
-		$debug and myprint( '[',
-		    map ( { "$_->$cache_1_2_ref->{$_} " } keys %{ $cache_1_2_ref } ), " ]\n" ) ;
-	}
-
-	my %h1_hash = () ;
-	my %h2_hash = () ;
-
-	my ( %h1_msgs, %h2_msgs ) ;
-	@h1_msgs{ @h1_msgs } = ();
-	@h2_msgs{ @h2_msgs } = ();
-
-	my @h1_msgs_in_cache = sort { $a <=> $b } keys %{ $cache_1_2_ref } ;
-	my @h2_msgs_in_cache = keys %{ $cache_2_1_ref } ;
-
-	my ( %h1_msgs_not_in_cache, %h2_msgs_not_in_cache ) ;
-	%h1_msgs_not_in_cache = %h1_msgs ;
-	%h2_msgs_not_in_cache = %h2_msgs ;
-	delete @h1_msgs_not_in_cache{ @h1_msgs_in_cache } ;
-	delete @h2_msgs_not_in_cache{ @h2_msgs_in_cache } ;
-
-	my @h1_msgs_not_in_cache = keys %h1_msgs_not_in_cache ;
-	#myprint( "h1_msgs_not_in_cache: [@h1_msgs_not_in_cache]\n"  ) ;
-	my @h2_msgs_not_in_cache = keys %h2_msgs_not_in_cache ;
-
-	my @h2_msgs_delete2_not_in_cache = () ;
-	%h1_msgs_copy_by_uid = (  ) ;
-
-	if ( $useuid ) {
-		# use uid so we have to avoid getting header
-		@h1_msgs_copy_by_uid{ @h1_msgs_not_in_cache } = (  ) ;
-		@h2_msgs_delete2_not_in_cache = @h2_msgs_not_in_cache if $usecache ;
-		@h1_msgs_not_in_cache = (  ) ;
-		@h2_msgs_not_in_cache = (  ) ;
-
-		#myprint( "delete2: @h2_msgs_delete2_not_in_cache\n" ) ;
-	}
-
-	$debug and myprint( "Host1 parsing headers of folder [$h1_fold]\n" ) ;
-
-	my ($h1_heads_ref, $h1_fir_ref) = ({}, {});
-	$h1_heads_ref = $imap1->parse_headers([@h1_msgs_not_in_cache], @useheader) if (@h1_msgs_not_in_cache);
-	$debug and myprint( "Host1 parsing headers of folder [$h1_fold] took ", timenext(), " s\n" ) ;
-
-	@{ $h1_fir_ref }{@h1_msgs} = ( undef ) ;
-
-	$debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold]\n"  ) ;
-        if ( $abletosearch ) {
-		$h1_fir_ref = $imap1->fetch_hash( \@h1_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
-	  	if ( @h1_msgs ) ;
-        }else{
-		my $uidnext = $imap1->uidnext( $h1_fold ) || $uidnext_default ;
-		my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-		$h1_fir_ref = $imap1->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
-		if ( @h1_msgs ) ;
+                myprint( 'CACHE h1 h2: ', scalar  keys %{ $cache_1_2_ref } , " files\n"  ) ;
+                $debug and myprint( '[',
+                    map ( { "$_->$cache_1_2_ref->{$_} " } keys %{ $cache_1_2_ref } ), " ]\n" ) ;
         }
-	$debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n"  ) ;
-	unless ($h1_fir_ref) {
-		my $error = join( q{}, "Host1 folder $h1_fold: Could not fetch_hash ",
-			scalar @h1_msgs, ' msgs: ', $imap1->LastError || q{}, "\n" ) ;
-		errors_incr( $sync, $error ) ;
-		next FOLDER ;
-	}
 
-	my @h1_msgs_duplicate;
-	foreach my $m (@h1_msgs_not_in_cache) {
-		my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, 'Host1', \%h1_hash);
-		if (! defined $rc) {
-			my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
-			myprint( "Host1 $h1_fold/$m size $h1_size ignored (no wanted headers so we ignore this message. To solve this: use --addheader)\n"  ) ;
-			$total_bytes_skipped += $h1_size;
-			$nb_msg_skipped += 1;
-			$h1_nb_msg_noheader +=1;
+        my %h1_hash = () ;
+        my %h2_hash = () ;
+
+        my ( %h1_msgs, %h2_msgs ) ;
+        @h1_msgs{ @h1_msgs } = ();
+        @h2_msgs{ @h2_msgs } = ();
+
+        my @h1_msgs_in_cache = sort { $a <=> $b } keys %{ $cache_1_2_ref } ;
+        my @h2_msgs_in_cache = keys %{ $cache_2_1_ref } ;
+
+        my ( %h1_msgs_not_in_cache, %h2_msgs_not_in_cache ) ;
+        %h1_msgs_not_in_cache = %h1_msgs ;
+        %h2_msgs_not_in_cache = %h2_msgs ;
+        delete @h1_msgs_not_in_cache{ @h1_msgs_in_cache } ;
+        delete @h2_msgs_not_in_cache{ @h2_msgs_in_cache } ;
+
+        my @h1_msgs_not_in_cache = keys %h1_msgs_not_in_cache ;
+        #myprint( "h1_msgs_not_in_cache: [@h1_msgs_not_in_cache]\n"  ) ;
+        my @h2_msgs_not_in_cache = keys %h2_msgs_not_in_cache ;
+
+        my @h2_msgs_delete2_not_in_cache = () ;
+        %h1_msgs_copy_by_uid = (  ) ;
+
+        if ( $useuid ) {
+                # use uid so we have to avoid getting header
+                @h1_msgs_copy_by_uid{ @h1_msgs_not_in_cache } = (  ) ;
+                @h2_msgs_delete2_not_in_cache = @h2_msgs_not_in_cache if $usecache ;
+                @h1_msgs_not_in_cache = (  ) ;
+                @h2_msgs_not_in_cache = (  ) ;
+
+                #myprint( "delete2: @h2_msgs_delete2_not_in_cache\n" ) ;
+        }
+
+        $debug and myprint( "Host1 parsing headers of folder [$h1_fold]\n" ) ;
+
+        my ($h1_heads_ref, $h1_fir_ref) = ({}, {});
+        $h1_heads_ref = $imap1->parse_headers([@h1_msgs_not_in_cache], @useheader) if (@h1_msgs_not_in_cache);
+        $debug and myprint( "Host1 parsing headers of folder [$h1_fold] took ", timenext(), " s\n" ) ;
+
+        @{ $h1_fir_ref }{@h1_msgs} = ( undef ) ;
+
+        $debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold]\n"  ) ;
+        if ( $sync->{abletosearch1} ) {
+                $h1_fir_ref = $imap1->fetch_hash( \@h1_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
+                if ( @h1_msgs ) ;
+        }else{
+                my $uidnext = $imap1->uidnext( $h1_fold ) || $uidnext_default ;
+                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+                $h1_fir_ref = $imap1->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h1_fir_ref )
+                if ( @h1_msgs ) ;
+        }
+        $debug and myprint( "Host1 getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n"  ) ;
+        if ( ! $h1_fir_ref ) {
+                my $error = join( q{}, "Host1 folder $h1_fold: Could not fetch_hash ",
+                        scalar @h1_msgs, ' msgs: ', $imap1->LastError || q{}, "\n" ) ;
+                errors_incr( $sync, $error ) ;
+                next FOLDER ;
+        }
+
+        my @h1_msgs_duplicate;
+        foreach my $m (@h1_msgs_not_in_cache) {
+                my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, 'Host1', \%h1_hash);
+                if ( ! defined $rc ) {
+                        my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
+                        myprint( "Host1 $h1_fold/$m size $h1_size ignored (no wanted headers so we ignore this message. To solve this: use --addheader)\n"  ) ;
+                        $total_bytes_skipped += $h1_size;
+                        $nb_msg_skipped += 1;
+                        $h1_nb_msg_noheader +=1;
                         $h1_nb_msg_processed +=1 ;
-		} elsif(0 == $rc) {
-			# duplicate
-			push @h1_msgs_duplicate, $m;
-			# duplicate, same id same size?
-			my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
-			$nb_msg_skipped += 1;
-			$h1_total_bytes_duplicate += $h1_size;
-			$h1_nb_msg_duplicate += 1;
+                } elsif(0 == $rc) {
+                        # duplicate
+                        push @h1_msgs_duplicate, $m;
+                        # duplicate, same id same size?
+                        my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
+                        $nb_msg_skipped += 1;
+                        $h1_total_bytes_duplicate += $h1_size;
+                        $h1_nb_msg_duplicate += 1;
                         $h1_nb_msg_processed +=1 ;
-		}
-	}
+                }
+        }
         my $h1_msgs_duplicate_nb = scalar  @h1_msgs_duplicate  ;
         $h1{ $h1_fold }{ 'duplicates_nb' } = $h1_msgs_duplicate_nb ;
 
         $debug and myprint( "Host1 selected: $h1_msgs_nb  duplicates: $h1_msgs_duplicate_nb\n"  ) ;
-	$debug and myprint( 'Host1 whole time parsing headers took ', timenext(), " s\n"  ) ;
-
-	$debug and myprint( "Host2 parsing headers of folder [$h2_fold]\n" ) ;
-
-	my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} );
-	$h2_heads_ref =   $imap2->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache);
-	$debug and myprint( "Host2 parsing headers of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
-
-	$debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold]\n"  ) ;
-	@{ $h2_fir_ref }{@h2_msgs} = (  ); # fetch_hash can select by uid with last arg as ref
+        $debug and myprint( 'Host1 whole time parsing headers took ', timenext(), " s\n"  ) ;
+	# Getting headers and metada can be so long that host2 might be disconnected here
+        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
 
-        if ( $abletosearch ) {
-		$h2_fir_ref = $imap2->fetch_hash( \@h2_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref)
-		if (@h2_msgs) ;
+        $debug and myprint( "Host2 parsing headers of folder [$h2_fold]\n" ) ;
+
+        my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} );
+        $h2_heads_ref =   $imap2->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache);
+        $debug and myprint( "Host2 parsing headers of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
+
+        $debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold]\n"  ) ;
+        @{ $h2_fir_ref }{@h2_msgs} = (  ); # fetch_hash can select by uid with last arg as ref
+
+
+        if ( $sync->{abletosearch2} and scalar( @h2_msgs ) ) {
+                $h2_fir_ref = $imap2->fetch_hash( \@h2_msgs, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref) ;
         }else{
-		my $uidnext = $imap2->uidnext( $h2_fold ) || $uidnext_default ;
-		my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-		$h2_fir_ref = $imap2->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref )
-		if ( @h2_msgs ) ;
+                my $uidnext = $imap2->uidnext( $h2_fold ) || $uidnext_default ;
+                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+                $h2_fir_ref = $imap2->fetch_hash( $fetch_hash_uids, 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE', $h2_fir_ref )
+                if ( @h2_msgs ) ;
         }
 
-	$debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
+        $debug and myprint( "Host2 getting flags idate and sizes of folder [$h2_fold] took ", timenext(), " s\n"  ) ;
 
-	my @h2_msgs_duplicate;
-	foreach my $m (@h2_msgs_not_in_cache) {
-		my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, 'Host2', \%h2_hash) ;
-		my $h2_size = $h2_fir_ref->{$m}->{'RFC822.SIZE'} || 0 ;
-		if (! defined  $rc  ) {
+        my @h2_msgs_duplicate;
+        foreach my $m (@h2_msgs_not_in_cache) {
+                my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, 'Host2', \%h2_hash) ;
+                my $h2_size = $h2_fir_ref->{$m}->{'RFC822.SIZE'} || 0 ;
+                if (! defined  $rc  ) {
                         myprint( "Host2 $h2_fold/$m size $h2_size ignored (no wanted headers so we ignore this message)\n"  ) ;
-			$h2_nb_msg_noheader += 1 ;
-		} elsif( 0 == $rc ) {
-			# duplicate
-			$h2_nb_msg_duplicate += 1 ;
-			$h2_total_bytes_duplicate += $h2_size ;
-			push  @h2_msgs_duplicate, $m  ;
-		}
-	}
+                        $h2_nb_msg_noheader += 1 ;
+                } elsif( 0 == $rc ) {
+                        # duplicate
+                        $h2_nb_msg_duplicate += 1 ;
+                        $h2_total_bytes_duplicate += $h2_size ;
+                        push  @h2_msgs_duplicate, $m  ;
+                }
+        }
 
         # %h2_folders_of_md5
         foreach my $md5 (  keys  %h2_hash  ) {
-        	$h2_folders_of_md5{ $md5 }->{ $h2_fold } ++ ;
+                $h2_folders_of_md5{ $md5 }->{ $h2_fold } ++ ;
         }
 
 
@@ -1897,271 +1905,272 @@ FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) {
         $h2{ $h2_fold }{ 'duplicates_nb' } = $h2_msgs_duplicate_nb ;
 
         myprint( "Host2 folder $h2_fold selected: $h2_msgs_nb messages,  duplicates: $h2_msgs_duplicate_nb\n" )
-        	if ( $debug or $delete2duplicates or $h2_msgs_duplicate_nb ) ;
-	$debug and myprint( 'Host2 whole time parsing headers took ', timenext(  ), " s\n"  ) ;
+                if ( $debug or $delete2duplicates or $h2_msgs_duplicate_nb ) ;
+        $debug and myprint( 'Host2 whole time parsing headers took ', timenext(  ), " s\n"  ) ;
 
-	$debug and myprint( "++++ Verifying [$h1_fold] -> [$h2_fold]\n" ) ;
-	# messages in host1 that are not in host2
+        $debug and myprint( "++++ Verifying [$h1_fold] -> [$h2_fold]\n" ) ;
+        # messages in host1 that are not in host2
 
-	my @h1_hash_keys_sorted_by_uid
-	  = sort {$h1_hash{$a}{'m'} <=> $h1_hash{$b}{'m'}} keys %h1_hash;
+        my @h1_hash_keys_sorted_by_uid
+          = sort {$h1_hash{$a}{'m'} <=> $h1_hash{$b}{'m'}} keys %h1_hash;
 
-	#myprint( map { $h1_hash{$_}{'m'} . q{ }} @h1_hash_keys_sorted_by_uid ) ;
+        #myprint( map { $h1_hash{$_}{'m'} . q{ }} @h1_hash_keys_sorted_by_uid ) ;
 
-	my @h2_hash_keys_sorted_by_uid
-	  = sort {$h2_hash{$a}{'m'} <=> $h2_hash{$b}{'m'}} keys %h2_hash;
+        my @h2_hash_keys_sorted_by_uid
+          = sort {$h2_hash{$a}{'m'} <=> $h2_hash{$b}{'m'}} keys %h2_hash;
 
 
-	if( $delete2duplicates and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
-		my @h2_expunge ;
+        if( $delete2duplicates and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
+                my @h2_expunge ;
 
-		foreach my $h2_msg ( @h2_msgs_duplicate ) {
-			myprint( "msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $dry_message\n"  ) ;
-			push  @h2_expunge, $h2_msg  if $uidexpunge2 ;
-			unless ( $dry ) {
-				$imap2->delete_message( $h2_msg ) ;
-				$h2_nb_msg_deleted += 1 ;
-			}
-		}
-		my $cnt = scalar @h2_expunge ;
-		if( @h2_expunge and not $expunge2 ) {
-			myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $dry_message\n"  ) ;
-			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
-		}
-        	if ( $expunge2 ){
-                	myprint( "Host2: Expunging folder $h2_fold $dry_message\n"  ) ;
-                	$imap2->expunge(  ) if ! $dry ;
-        	}
-	}
-
-	if( $delete2 and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
-        	# No host1 folders f1a f1b ... going all to same f2 (via --regextrans2)
-		my @h2_expunge;
-		foreach my $m_id (@h2_hash_keys_sorted_by_uid) {
-			#myprint( "$m_id " ) ;
-			unless (exists $h1_hash{$m_id}) {
-				my $h2_msg  = $h2_hash{$m_id}{'m'};
-				my $h2_flags  = $h2_hash{$m_id}{'F'} || q{};
-				my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0;
-				myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted on host2 [$m_id] $dry_message\n" )
-				  if ! $isdel;
-				push @h2_expunge, $h2_msg if $uidexpunge2;
-				unless ($dry or $isdel) {
-					$imap2->delete_message($h2_msg);
-					$h2_nb_msg_deleted += 1;
-				}
-			}
-		}
-		foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
-			myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $dry_message\n" ) ;
-                        push @h2_expunge, $h2_msg if $uidexpunge2;
-			unless ($dry) {
-				$imap2->delete_message($h2_msg);
-				$h2_nb_msg_deleted += 1;
-			}
-		}
-		my $cnt = scalar @h2_expunge ;
-
-		if( @h2_expunge and not $expunge2 ) {
-			myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $dry_message\n"  ) ;
-			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
-		}
-        	if ( $expunge2 ) {
-                	myprint( "Host2: Expunging folder $h2_fold $dry_message\n"  ) ;
-                	$imap2->expunge(  ) if ! $dry ;
-        	}
-	}
-
-	if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  ) {
-        	myprint( "Host2 folder $h2_fold $h2_folders_from_1_several{ $h2_fold } folders left to sync there\n"  ) ;
-		my @h2_expunge;
-		foreach my $m_id ( @h2_hash_keys_sorted_by_uid ) {
-                	my $h2_msg  = $h2_hash{ $m_id }{ 'm' } ;
-			unless ( exists  $h1_hash{ $m_id }  ) {
-				my $h2_flags  = $h2_hash{ $m_id }{ 'F' } || q{} ;
-				my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0 ;
-				unless ( $isdel ) {
-                                	$debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [$m_id]\n"  ) ;
-					$uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
-				}
-			}else{
-                        	$debug and myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [$m_id]\n"  ) ;
-                        	$uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                foreach my $h2_msg ( @h2_msgs_duplicate ) {
+                        myprint( "msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $sync->{dry_message}\n"  ) ;
+                        push  @h2_expunge, $h2_msg  if $uidexpunge2 ;
+                        if ( ! $sync->{dry} ) {
+                                $imap2->delete_message( $h2_msg ) ;
+                                $h2_nb_msg_deleted += 1 ;
                         }
-		}
-		foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
-			myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [not in cache]\n" ) ;
-                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
-		}
+                }
+                my $cnt = scalar @h2_expunge ;
+                if( @h2_expunge and not $expunge2 ) {
+                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
+                }
+                if ( $expunge2 ){
+                        myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->expunge(  ) if ! $sync->{dry} ;
+                }
+        }
 
-		foreach my $h2_msg ( @h2_msgs_in_cache ) {
-			myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [in cache]\n" ) ;
+        if( $delete2 and not exists  $h2_folders_from_1_several{ $h2_fold }  ) {
+                # No host1 folders f1a f1b ... going all to same f2 (via --regextrans2)
+                my @h2_expunge;
+                foreach my $m_id (@h2_hash_keys_sorted_by_uid) {
+                        #myprint( "$m_id " ) ;
+                        if ( ! exists $h1_hash{$m_id} ) {
+                                my $h2_msg  = $h2_hash{$m_id}{'m'};
+                                my $h2_flags  = $h2_hash{$m_id}{'F'} || q{};
+                                my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0;
+                                myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted on host2 [$m_id] $sync->{dry_message}\n" )
+                                  if ! $isdel;
+                                push @h2_expunge, $h2_msg if $uidexpunge2;
+                                if ( ! ( $sync->{dry} or $isdel ) ) {
+                                        $imap2->delete_message($h2_msg);
+                                        $h2_nb_msg_deleted += 1;
+                                }
+                        }
+                }
+                foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $sync->{dry_message}\n" ) ;
+                        push @h2_expunge, $h2_msg if $uidexpunge2;
+                        if ( ! $sync->{dry} ) {
+                                $imap2->delete_message($h2_msg);
+                                $h2_nb_msg_deleted += 1;
+                        }
+                }
+                my $cnt = scalar @h2_expunge ;
+
+                if( @h2_expunge and not $expunge2 ) {
+                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
+                }
+                if ( $expunge2 ) {
+                        myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->expunge(  ) if ! $sync->{dry} ;
+                }
+        }
+
+        if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  ) {
+                myprint( "Host2 folder $h2_fold $h2_folders_from_1_several{ $h2_fold } folders left to sync there\n"  ) ;
+                my @h2_expunge;
+                foreach my $m_id ( @h2_hash_keys_sorted_by_uid ) {
+                        my $h2_msg  = $h2_hash{ $m_id }{ 'm' } ;
+                        if ( ! exists  $h1_hash{ $m_id }  ) {
+                                my $h2_flags  = $h2_hash{ $m_id }{ 'F' } || q{} ;
+                                my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0 ;
+                                if ( ! $isdel ) {
+                                        $debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [$m_id]\n"  ) ;
+                                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
+                                }
+                        }else{
+                                $debug and myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [$m_id]\n"  ) ;
+                                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                        }
+                }
+                foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [not in cache]\n" ) ;
+                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
+                }
+
+                foreach my $h2_msg ( @h2_msgs_in_cache ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [in cache]\n" ) ;
                         $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
-		}
+                }
 
 
                 if ( 0 == $h2_folders_from_1_several{ $h2_fold } ) {
-                	# last host1 folder going to $h2_fold
+                        # last host1 folder going to $h2_fold
                         myprint( "Last host1 folder going to $h2_fold\n"  ) ;
                         foreach my $h2_msg ( keys %{ $uid_candidate_for_deletion{ $h2_fold } } ) {
-                        	$debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion\n"  ) ;
+                                $debug and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion\n"  ) ;
                                 if ( exists  $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }  ) {
-                                	$debug and myprint( "Host2: msg $h2_fold/$h2_msg canceled deletion\n"  ) ;
+                                        $debug and myprint( "Host2: msg $h2_fold/$h2_msg canceled deletion\n"  ) ;
                                 }else{
-                                	myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted $dry_message\n" ) ;
+                                        myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted $sync->{dry_message}\n" ) ;
                                         push  @h2_expunge, $h2_msg  if $uidexpunge2 ;
-                                        unless ( $dry ) {
-                                        	$imap2->delete_message( $h2_msg ) ;
-                                        	$h2_nb_msg_deleted += 1 ;
+                                        if ( ! $sync->{dry} ) {
+                                                $imap2->delete_message( $h2_msg ) ;
+                                                $h2_nb_msg_deleted += 1 ;
                                         }
                                 }
                         }
                 }
 
-		my $cnt = scalar @h2_expunge ;
-		if( @h2_expunge and not $expunge2 ) {
-			myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $dry_message\n"  ) ;
-			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
-		}
-        	if ( $expunge2 ) {
-                	myprint( "Host2: Expunging host2 folder $h2_fold $dry_message\n"  ) ;
-                	$imap2->expunge(  ) if ! $dry ;
-        	}
+                my $cnt = scalar @h2_expunge ;
+                if( @h2_expunge and not $expunge2 ) {
+                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
+                }
+                if ( $expunge2 ) {
+                        myprint( "Host2: Expunging host2 folder $h2_fold $sync->{dry_message}\n"  ) ;
+                        $imap2->expunge(  ) if ! $sync->{dry} ;
+                }
 
                 $h2_folders_from_1_several{ $h2_fold }-- ;
-	}
+        }
 
-
-	my $h2_uidnext = $imap2->uidnext( $h2_fold ) ;
+        my $h2_uidnext = $imap2->uidnext( $h2_fold ) ;
         $debug and myprint( "Host2 uidnext: $h2_uidnext\n"  ) ;
-	$h2_uidguess = $h2_uidnext ;
-	MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) {
-        	last FOLDER if $imap1->IsUnconnected(  ) ;
-                last FOLDER if $imap2->IsUnconnected(  ) ;
+        $h2_uidguess = $h2_uidnext ;
 
-		#myprint( "h1_nb_msg_processed: $h1_nb_msg_processed\n"  ) ;
-		my $h1_size  = $h1_hash{$m_id}{'s'};
-		my $h1_msg   = $h1_hash{$m_id}{'m'};
-		my $h1_idate = $h1_hash{$m_id}{'D'};
+	# Getting host2 headers, metada and delete2 stuff can be so long that host1 might be disconnected here
+        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-		if ( ( not exists  $h2_hash{ $m_id }  )
-                	and ( not ( exists $h2_folders_of_md5{ $m_id } )
+        MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) {
+		if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
+
+                #myprint( "h1_nb_msg_processed: $h1_nb_msg_processed\n"  ) ;
+                my $h1_size  = $h1_hash{$m_id}{'s'};
+                my $h1_msg   = $h1_hash{$m_id}{'m'};
+                my $h1_idate = $h1_hash{$m_id}{'D'};
+
+                if ( ( not exists  $h2_hash{ $m_id }  )
+                        and ( not ( exists $h2_folders_of_md5{ $m_id } )
                               or not $skipcrossduplicates ) ) {
-			# copy
-			my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
+                        # copy
+                        my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
                         $h2_folders_of_md5{ $m_id }->{ $h2_fold } ++ ;
                         if( $delete2 and ( exists $h2_folders_from_1_several{ $h2_fold } ) and $h2_msg ) {
-                        	myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
-	                        $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                                myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
+                                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
                         }
                         last FOLDER if total_bytes_max_reached(  ) ;
-			next MESS;
-		}
-		else{
-		        # already on host2
+                        next MESS;
+                }
+                else{
+                        # already on host2
                         if ( exists  $h2_hash{ $m_id }  ) {
-				my $h2_msg   = $h2_hash{$m_id}{'m'} ;
-				$debug and myprint( "Host1 found msg $h1_fold/$h1_msg equals Host2 $h2_fold/$h2_msg\n"  ) ;
+                                my $h2_msg   = $h2_hash{$m_id}{'m'} ;
+                                $debug and myprint( "Host1 found msg $h1_fold/$h1_msg equals Host2 $h2_fold/$h2_msg\n"  ) ;
                                 if ( $usecache ) {
-                                	$debugcache and myprint( "touch $cache_dir/${h1_msg}_$h2_msg\n"  ) ;
-                                	touch( "$cache_dir/${h1_msg}_$h2_msg" )
+                                        $debugcache and myprint( "touch $cache_dir/${h1_msg}_$h2_msg\n"  ) ;
+                                        touch( "$cache_dir/${h1_msg}_$h2_msg" )
                                         or croak( "Couldn't touch $cache_dir/${h1_msg}_$h2_msg" ) ;
                                 }
                         }elsif( exists  $h2_folders_of_md5{ $m_id }  ) {
-                        	my @folders_dup = keys  %{ $h2_folders_of_md5{ $m_id } }  ;
-                        	( $debug or $debugcrossduplicates ) and myprint( "Host1 found msg $h1_fold/$h1_msg is also in Host2 folders @folders_dup\n"  ) ;
+                                my @folders_dup = keys  %{ $h2_folders_of_md5{ $m_id } }  ;
+                                ( $debug or $debugcrossduplicates ) and myprint( "Host1 found msg $h1_fold/$h1_msg is also in Host2 folders @folders_dup\n"  ) ;
                         }
-			$total_bytes_skipped += $h1_size ;
-			$nb_msg_skipped += 1 ;
+                        $total_bytes_skipped += $h1_size ;
+                        $nb_msg_skipped += 1 ;
                         $h1_nb_msg_processed +=1 ;
                 }
 
                 if ( exists  $h2_hash{ $m_id }  ) {
-			#$debug and myprint( "MESSAGE $m_id\n" ) ;
-			my $h2_msg  = $h2_hash{$m_id}{'m'};
+                        #$debug and myprint( "MESSAGE $m_id\n" ) ;
+                        my $h2_msg  = $h2_hash{$m_id}{'m'};
 
-                	sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
-	    		# Good
-			my $h2_size = $h2_hash{$m_id}{'s'};
-			$debug and myprint(
-			"Host1 size  msg $h1_fold/$h1_msg = $h1_size <> $h2_size = Host2 $h2_fold/$h2_msg\n" ) ;
-		}
-                last FOLDER if $imap2->IsUnconnected(  ) ;
-
-		if ( $delete ) {
-			delete_message_on_host1( $h1_msg, $h1_fold ) ;
-		}
-	}
-	# END MESS: loop
-        last FOLDER if $imap1->IsUnconnected(  ) ;
-        last FOLDER if $imap2->IsUnconnected(  ) ;
-	MESS_IN_CACHE: foreach my $h1_msg ( @h1_msgs_in_cache ) {
-		my $h2_msg = $cache_1_2_ref->{ $h1_msg } ;
-		$debugcache and myprint( "cache messages update flags $h1_msg->$h2_msg\n" ) ;
-		sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
-		my $h1_size = $h1_fir_ref->{ $h1_msg }->{ 'RFC822.SIZE' } || 0 ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-                $h1_nb_msg_processed +=1 ;
-                last FOLDER if $imap2->IsUnconnected(  ) ;
-	}
-
-	#myprint( "Messages by uid: ", map { "$_ " } keys %h1_msgs_copy_by_uid, "\n"  ) ;
-	MESS_BY_UID: foreach my $h1_msg ( sort { $a <=> $b } keys %h1_msgs_copy_by_uid ) {
-		#
-		$debug and myprint( "Copy by uid $h1_fold/$h1_msg\n"  ) ;
-                last FOLDER if $imap1->IsUnconnected(  ) ;
-                last FOLDER if $imap2->IsUnconnected(  ) ;
-		my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
-                if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  and $h2_msg ) {
-                	myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
-	                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                        sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
+                        # Good
+                        my $h2_size = $h2_hash{$m_id}{'s'};
+                        $debug and myprint(
+                        "Host1 size  msg $h1_fold/$h1_msg = $h1_size <> $h2_size = Host2 $h2_fold/$h2_msg\n" ) ;
                 }
-		last FOLDER if total_bytes_max_reached(  ) ;
-	}
 
-	if ( $expunge or $expunge1 ){
-		myprint( "Host1: Expunging folder $h1_fold $dry_message\n"  ) ;
-		unless( $dry ) { $imap1->expunge(  ) } ;
-	}
-	if ( $expunge2 ){
-		myprint( "Host2: Expunging folder $h2_fold $dry_message\n"  ) ;
-		unless( $dry ) { $imap2->expunge(  ) } ;
-	}
-	$debug and myprint( 'Time: ', timenext(  ), " s\n"  ) ;
-}
+		if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
 
-sub total_bytes_max_reached {
+                if ( $delete1 ) {
+                        delete_message_on_host1( $h1_msg, $h1_fold ) ;
+                }
+        }
+        # END MESS: loop
+	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
+        MESS_IN_CACHE: foreach my $h1_msg ( @h1_msgs_in_cache ) {
+                my $h2_msg = $cache_1_2_ref->{ $h1_msg } ;
+                $debugcache and myprint( "cache messages update flags $h1_msg->$h2_msg\n" ) ;
+                sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
+                my $h1_size = $h1_fir_ref->{ $h1_msg }->{ 'RFC822.SIZE' } || 0 ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                $h1_nb_msg_processed +=1 ;
+                if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
 
-	return( 0 ) if not $exitwhenover ;
-	if ( $total_bytes_transferred >= $exitwhenover ) {
-        	myprint( "Maximum bytes transferred reached, $total_bytes_transferred >= $exitwhenover, ending sync\n"  ) ;
-        	return( 1 ) ;
         }
 
+        #myprint( "Messages by uid: ", map { "$_ " } keys %h1_msgs_copy_by_uid, "\n"  ) ;
+        MESS_BY_UID: foreach my $h1_msg ( sort { $a <=> $b } keys %h1_msgs_copy_by_uid ) {
+                #
+                $debug and myprint( "Copy by uid $h1_fold/$h1_msg\n"  ) ;
+                if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
+
+                my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
+                if( $delete2 and exists  $h2_folders_from_1_several{ $h2_fold }  and $h2_msg ) {
+                        myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
+                        $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
+                }
+                last FOLDER if total_bytes_max_reached(  ) ;
+        }
+
+        if ( $expunge1 ){
+                myprint( "Host1: Expunging folder $h1_fold $sync->{dry_message}\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap1->expunge(  ) } ;
+        }
+        if ( $expunge2 ){
+                myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
+                if ( ! $sync->{dry} ) { $imap2->expunge(  ) } ;
+        }
+        $debug and myprint( 'Time: ', timenext(  ), " s\n"  ) ;
 }
 
+
 myprint( "++++ End looping on each folder\n"  ) ;
+
+if ( $delete1 and $sync->{'delete1emptyfolders'} ) {
+	delete1emptyfolders( $sync ) ;
+}
+
 ( $debug or $sync->{debugfolders} ) and myprint( 'Time: ', timenext(  ), " s\n"  ) ;
 
 
 if ( $foldersizesatend ) {
-	myprint( << 'END_SIZE'  ) ;
+        myprint( << 'END_SIZE'  ) ;
 
 Folders sizes after the synchronization.
 You can remove this foldersizes listing by using  "--nofoldersizesatend"
 END_SIZE
 
-	foldersizesatend(  ) ;
+        foldersizesatend(  ) ;
 }
 
-$imap1->logout(  ) unless lost_connection( $imap1, "for host1 [$host1]" ) ;
-$imap2->logout(  ) unless lost_connection( $imap2, "for host2 [$host2]" ) ;
+if ( ! lost_connection( $imap1, "for host1 [$sync->{host1}]" ) ) { $imap1->logout(  )  ; }
+if ( ! lost_connection( $imap2, "for host2 [$sync->{host2}]" ) ) { $imap2->logout(  )  ; }
 
 stats( $sync ) ;
 myprint( errorsdump( $sync->{nb_errors}, errors_log( $sync ) ) ) if ( $sync->{errorsdump} ) ;
-tests_live_result( $sync->{nb_errors} ) if ( $testslive ) ;
+tests_live_result( $sync->{nb_errors} ) if ( $sync->{testslive} or $sync->{testslive6} ) ;
+
+
 exit_clean( $sync, $EXIT_WITH_ERRORS ) if ( $sync->{nb_errors} ) ;
 exit_clean( $sync, $EX_OK ) ;
 
@@ -2169,28 +2178,403 @@ exit_clean( $sync, $EX_OK ) ;
 
 
 # subroutines
-sub  myprint  { return print  @ARG ; } 
-sub  myprintf { return printf @ARG ; } 
+sub myprint  { return print  @ARG ; }
+sub myprintf { return printf @ARG ; }
 
 sub mysprintf {
         my( $format, @list ) = @ARG ;
-        return sprintf $format, @list ; 
+        return sprintf $format, @list ;
 }
 
-sub unsetunsafe {
-        # Remove all content in unsafe evalued options
-        @regextrans2 = (  ) ;
-        @regexflag = (  ) ;
-        @regexmess = (  ) ;
-        @skipmess = (  ) ;
-        @pipemess = (  ) ;
-        $delete2foldersonly = undef ;
-        $delete2foldersbutnot = undef ;
-        return ;
+sub output_start {
+	my $mysync = shift @ARG ;
+
+	if ( not $mysync ) { return ; }
+
+	my @output = @ARG ;
+	$mysync->{ output } = join( q{}, @output ) . ( $mysync->{ output } || q{} ) ;
+	return $mysync->{ output } ;
 }
 
+sub tests_output_start {
+	note( 'Entering tests_output_start()' ) ;
+
+	my $mysync = { } ;
+
+	is( undef, output_start(  ), 'output_start: no args => undef' ) ;
+	is( q{}, output_start( $mysync ), 'output_start: one arg => ""' ) ;
+	is( 'rrrr', output_start( $mysync, 'rrrr' ), 'output_start: rrrr => rrrr' ) ;
+	is( 'aaaarrrr', output_start( $mysync, 'aaaa' ), 'output_start: aaaa => aaaarrrr' ) ;
+	is( "\naaaarrrr", output_start( $mysync, "\n" ), 'output_start: \n => \naaaarrrr' ) ;
+	is( "ABC\naaaarrrr", output_start( $mysync, 'A', 'B', 'C' ), 'output_start: A B C => ABC\naaaarrrr' ) ;
+
+	note( 'Leaving  tests_output_start()' ) ;
+	return ;
+}
+
+sub tests_output {
+	note( 'Entering tests_output()' ) ;
+
+	my $mysync = { } ;
+
+	is( undef, output(  ), 'output: no args => undef' ) ;
+	is( q{}, output( $mysync ), 'output: one arg => ""' ) ;
+	is( 'rrrr', output( $mysync, 'rrrr' ), 'output: rrrr => rrrr' ) ;
+	is( 'rrrraaaa', output( $mysync, 'aaaa' ), 'output: aaaa => rrrraaaa' ) ;
+	is( "rrrraaaa\n", output( $mysync, "\n" ), 'output: \n => rrrraaaa\n' ) ;
+	is( "rrrraaaa\nABC", output( $mysync, 'A', 'B', 'C' ), 'output: A B C => rrrraaaaABC\n' ) ;
+
+	note( 'Leaving  tests_output()' ) ;
+	return ;
+}
+
+sub output {
+	my $mysync = shift @ARG ;
+
+	if ( not $mysync ) { return ; }
+
+	my @output = @ARG ;
+	$mysync->{ output } .= join( q{}, @output ) ;
+	return $mysync->{ output } ;
+}
+
+
+
+sub tests_output_reset_with {
+	note( 'Entering tests_output_reset_with()' ) ;
+
+	my $mysync = { } ;
+
+	is( undef,  output_reset_with(  ), 'output_reset_with: no args => undef' ) ;
+	is( q{},    output_reset_with( $mysync ), 'output_reset_with: one arg => ""' ) ;
+	is( 'rrrr', output_reset_with( $mysync, 'rrrr' ), 'output_reset_with: rrrr => rrrr' ) ;
+	is( 'aaaa', output_reset_with( $mysync, 'aaaa' ), 'output_reset_with: aaaa => aaaa' ) ;
+	is( "\n",   output_reset_with( $mysync, "\n" ), 'output_reset_with: \n => \n' ) ;
+
+	note( 'Leaving  tests_output_reset_with()' ) ;
+	return ;
+}
+
+sub output_reset_with {
+	my $mysync = shift @ARG ;
+
+	if ( not $mysync ) { return ; }
+
+	my @output = @ARG ;
+	$mysync->{ output } = join( q{}, @output ) ;
+	return $mysync->{ output } ;
+}
+
+
+
+sub abort  {
+	my $mysync = shift @ARG ;
+	if ( ! -r $sync->{pidfile} ) {
+		myprint( "Can not read pidfile $sync->{pidfile}. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	my $pidtokill = firstline( $sync->{pidfile} ) ;
+	if ( ! $pidtokill ) {
+		myprint( "No process to abort. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	# First ask for suicide
+	if ( kill 'ZERO', $pidtokill ) {
+		myprint( "Sending signal QUIT to PID $pidtokill \n" ) ;
+		kill 'QUIT', $pidtokill ;
+		sleep 1 ;
+	}else{
+		myprint( "Can not send signal to PID $pidtokill. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	# Then murder
+	if ( kill 'ZERO', $pidtokill ) {
+		myprint( "Sending signal KILL to PID $pidtokill \n" ) ;
+		kill 'KILL', $pidtokill ;
+		sleep 1 ;
+	}else{
+		myprint( "Process PID $pidtokill ended. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+	# Well ...
+	if ( kill 'ZERO', $pidtokill ) {
+		myprint( "Process PID $pidtokill still there. Can not do much. Exiting.\n" ) ;
+		exit $EX_OK ;
+	}
+
+	return ;
+}
+
+
+
+sub docker_context {
+	my $mysync = shift ;
+	-e '/.dockerenv'  || return ;
+	myprint( "Docker context detected with /.dockerenv\n" ) ;
+	# No pidfile
+	$mysync->{pidfile} = q{} ;
+	# No log
+	$mysync->{log} = 0 ;
+	# In case
+	myprint( "Changing current directory to /var/tmp/\n" ) ;
+	chdir '/var/tmp/' ;
+	
+	return ;
+}
+
+sub cgibegin {
+	if ( ! under_cgi_context(  ) ) { return ; }
+	my $mysync = shift ;
+	require CGI ;
+	CGI->import( qw( -no_debug ) ) ;
+	require CGI::Carp ;
+	CGI::Carp->import( qw( fatalsToBrowser ) ) ;
+	$mysync->{cgi} = CGI->new( ) ;
+	return ;
+}
+
+sub tests_under_cgi_context {
+	note( 'Entering tests_under_cgi_context()' ) ;
+	# $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
+	do {
+		# Not in cgi context
+		delete local $ENV{SERVER_SOFTWARE} ;
+		is( undef, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE unset => not in cgi context' ) ;
+	} ;
+	do {
+		# In cgi context
+		local $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
+		is( 1, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE set => in cgi context' ) ;
+	} ;
+	do {
+		# Not in cgi context
+		delete local $ENV{SERVER_SOFTWARE} ;
+		is( undef, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE unset => not in cgi context' ) ;
+	} ;
+	do {
+		# In cgi context
+		local $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
+		is( 1, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE set => in cgi context' ) ;
+	} ;
+	note( 'Leaving  tests_under_cgi_context()' ) ;
+	return ;
+}
+
+
+sub under_cgi_context {
+
+	# Under cgi context
+	if ( $ENV{SERVER_SOFTWARE} ) {
+		return 1 ;
+	}
+	# Not in cgi context
+	return ;
+}
+
+sub cgibuildheader {
+	if ( ! under_cgi_context(  ) ) { return ; }
+	my $mysync = shift ;
+
+	my $imapsync_runs = $mysync->{cgi}->cookie( 'imapsync_runs' ) || 0 ;
+	my $cookie = $mysync->{cgi}->cookie(
+			-name => 'imapsync_runs',
+			-value => 1 + $imapsync_runs,
+			-expires => '+20y',
+			-path    => '/cgi-bin/imapsync',
+		) ;
+	my $httpheader ;
+	if ( $mysync->{ abort } ) {
+		$httpheader = $mysync->{cgi}->header(
+			-type   => 'text/plain',
+			-status => '200 OK to stop playing IMAP mailboxes' . ". Load is $mysync->{ loadavg }",
+		) ;
+	}elsif( $mysync->{ loaddelay } ) {
+# https://tools.ietf.org/html/rfc2616#section-10.5.4
+# 503 Service Unavailable
+# The server is currently unable to handle the request due to a temporary overloading or maintenance of the server.
+		$httpheader = $mysync->{cgi}->header(
+			-type   => 'text/plain',
+			-status => '503 Service Unavailable' . ". Be back in $mysync->{ loaddelay } min. Load is $mysync->{ loadavg }",
+		) ;
+	}else{
+		$httpheader = $mysync->{cgi}->header(
+		-type   => 'text/plain',
+		-status => '200 OK to play IMAP mailboxes' . ". Load is $mysync->{ loadavg }",
+		-cookie => $cookie,
+		) ;
+	}
+	output_start( $mysync, $httpheader ) ;
+
+	return ;
+}
+
+sub cgiload {
+	if ( ! under_cgi_context(  ) ) { return ; }
+	my $mysync = shift ;
+	if ( $mysync->{ abort } ) { return ; } # keep going to abort
+	if ( $mysync->{ loaddelay } ) {
+		myprint( "Server is on heavy load. Be back in $mysync->{ loaddelay } min. Load is $mysync->{ loadavg }\n") ;
+		exit_clean( $mysync, $EX_UNAVAILABLE ) ;
+	}
+	return ;
+}
+
+sub tests_set_umask {
+	note( 'Entering tests_set_umask()' ) ;
+	my $save_umask = umask ;
+
+	my $mysync = {} ;
+	if ( 'MSWin32' eq $OSNAME ) {
+		is( undef, set_umask( $mysync ), "set_umask: set failure to $UMASK_PARANO on MSWin32" ) ;
+	}else{
+		is( 1, set_umask( $mysync ), "set_umask: set to $UMASK_PARANO" ) ;
+	}
+
+	umask $save_umask ;
+	note( 'Leaving  tests_set_umask()' ) ;
+	return ;
+}
+
+sub set_umask {
+	my $mysync = shift ;
+	my $previous_umask = umask_str(  ) ;
+	my $new_umask = umask_str( $UMASK_PARANO ) ;
+	output( $mysync, "Umask set with $new_umask (was $previous_umask)\n" ) ;
+	if ( $new_umask eq $UMASK_PARANO ) {
+		return 1 ;
+	}
+	return ;
+}
+
+sub tests_umask_str {
+	note( 'Entering tests_umask_str()' ) ;
+	my $save_umask = umask ;
+
+	is( umask_str(  ), umask_str(  ),  'umask_str: no parameters => idopotent' ) ;
+	is( my $save_umask_str = umask_str(  ), umask_str(  ),  'umask_str: no parameters => idopotent + save' ) ;
+	is( '0000', umask_str(    q{ } ),  'umask_str:  q{ } => 0000' ) ;
+	is( '0000', umask_str(     q{} ),  'umask_str:   q{} => 0000' ) ;
+	is( '0000', umask_str(  '0000' ),  'umask_str:  0000 => 0000' ) ;
+	is( '0000', umask_str(     '0' ),  'umask_str:     0 => 0000' ) ;
+	is( '0200', umask_str(  '0200' ),  'umask_str:  0200 => 0200' ) ;
+	is( '0400', umask_str(  '0400' ),  'umask_str:  0400 => 0400' ) ;
+	is( '0600', umask_str(  '0600' ),  'umask_str:  0600 => 0600' ) ;
+
+	SKIP: {
+	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests success only for Unix', 6 ) ; }
+	is( '0100', umask_str(  '0100' ),  'umask_str:  0100 => 0100' ) ;
+	is( '0001', umask_str(  '0001' ),  'umask_str:  0001 => 0001' ) ;
+	is( '0777', umask_str(  '0777' ),  'umask_str:  0777 => 0777' ) ;
+	is( '0777', umask_str( '00777' ),  'umask_str: 00777 => 0777' ) ;
+	is( '0777', umask_str( ' 777 ' ),  'umask_str:  777  => 0777' ) ;
+	is( "$UMASK_PARANO", umask_str( $UMASK_PARANO ),   "umask_str: UMASK_PARANO $UMASK_PARANO => $UMASK_PARANO" ) ;
+	}
+
+	is( $save_umask_str, umask_str( $save_umask_str ),  'umask_str: restore with str' ) ;
+	is( $save_umask, umask, 'umask_str: umask is restored, controlled by direct umask' ) ;
+	is( $save_umask, umask $save_umask, 'umask_str: umask is restored by direct umask' ) ;
+	is( $save_umask, umask, 'umask_str: umask initial controlled by direct umask' ) ;
+
+	note( 'Leaving  tests_umask_str()' ) ;
+	return ;
+}
+
+sub umask_str {
+	my $value = shift ;
+
+	if ( defined $value ) {
+		umask oct( $value ) ;
+	}
+	my $current = umask ;
+
+	return( sprintf( '%#04o', $current ) ) ;
+}
+
+sub tests_umask {
+	note( 'Entering tests_umask()' ) ;
+	my $save_umask ;
+	is( umask, umask, 'umask: umask is umask' ) ;
+	is( $save_umask = umask, umask, "umask: umask is umask again + save it: $save_umask" ) ;
+	is( $save_umask, umask oct(0000), 'umask: umask 0000' ) ;
+	is( oct(0000), umask, 'umask: umask is now 0000' ) ;
+	is( oct(0000), umask oct(777), 'umask: umask 0777 call, previous 0000' ) ;
+
+	SKIP: {
+	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests success only for Unix', 2 ) ; }
+	is( oct(777), umask, 'umask: umask is now  0777' ) ;
+	is( oct(777), umask $save_umask, "umask: umask $save_umask restore inital value, previous 0777" ) ;
+	}
+
+	ok( defined umask $save_umask, "umask: umask $save_umask restore inital value, previous defined" ) ;
+	is( $save_umask, umask, 'umask: umask is umask restored' ) ;
+	note( 'Leaving  tests_umask()' ) ;
+
+	return ;
+}
+
+sub cgisetcontext {
+	if ( ! under_cgi_context(  ) ) { return ; }
+
+	my $mysync = shift @ARG ;
+	output( $mysync, "Under cgi context\n" ) ;
+	set_umask( $mysync ) ;
+
+        # Remove all content in unsafe evaled options
+        @regextrans2 = (  ) ;
+        @regexflag   = (  ) ;
+        @regexmess   = (  ) ;
+        @skipmess    = (  ) ;
+        @pipemess    = (  ) ;
+        $delete2foldersonly   = undef ;
+        $delete2foldersbutnot = undef ;
+	$maxlinelengthcmd     = undef ;
+
+	# Set safe default values (I hope...)
+
+	$mysync->{pidfile} =  'imapsync.pid' ;
+	$mysync->{pidfilelocking} = 1 ;
+	$mysync->{errorsmax} = $ERRORS_MAX_CGI ;
+	$modulesversion = 0 ;
+	$releasecheck = 1 ;
+	$usecache = 0 ;
+	$mysync->{showpasswords} = 0 ;
+	$debugimap1 = $debugimap2 = $debugimap = 0 ;
+	$reconnectretry1 = $reconnectretry2 = $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
+	$pipemesscheck = 0 ;
+
+	$mysync->{hashfile} = $CGI_HASHFILE ;
+	my $hashsynclocal = hashsynclocal( $mysync ) || die "Can not get hashsynclocal. Exiting\n" ;
+	$cgidir = $CGI_TMPDIR_TOP . '/' . $hashsynclocal ;
+
+        -d $cgidir or mkpath $cgidir or die "Can not create $cgidir: $OS_ERROR\n" ;
+        chdir  $cgidir or die "Can not cd to $cgidir: $OS_ERROR\n" ;
+	$tmpdir = $cgidir ;
+	cgioutputenvcontext( $mysync ) ;
+        $debug and output( $mysync, 'Current directory is ' . getcwd(  ) . "\n" ) ;
+        $debug and output( $mysync, 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
+        $debug and output( $mysync, 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;
+
+	return ;
+}
+
+sub cgioutputenvcontext {
+	my $mysync = shift @ARG ;
+
+	for my $envvar ( qw( REMOTE_ADDR REMOTE_HOST HTTP_REFERER HTTP_USER_AGENT HTTP_COOKIE ) ) {
+
+		my $envval = $ENV{ $envvar } || q{} ;
+		if ( $envval ) { output( $mysync, "$envvar is $envval\n" ) } ;
+	}
+
+	return ;
+}
+
+
+
+
+
 sub debugsleep {
-        my $mysync = shift ;
+        my $mysync = shift @ARG ;
         if ( defined $mysync->{debugsleep} ) {
                 myprint( "Info: sleeping $mysync->{debugsleep}s\n" ) ;
                 sleep $mysync->{debugsleep} ;
@@ -2199,15 +2583,15 @@ sub debugsleep {
 }
 
 sub foldersizes_on_h1h2 {
-	myprint( << 'END_SIZE'  ) ;
+        myprint( << 'END_SIZE'  ) ;
 
 Folders sizes before the synchronization.
 You can remove foldersizes listings by using "--nofoldersizes" and  "--nofoldersizesatend"
 but then you will also loose the ETA (Estimation Time of Arrival) given after each message copy.
 END_SIZE
 
-	( $h1_nb_msg_start, $h1_bytes_start ) = foldersizes( 'Host1', $imap1, $search1, @h1_folders_wanted        ) ;
-	( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( 'Host2', $imap2, $search2, @h2_folders_from_1_wanted ) ;
+        ( $h1_nb_msg_start, $h1_bytes_start ) = foldersizes( 'Host1', $imap1, $search1, $sync->{abletosearch1}, @h1_folders_wanted        ) ;
+        ( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( 'Host2', $imap2, $search2, $sync->{abletosearch2}, @h2_folders_from_1_wanted ) ;
 
         if ( not all_defined( $h1_nb_msg_start, $h1_bytes_start, $h2_nb_msg_start, $h2_bytes_start ) ) {
                 my $error = "Failure getting foldersizes, ETA and final diff will not be displayed\n" ;
@@ -2216,16 +2600,29 @@ END_SIZE
                 $foldersizesatend = 0 ;
                 return ;
         }
-        
-        my $h2_bytes_limit = $sync->{host2}->{quota_limit_bytes} || 0 ;
+
+        my $h2_bytes_limit = $sync->{h2}->{quota_limit_bytes} || 0 ;
         if ( $h2_bytes_limit and ( $h2_bytes_limit < $h1_bytes_start ) ) {
-        	my $quota_percent = mysprintf( '%.0f', $h1_bytes_start/$h2_bytes_limit ) ;
+                my $quota_percent = mysprintf( '%.0f', $NUMBER_100 * $h1_bytes_start / $h2_bytes_limit ) ;
                 my $error = "Host2: Quota limit will be exceeded! Over $quota_percent % ( $h1_bytes_start bytes / $h2_bytes_limit bytes )\n" ;
                 errors_incr( $sync, $error ) ;
         }
         return ;
 }
 
+
+sub total_bytes_max_reached {
+
+        return( 0 ) if not $exitwhenover ;
+        if ( $sync->{total_bytes_transferred} >= $exitwhenover ) {
+                myprint( "Maximum bytes transferred reached, $sync->{total_bytes_transferred} >= $exitwhenover, ending sync\n"  ) ;
+                return( 1 ) ;
+        }
+
+}
+
+
+
 sub all_defined {
         if ( not @ARG ) {
                 return 0 ;
@@ -2239,6 +2636,8 @@ sub all_defined {
 }
 
 sub tests_all_defined {
+	note( 'Entering tests_all_defined()' ) ;
+
         is( 0, all_defined(  ),             'all_defined: no param  => 0' ) ;
         is( 0, all_defined( () ),           'all_defined: void list => 0' ) ;
         is( 0, all_defined( undef ),        'all_defined: undef     => 0' ) ;
@@ -2247,171 +2646,346 @@ sub tests_all_defined {
         is( 0, all_defined( undef, 1 ),     'all_defined: undef 1   => 0' ) ;
         is( 1, all_defined( 1, 1 ),         'all_defined: 1 1   => 1' ) ;
         is( 1, all_defined( (1, 1) ),       'all_defined: (1 1) => 1' ) ;
+
+	note( 'Leaving  tests_all_defined()' ) ;
         return ;
 }
 
 
-sub imap_id_stuff {
-	my $sync = shift ;
+sub tests_hashsynclocal {
+	note( 'Entering tests_hashsynclocal()' ) ;
 
-	if ( not $sync->{id} ) { return ; } ;
+	my $mysync = {
+		host1 => '',
+		user1 => '',
+		password1 => '',
+		host2 => '',
+		user2 => '',
+		password2 => '',
+	} ;
 
-	$sync->{h1_imap_id} = imap_id( $sync->{imap1}, 'Host1' ) ;
-	#myprint( 'Host1: ' . $sync->{h1_imap_id}  ) ;
-	$sync->{h2_imap_id} = imap_id( $sync->{imap2}, 'Host2' ) ;
-	#myprint( 'Host2: ' . $sync->{h2_imap_id}  ) ;
+	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: no hashfile name' ) ;
 
+	$mysync->{ hashfile } = '' ;
+	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: empty hashfile name' ) ;
+
+	$mysync->{ hashfile } = './noexist/rrr' ;
+	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: no exists hashfile dir' ) ;
+
+	SKIP: {
+		if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests only for Unix', 1 ) ; }
+		$mysync->{ hashfile } = '/rrr' ;
+		is( undef, hashsynclocal( $mysync ), 'hashsynclocal: permission denied' ) ;
+	}
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'hashsynclocal: mkpath W/tmp/tests/' ) ;
+	$mysync->{ hashfile } = 'W/tmp/tests/imapsync_hash' ;
+
+	ok( ! -e 'W/tmp/tests/imapsync_hash' || unlink 'W/tmp/tests/imapsync_hash', 'hashsynclocal: unlink W/tmp/tests/imapsync_hash' ) ;
+	ok( ! -e 'W/tmp/tests/imapsync_hash', 'hashsynclocal: verify there is no W/tmp/tests/imapsync_hash' ) ;
+	is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync, 'mukksyhpmbixkxkpjlqivmlqsulpictj' ), 'hashsynclocal: creating/reading W/tmp/tests/imapsync_hash' ) ;
+	# A second time now
+	is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync ), 'hashsynclocal: reading W/tmp/tests/imapsync_hash second time => same' ) ;
+
+	note( 'Leaving  tests_hashsynclocal()' ) ;
 	return ;
 }
 
+sub hashsynclocal {
+	my $mysync = shift ;
+	my $hashkey = shift ; # Optional, only there for tests
+	my $hashfile = $mysync->{ hashfile } ;
+	$hashfile = createhashfileifneeded( $hashfile, $hashkey ) ;
+	if ( ! $hashfile ) {
+		return ;
+	}
+	$hashkey = firstline( $hashfile ) ;
+	if ( ! $hashkey ) {
+		myprint( "No hashkey!\n" ) ;
+		return ;
+	}
+	my $hashsynclocal = hashsync( $mysync, $hashkey ) ;
+	return( $hashsynclocal ) ;
+
+}
+
+sub tests_hashsync {
+	note( 'Entering tests_hashsync()' ) ;
+
+
+	is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hashsync( {}, q{} ), 'hashsync: empty args' ) ;
+	my $mysync ;
+	$mysync->{ host1 } = 'zzz' ;
+	is( 'e86a28a3611c1e7bbaf8057cd00ae122781a11fe', hashsync( $mysync, q{} ), 'hashsync: host1 zzz => ' ) ;
+	is( 'e86a28a3611c1e7bbaf8057cd00ae122781a11fe', hashsync( $mysync, q{} ), 'hashsync: host1 zzz => ' ) ;
+	$mysync->{ host2 } = 'zzz' ;
+	is( '15959573e4a86763253a7aedb1a2b0c60d133dc2', hashsync( $mysync, q{} ), 'hashsync: + host2 zzz => ' ) ;
+	is( 'b8d4ab541b209c75928528020ca28ee43488bd8f', hashsync( $mysync, 'A' ), 'hashsync: + hashkey A => ' ) ;
+
+	note( 'Leaving  tests_hashsync()' ) ;
+	return ;
+}
+
+sub hashsync {
+	my $mysync  = shift ;
+	my $hashkey = shift ;
+
+	my $mystring = join( q{},
+		$mysync->{ host1 }     || q{},
+		$mysync->{ user1 }     || q{},
+		$mysync->{ password1 } || q{},
+		$mysync->{ host2 }     || q{},
+		$mysync->{ user2 }     || q{},
+		$mysync->{ password2 } || q{},
+	) ;
+	my $hashsync = hmac_sha1_hex( $mystring, $hashkey ) ;
+	#myprint( "$hashsync\n" ) ;
+	return( $hashsync ) ;
+}
+
+
+sub tests_createhashfileifneeded {
+	note( 'Entering tests_createhashfileifneeded()' ) ;
+
+	is( undef, createhashfileifneeded(  ), 'createhashfileifneeded: no parameters => undef' ) ;
+
+	note( 'Leaving  tests_createhashfileifneeded()' ) ;
+	return ;
+}
+
+sub createhashfileifneeded {
+	my $hashfile = shift ;
+	my $hashkey  = shift || rand32(  ) ;
+
+	# no name
+	if ( ! $hashfile ) {
+		return ;
+	}
+	# already there
+	if ( -e -r $hashfile ) {
+		return $hashfile ;
+	}
+	# not creatable
+	if ( ! -w dirname( $hashfile ) ) {
+		return ;
+	}
+	# creatable
+	open my $FILE_HANDLE, '>', $hashfile
+                or do {
+                        myprint( "Could not open $hashfile for writing. Check permissions or disk space."  ) ;
+                return ;
+        } ;
+        myprint( "Writing random hashkey in $hashfile, once for all times\n"  ) ;
+        print $FILE_HANDLE $hashkey ;
+        close $FILE_HANDLE ;
+	# Should be there now
+	if ( -e -r $hashfile ) {
+		return $hashfile ;
+	}
+	# unknown failure
+	return ;
+}
+
+sub tests_rand32 {
+	note( 'Entering tests_rand32()' ) ;
+
+	my $string = rand32(  ) ;
+	print "$string\n" ;
+	is( 32, length( $string ),    'rand32: 32 characters long' ) ;
+	is( 32, length( rand32(  ) ), 'rand32: 32 characters long, another one' ) ;
+
+	note( 'Leaving  tests_rand32()' ) ;
+	return ;
+}
+
+sub rand32 {
+	my @chars = ( "a".."z" ) ;
+	my $string;
+	$string .= $chars[rand @chars] for 1..32 ;
+	return $string ;
+}
+
+sub imap_id_stuff {
+        my $mysync = shift ;
+
+        if ( not $mysync->{id} ) { return ; } ;
+
+        $mysync->{h1_imap_id} = imap_id( $mysync, $mysync->{imap1}, 'Host1' ) ;
+        #myprint( 'Host1: ' . $mysync->{h1_imap_id}  ) ;
+        $mysync->{h2_imap_id} = imap_id( $mysync, $mysync->{imap2}, 'Host2' ) ;
+        #myprint( 'Host2: ' . $mysync->{h2_imap_id}  ) ;
+
+        return ;
+}
+
 sub imap_id {
-	my ( $imap, $Side ) = @_ ;
+        my ( $mysync, $imap, $Side ) = @_ ;
 
-	$Side ||= q{} ;
-	my $imap_id_response = q{} ;
+        $Side ||= q{} ;
+        my $imap_id_response = q{} ;
 
-	if ( not $imap->has_capability( 'ID' ) ) {
-		 $imap_id_response = 'No ID capability' ;
+        if ( not $imap->has_capability( 'ID' ) ) {
+                 $imap_id_response = 'No ID capability' ;
                  myprint( "$Side: No ID capability\n"  ) ;
-	}else{
-		my $id_inp = imapsync_id( { side => lc $Side } ) ;
-		myprint( "\n$Side: found ID capability. Sending/receiving ID, presented in raw IMAP for now.\n"
+        }else{
+                my $id_inp = imapsync_id( $mysync, { side => lc $Side } ) ;
+                myprint( "\n$Side: found ID capability. Sending/receiving ID, presented in raw IMAP for now.\n"
                 . "In order to avoid sending/receiving ID, use option --noid\n" ) ;
-		my $debug_before = $imap->Debug(  ) ;
-		$imap->Debug( 1 ) ;
-		my $id_out = $imap->tag_and_run( 'ID ' . $id_inp ) ;
-		#my $id_out = $imap->tag_and_run( 'ID NIL' ) ;
+                my $debug_before = $imap->Debug(  ) ;
+                $imap->Debug( 1 ) ;
+                my $id_out = $imap->tag_and_run( 'ID ' . $id_inp ) ;
+                #my $id_out = $imap->tag_and_run( 'ID NIL' ) ;
                 myprint( "\n"  ) ;
-		$imap->Debug( $debug_before ) ;
-		#$imap_id_response = Data::Dumper->Dump( [ $id_out ], [ 'IMAP_ID' ] ) ;
-	}
-	return( $imap_id_response ) ;
+                $imap->Debug( $debug_before ) ;
+                #$imap_id_response = Data::Dumper->Dump( [ $id_out ], [ 'IMAP_ID' ] ) ;
+        }
+        return( $imap_id_response ) ;
 }
 
 sub imapsync_id {
-	my $overhashref = shift ;
-	# See http://tools.ietf.org/html/rfc2971.html
+        my $mysync = shift ;
+        my $overhashref = shift ;
+        # See http://tools.ietf.org/html/rfc2971.html
 
-	my $imapsync_id = { } ;
+        my $imapsync_id = { } ;
 
-	my $imapsync_id_lamiral = {
-		name          => 'imapsync',
-		version       => imapsync_version(  ),
-		os            => $OSNAME,
-		vendor        => 'Gilles LAMIRAL',
-		'support-url' => 'http://imapsync.lamiral.info/',
-		# Example of date-time:  19-Sep-2015 08:56:07
-		date          => date_from_rcs( q{$Date: 2016/08/19 10:30:36 $ } ),
-	} ;
+        my $imapsync_id_lamiral = {
+                name          => 'imapsync',
+                version       => imapsync_version( $mysync ),
+                os            => $OSNAME,
+                vendor        => 'Gilles LAMIRAL',
+                'support-url' => 'http://imapsync.lamiral.info/',
+                # Example of date-time:  19-Sep-2015 08:56:07
+                date          => date_from_rcs( q{$Date: 2017/09/05 16:14:53 $ } ),
+        } ;
 
-	my $imapsync_id_github  = {
-		name          => 'imapsync',
-		version       => imapsync_version(  ),
-		os            => $OSNAME,
-		vendor        => 'github',
-		'support-url' => 'https://github.com/imapsync/imapsync',
-		date          => date_from_rcs( q{$Date: 2016/08/19 10:30:36 $ } ),
-	} ;
+        my $imapsync_id_github  = {
+                name          => 'imapsync',
+                version       => imapsync_version( $mysync ),
+                os            => $OSNAME,
+                vendor        => 'github',
+                'support-url' => 'https://github.com/imapsync/imapsync',
+                date          => date_from_rcs( q{$Date: 2017/09/05 16:14:53 $ } ),
+        } ;
 
-	$imapsync_id = $imapsync_id_lamiral ;
-	#$imapsync_id = $imapsync_id_github ;
-	my %mix = ( %{ $imapsync_id }, %{ $overhashref } ) ;
-	my $imapsync_id_str = format_for_imap_arg( \%mix ) ;
-	#myprint( "$imapsync_id_str\n"  ) ;
-	return( $imapsync_id_str ) ;
+        $imapsync_id = $imapsync_id_lamiral ;
+        #$imapsync_id = $imapsync_id_github ;
+        my %mix = ( %{ $imapsync_id }, %{ $overhashref } ) ;
+        my $imapsync_id_str = format_for_imap_arg( \%mix ) ;
+        #myprint( "$imapsync_id_str\n"  ) ;
+        return( $imapsync_id_str ) ;
 }
 
 sub tests_imapsync_id {
-	ok( '("name" "imapsync" "version" "111" "os" "beurk" "vendor" "Gilles LAMIRAL" "support-url" "http://imapsync.lamiral.info/" "date" "22-12-1968" "side" "host1")'
-	eq imapsync_id( {
-		version => 111,
-		os => 'beurk',
-		date => '22-12-1968',
-		side => 'host1' } ),
-	'tests_imapsync_id override' ) ;
+	note( 'Entering tests_imapsync_id()' ) ;
 
-	return ;
+        my $mysync ;
+        ok( '("name" "imapsync" "version" "111" "os" "beurk" "vendor" "Gilles LAMIRAL" "support-url" "http://imapsync.lamiral.info/" "date" "22-12-1968" "side" "host1")'
+                eq imapsync_id( $mysync,
+                        {
+                        version => 111,
+                        os => 'beurk',
+                        date => '22-12-1968',
+                        side => 'host1' 
+                        }
+                ),
+                'tests_imapsync_id override' 
+        ) ;
+
+	note( 'Leaving  tests_imapsync_id()' ) ;
+        return ;
 }
 
 sub format_for_imap_arg {
-	my $ref = shift ;
+        my $ref = shift ;
 
-	my $string = q{} ;
-	my %terms = %{ $ref } ;
-	my @terms = (  ) ;
-	if ( not ( %terms ) ) { return( 'NIL' ) } ;
-	# sort like in RFC then add extra key/values
-	foreach my $key ( qw( name version os os-version vendor support-url address date command arguments environment) ) {
-		if ( $terms{ $key } ) {
-			push  @terms, $key, $terms{ $key }  ;
-			delete $terms{ $key } ;
-		}
-	}
-	push  @terms, %terms  ;
-	$string = '(' . ( join q{ }, map { '"' . $_ . '"' } @terms )  . ')' ;
-	return( $string ) ;
+        my $string = q{} ;
+        my %terms = %{ $ref } ;
+        my @terms = (  ) ;
+        if ( not ( %terms ) ) { return( 'NIL' ) } ;
+        # sort like in RFC then add extra key/values
+        foreach my $key ( qw( name version os os-version vendor support-url address date command arguments environment) ) {
+                if ( $terms{ $key } ) {
+                        push  @terms, $key, $terms{ $key }  ;
+                        delete $terms{ $key } ;
+                }
+        }
+        push  @terms, %terms  ;
+        $string = '(' . ( join q{ }, map { '"' . $_ . '"' } @terms )  . ')' ;
+        return( $string ) ;
 }
 
 
 
 sub tests_format_for_imap_arg {
-	ok( 'NIL' eq format_for_imap_arg( { } ), 'format_for_imap_arg empty hash ref' ) ;
-	ok( '("name" "toto")' eq format_for_imap_arg( { name => 'toto' } ), 'format_for_imap_arg { name => toto }' ) ;
-	ok( '("name" "toto" "key" "val")' eq format_for_imap_arg( { name => 'toto', key => 'val' } ), 'format_for_imap_arg 2 x key val' ) ;
-	return ;
+	note( 'Entering tests_format_for_imap_arg()' ) ;
+
+        ok( 'NIL' eq format_for_imap_arg( { } ), 'format_for_imap_arg empty hash ref' ) ;
+        ok( '("name" "toto")' eq format_for_imap_arg( { name => 'toto' } ), 'format_for_imap_arg { name => toto }' ) ;
+        ok( '("name" "toto" "key" "val")' eq format_for_imap_arg( { name => 'toto', key => 'val' } ), 'format_for_imap_arg 2 x key val' ) ;
+
+	note( 'Leaving  tests_format_for_imap_arg()' ) ;
+        return ;
 }
 
 sub quota {
-	my ( $imap, $side, $sync ) = @_ ;
+        my ( $imap, $side, $mysync ) = @_ ;
 
-        my $Side = ucfirst $side ;
-	my $debug_before = $imap->Debug(  ) ;
-	$imap->Debug( 1 ) ;
-	if ( not $imap->has_capability( 'QUOTA' ) ) {
-        	$imap->Debug( $debug_before ) ;
-        	return ;
+	my %side = (
+		h1 => 'Host1',
+		h2 => 'Host2',
+	) ;
+        my $Side = $side{ $side } ;
+        my $debug_before = $imap->Debug(  ) ;
+        $imap->Debug( 1 ) ;
+        if ( not $imap->has_capability( 'QUOTA' ) ) {
+                $imap->Debug( $debug_before ) ;
+                return ;
         } ;
-	myprint( "\n$Side: found quota, presented in raw IMAP\n"  ) ;
-	my $getquotaroot = $imap->getquotaroot( 'INBOX' ) ;
+        myprint( "\n$Side: found quota, presented in raw IMAP\n"  ) ;
+        my $getquotaroot = $imap->getquotaroot( 'INBOX' ) ;
         # Gmail INBOX quotaroot is "" but with it Mail::IMAPClient does a literal GETQUOTA {2} \n ""
         #$imap->quota( 'ROOT' ) ;
         #$imap->quota( '""' ) ;
-	myprint( "\n"  ) ;
-	$imap->Debug( $debug_before ) ;
+        myprint( "\n"  ) ;
+        $imap->Debug( $debug_before ) ;
         my $quota_limit_bytes   = quota_extract_storage_limit_in_bytes( $getquotaroot ) ;
         my $quota_current_bytes = quota_extract_storage_current_in_bytes( $getquotaroot ) ;
-        $sync->{$side}->{quota_limit_bytes}   = $quota_limit_bytes ;
-        $sync->{$side}->{quota_current_bytes} = $quota_current_bytes ;
+        $mysync->{$side}->{quota_limit_bytes}   = $quota_limit_bytes ;
+        $mysync->{$side}->{quota_current_bytes} = $quota_current_bytes ;
         my $quota_percent ;
         if ( $quota_limit_bytes > 0 ) {
-        	$quota_percent = mysprintf( '%.2f', $NUMBER_100 * $quota_current_bytes / $quota_limit_bytes ) ;
+                $quota_percent = mysprintf( '%.2f', $NUMBER_100 * $quota_current_bytes / $quota_limit_bytes ) ;
         }else{
-        	$quota_percent = 0 ;
+                $quota_percent = 0 ;
         }
         myprint( "$Side: Quota current storage is $quota_current_bytes bytes. Limit is $quota_limit_bytes bytes. So $quota_percent % full\n"  ) ;
         if ( $QUOTA_PERCENT_LIMIT < $quota_percent ) {
-        	my $error = "$Side: $quota_percent % full: it is time to find a bigger place! ( $quota_current_bytes bytes / $quota_limit_bytes bytes )\n" ;
-                errors_incr( $sync, $error ) ;
+                my $error = "$Side: $quota_percent % full: it is time to find a bigger place! ( $quota_current_bytes bytes / $quota_limit_bytes bytes )\n" ;
+                errors_incr( $mysync, $error ) ;
         }
-	return ;
+        return ;
 }
 
 sub tests_quota_extract_storage_limit_in_bytes {
-	my $imap_output = [
-	'* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
+	note( 'Entering tests_quota_extract_storage_limit_in_bytes()' ) ;
+
+        my $imap_output = [
+        '* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
         '* QUOTA "Storage quota" (STORAGE 1 104857600)',
         '* QUOTA "Messages quota" (MESSAGE 2 100000)',
         '5 OK Getquotaroot completed.'
-	] ;
-        ok( $NUMBER_104857600 * $KIBI == quota_extract_storage_limit_in_bytes( $imap_output ), 'quota_extract_storage_limit_in_bytes ') ;
+        ] ;
+        ok( $NUMBER_104_857_600 * $KIBI == quota_extract_storage_limit_in_bytes( $imap_output ), 'quota_extract_storage_limit_in_bytes ') ;
+
+	note( 'Leaving  tests_quota_extract_storage_limit_in_bytes()' ) ;
         return ;
 }
 
 sub quota_extract_storage_limit_in_bytes {
-	my $imap_output = shift ;
+        my $imap_output = shift ;
 
         my $limit_kb ;
-        $limit_kb = ( map { /.*\(\s*STORAGE\s+\d+\s+(\d+)\s*\)/ ? $1 : () } @{ $imap_output } )[0] ;
+        $limit_kb = ( map { /.*\(\s*STORAGE\s+\d+\s+(\d+)\s*\)/x ? $1 : () } @{ $imap_output } )[0] ;
         $limit_kb ||= 0 ;
         $debug and myprint( "storage_limit_kb = $limit_kb\n"  ) ;
         return( $KIBI * $limit_kb ) ;
@@ -2419,21 +2993,26 @@ sub quota_extract_storage_limit_in_bytes {
 
 
 sub tests_quota_extract_storage_current_in_bytes {
-	my $imap_output = [
-	'* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
+	note( 'Entering tests_quota_extract_storage_current_in_bytes()' ) ;
+
+
+        my $imap_output = [
+        '* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
         '* QUOTA "Storage quota" (STORAGE 1 104857600)',
         '* QUOTA "Messages quota" (MESSAGE 2 100000)',
         '5 OK Getquotaroot completed.'
-	] ;
+        ] ;
         ok( 1*$KIBI == quota_extract_storage_current_in_bytes( $imap_output ), 'quota_extract_storage_current_in_bytes: 1 => 1024 ') ;
+
+	note( 'Leaving  tests_quota_extract_storage_current_in_bytes()' ) ;
         return ;
 }
 
 sub quota_extract_storage_current_in_bytes {
-	my $imap_output = shift ;
+        my $imap_output = shift ;
 
         my $current_kb ;
-        $current_kb = ( map { /.*\(\s*STORAGE\s+(\d+)\s+\d+\s*\)/ ? $1 : () } @{ $imap_output } )[0] ;
+        $current_kb = ( map { /.*\(\s*STORAGE\s+(\d+)\s+\d+\s*\)/x ? $1 : () } @{ $imap_output } )[0] ;
         $current_kb ||= 0 ;
         $debug and myprint( "storage_current_kb = $current_kb\n"  ) ;
         return( $KIBI * $current_kb ) ;
@@ -2442,52 +3021,52 @@ sub quota_extract_storage_current_in_bytes {
 
 
 sub automap {
-	my ( $sync ) = @_ ;
+        my ( $mysync ) = @_ ;
 
-	if ( $sync->{automap} ) {
-		myprint( "Turned on automapping folders ( use --noautomap to turn off automapping )\n"  ) ;
-	}else{
-		myprint( "Turned off automapping folders ( use --automap to turn on automapping )\n"  ) ;
-		return ;
-	}
+        if ( $mysync->{automap} ) {
+                myprint( "Turned on automapping folders ( use --noautomap to turn off automapping )\n"  ) ;
+        }else{
+                myprint( "Turned off automapping folders ( use --automap to turn on automapping )\n"  ) ;
+                return ;
+        }
 
-        $sync->{h1_special} = special_from_folders_hash( $sync->{imap1}, 'Host1' ) ;
-        $sync->{h2_special} = special_from_folders_hash( $sync->{imap2}, 'Host2' ) ;
+        $mysync->{h1_special} = special_from_folders_hash( $mysync->{imap1}, 'Host1' ) ;
+        $mysync->{h2_special} = special_from_folders_hash( $mysync->{imap2}, 'Host2' ) ;
 
-	build_possible_special( $sync ) ;
-        build_guess_special(  $sync ) ;
-	build_automap( $sync ) ;
+        build_possible_special( $mysync ) ;
+        build_guess_special(  $mysync ) ;
+        build_automap( $mysync ) ;
 
-	return ;
+        return ;
 }
 
 
 
 
 sub build_guess_special {
-	my ( $sync ) = shift ;
+        my ( $mysync ) = shift ;
 
-        foreach my $h1_fold ( sort keys  %{ $sync->{h1_folders_all} }  ) {
-        	my $special = guess_special( $h1_fold, $sync->{possible_special}, $sync->{h1_prefix} ) ;
-        	if ( $special ) {
-                	$sync->{h1_special_guessed}{$h1_fold} = $special ;
-                        my $already_guessed = $sync->{h1_special_guessed}{$special} ;
+        foreach my $h1_fold ( sort keys  %{ $mysync->{h1_folders_all} }  ) {
+                my $special = guess_special( $h1_fold, $mysync->{possible_special}, $mysync->{h1_prefix} ) ;
+                if ( $special ) {
+                        $mysync->{h1_special_guessed}{$h1_fold} = $special ;
+                        my $already_guessed = $mysync->{h1_special_guessed}{$special} ;
                         if ( $already_guessed ) {
-                        	myprint( "Host1: $h1_fold not $special because set to $already_guessed\n"  ) ;
+                                myprint( "Host1: $h1_fold not $special because set to $already_guessed\n"  ) ;
                         }else{
-	                        $sync->{h1_special_guessed}{$special} = $h1_fold ;
+                                $mysync->{h1_special_guessed}{$special} = $h1_fold ;
                         }
                 }
         }
-        foreach my $h2_fold ( sort keys  %{ $sync->{h2_folders_all} }  ) {
-        	my $special = guess_special( $h2_fold, $sync->{possible_special}, $sync->{h2_prefix} ) ;
-        	if ( $special ) {
-                	$sync->{h2_special_guessed}{$h2_fold} = $special ;
-                        my $already_guessed = $sync->{h2_special_guessed}{$special} ;
+        foreach my $h2_fold ( sort keys  %{ $mysync->{h2_folders_all} }  ) {
+                my $special = guess_special( $h2_fold, $mysync->{possible_special}, $mysync->{h2_prefix} ) ;
+                if ( $special ) {
+                        $mysync->{h2_special_guessed}{$h2_fold} = $special ;
+                        my $already_guessed = $mysync->{h2_special_guessed}{$special} ;
                         if ( $already_guessed ) {
-                        	myprint( "Host2: $h2_fold not $special because set to $already_guessed\n"  ) ;
+                                myprint( "Host2: $h2_fold not $special because set to $already_guessed\n"  ) ;
                         }else{
-	                        $sync->{h2_special_guessed}{$special} = $h2_fold ;
+                                $mysync->{h2_special_guessed}{$special} = $h2_fold ;
                         }
                 }
         }
@@ -2495,153 +3074,179 @@ sub build_guess_special {
 }
 
 sub guess_special {
-	my( $folder, $possible_special_ref, $prefix ) = @_ ;
+        my( $folder, $possible_special_ref, $prefix ) = @_ ;
 
         my $folder_no_prefix = $folder ;
-        $folder_no_prefix =~ s/${prefix}// ;
+        $folder_no_prefix =~ s/\Q${prefix}\E//xms ;
         #$debug and myprint( "folder_no_prefix: $folder_no_prefix\n"  ) ;
 
         my $guess_special = $possible_special_ref->{ $folder }
-        	|| $possible_special_ref->{ $folder_no_prefix }
-        	|| q{} ;
+                || $possible_special_ref->{ $folder_no_prefix }
+                || q{} ;
 
         return( $guess_special ) ;
 }
 
 sub tests_guess_special {
-	my $possible_special_ref = build_possible_special( my $sync ) ;
+	note( 'Entering tests_guess_special()' ) ;
+
+        my $possible_special_ref = build_possible_special( my $mysync ) ;
         ok( '\Sent' eq guess_special( 'Sent', $possible_special_ref, q{} ) ,'guess_special: Sent => \Sent' ) ;
         ok( q{} eq guess_special( 'Blabla', $possible_special_ref, q{} ) ,'guess_special: Blabla => q{}' ) ;
         ok( '\Sent' eq guess_special( 'INBOX.Sent', $possible_special_ref, 'INBOX.' ) ,'guess_special: INBOX.Sent => \Sent' ) ;
-	return ;
+        ok( '\Sent' eq guess_special( 'IN BOX.Sent', $possible_special_ref, 'IN BOX.' ) ,'guess_special: IN BOX.Sent => \Sent' ) ;
+
+	note( 'Leaving  tests_guess_special()' ) ;
+        return ;
 }
 
 sub build_automap {
-	my ( $sync ) = @_ ;
+        my $mysync = shift ;
+	$debug and myprint( "Entering build_automap\n" ) ;
+        foreach my $h1_fold ( @{ $mysync->{h1_folders_wanted} } ) {
+                my $h2_fold ;
+                my $h1_special = $mysync->{h1_special}{$h1_fold} ;
+                my $h1_special_guessed = $mysync->{h1_special_guessed}{$h1_fold} ;
 
-	foreach my $h1_fold ( @{ $sync->{h1_folders_wanted} } ) {
-		my $h2_fold ;
-		my $h1_special = $sync->{h1_special}{$h1_fold} ;
-                my $h1_special_guessed = $sync->{h1_special_guessed}{$h1_fold} ;
-
-		# Case 1: special on both sides.
-		if ( $h1_special
-                     and exists  $sync->{h2_special}{$h1_special}  ) {
-			$h2_fold = $sync->{h2_special}{$h1_special} ;
-			$sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
-		}
-		# Case 2: special on host1, not on host2
-		if ( $h1_special
-                     and ( not exists  $sync->{h2_special}{$h1_special}  )
-                     and ( exists  $sync->{h2_special_guessed}{$h1_special}  )
+                # Case 1: special on both sides.
+                if ( $h1_special
+                     and exists  $mysync->{h2_special}{$h1_special}  ) {
+                        $h2_fold = $mysync->{h2_special}{$h1_special} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
+                }
+                # Case 2: special on host1, not on host2
+                if ( $h1_special
+                     and ( not exists  $mysync->{h2_special}{$h1_special}  )
+                     and ( exists  $mysync->{h2_special_guessed}{$h1_special}  )
                    ) {
-			# special_guessed on host2
-                        $h2_fold = $sync->{h2_special_guessed}{$h1_special} ;
-                        $sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
-		}
-		# Case 3: no special on host1, special on host2
+                        # special_guessed on host2
+                        $h2_fold = $mysync->{h2_special_guessed}{$h1_special} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
+                }
+                # Case 3: no special on host1, special on host2
                 if ( ( not $h1_special )
                      and ( $h1_special_guessed )
-                     and ( exists  $sync->{h2_special}{$h1_special_guessed}  )
+                     and ( exists  $mysync->{h2_special}{$h1_special_guessed}  )
                 ) {
-                	$h2_fold = $sync->{h2_special}{$h1_special_guessed} ;
-                        $sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
+                        $h2_fold = $mysync->{h2_special}{$h1_special_guessed} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
                 }
                 # Case 4: no special on both sides.
                 if ( ( not $h1_special )
                      and ( $h1_special_guessed )
-                     and ( not exists  $sync->{h2_special}{$h1_special_guessed}  )
-                     and ( exists  $sync->{h2_special_guessed}{$h1_special_guessed}  )
+                     and ( not exists  $mysync->{h2_special}{$h1_special_guessed}  )
+                     and ( exists  $mysync->{h2_special_guessed}{$h1_special_guessed}  )
                 ) {
-                	$h2_fold = $sync->{h2_special_guessed}{$h1_special_guessed} ;
-                        $sync->{f1f2auto}{ $h1_fold } = $h2_fold ;
-			next ;
+                        $h2_fold = $mysync->{h2_special_guessed}{$h1_special_guessed} ;
+                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
+                        next ;
                 }
-	}
-	return( $sync->{f1f2auto} ) ;
+        }
+        return( $mysync->{f1f2auto} ) ;
 }
 
 # I willll probably add what there is at:
 # http://stackoverflow.com/questions/2185391/localized-gmail-imap-folders/2185548#2185548
 sub build_possible_special {
-	my $sync = shift ;
-	my $possible_special = { } ;
-	# All|Archive|Drafts|Flagged|Junk|Sent|Trash
+        my $mysync = shift ;
+        my $possible_special = { } ;
+        # All|Archive|Drafts|Flagged|Junk|Sent|Trash
 
-	$possible_special->{'\All'}     = [ 'All', 'All Messages', '&BBIEQQQ1-' ] ;
-	$possible_special->{'\Archive'} = [ 'Archive', 'Archives', '&BBAEQARFBDgEMg-' ] ;
-	$possible_special->{'\Drafts'}  = [ 'Drafts', '&BCcENQRABD0EPgQyBDgEOgQ4-' ] ;
-	$possible_special->{'\Flagged'} = [ 'Flagged', 'Starred', '&BB8EPgQ8BDUERwQ1BD0EPQRLBDU-' ] ;
-	$possible_special->{'\Junk'}    = [ 'Junk', 'Spam', '&BCEEPwQwBDw-' ] ;
-	$possible_special->{'\Sent'}    = [ 'Sent', 'Sent Messages', 'Sent Items',
+        $possible_special->{'\All'}     = [ 'All', 'All Messages', '&BBIEQQQ1-' ] ;
+        $possible_special->{'\Archive'} = [ 'Archive', 'Archives', '&BBAEQARFBDgEMg-' ] ;
+        $possible_special->{'\Drafts'}  = [ 'Drafts', '&BCcENQRABD0EPgQyBDgEOgQ4-' ] ;
+        $possible_special->{'\Flagged'} = [ 'Flagged', 'Starred', '&BB8EPgQ8BDUERwQ1BD0EPQRLBDU-' ] ;
+        $possible_special->{'\Junk'}    = [ 'Junk', 'Spam', '&BCEEPwQwBDw-' ] ;
+        $possible_special->{'\Sent'}    = [ 'Sent', 'Sent Messages', 'Sent Items',
                                             'Gesendete Elemente', 'Gesendete Objekte',
-                                            '&AMk-l&AOk-ments envoy&AOk-s', 'Envoy&AOk-',
+                                            '&AMk-l&AOk-ments envoy&AOk-s', 'Envoy&AOk-', 'Objets envoy&AOk-s',
                                             'Elementos enviados',
                                             '&kAFP4W4IMH8wojCkMMYw4A-',
                                             '&BB4EQgQ,BEAEMAQyBDsENQQ9BD0ESwQ1-'] ;
-	$possible_special->{'\Trash'}   = [ 'Trash', '&BCMENAQwBDsENQQ9BD0ESwQ1-', '&BBoEPgRABDcEOAQ9BDA-' ] ;
+        $possible_special->{'\Trash'}   = [ 'Trash', '&BCMENAQwBDsENQQ9BD0ESwQ1-', '&BBoEPgRABDcEOAQ9BDA-' ] ;
 
-	foreach my $special ( qw( \All \Archive \Drafts \Flagged \Junk \Sent \Trash ) ){
-		foreach my $possible_folder ( @{ $possible_special->{$special} } ) {
-			$possible_special->{ $possible_folder } = $special ;
-		} ;
-	}
-        $sync->{possible_special} = $possible_special ;
-	$debug and myprint( Data::Dumper->Dump( [ $possible_special ], [ 'possible_special' ] )  ) ;
+        foreach my $special ( qw( \All \Archive \Drafts \Flagged \Junk \Sent \Trash ) ){
+                foreach my $possible_folder ( @{ $possible_special->{$special} } ) {
+                        $possible_special->{ $possible_folder } = $special ;
+                } ;
+        }
+        $mysync->{possible_special} = $possible_special ;
+        $debug and myprint( Data::Dumper->Dump( [ $possible_special ], [ 'possible_special' ] )  ) ;
         return( $possible_special ) ;
 }
 
 sub special_from_folders_hash {
-	my ( $imap, $side ) = @_ ;
-	my %special = (  ) ;
-        if ( not( Mail::IMAPClient->can( 'folders_hash' ) ) ) {
-        	my $error =  "$side: To have automagic rfc6154 folder mapping, upgrade Mail::IMAPClient >= 3.34\n" ;
+        my ( $imap, $side ) = @_ ;
+        my %special = (  ) ;
+
+        if ( ! defined $imap  ) { return ; }
+        $side = defined $side ? $side : 'Host?' ;
+
+        if ( ! $imap->can( 'folders_hash' ) ) {
+                my $error =  "$side: To have automagic rfc6154 folder mapping, upgrade Mail::IMAPClient >= 3.34\n" ;
                 errors_incr( $sync, $error ) ;
                 return( \%special ) ; # empty hash ref
         }
-	my $folders_hash = $imap->folders_hash(  ) ;
-	foreach my $fhash (@{ $folders_hash } ) {
-			my @special =  grep { /\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)/ } @{ $fhash->{attrs} }  ;
-			if ( @special ) {
-				my $special = $special[0] ; # keep first one. Could be not very good.
-				if ( exists  $special{ $special }  ) {
-					myprintf( "%s: special %-20s = %s already asigned to %s\n",
-					        $side, $fhash->{name}, join( q{ }, @special ), $special{ $special } ) ;
-				}else{
-					myprintf( "%s: special %-20s = %s\n",
-					        $side, $fhash->{name}, join( q{ }, @special ) ) ;
-					$special{ $special } = $fhash->{name} ;
-					$special{ $fhash->{name} } = $special ; # double entry value => key
-				}
-			}
-		}
+        my $folders_hash = $imap->folders_hash(  ) ;
+        foreach my $fhash (@{ $folders_hash } ) {
+                        my @special =  grep { /\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)/x } @{ $fhash->{attrs} }  ;
+                        if ( @special ) {
+                                my $special = $special[0] ; # keep first one. Could be not very good.
+                                if ( exists  $special{ $special }  ) {
+                                        myprintf( "%s: special %-20s = %s already assigned to %s\n",
+                                                $side, $fhash->{name}, join( q{ }, @special ), $special{ $special } ) ;
+                                }else{
+                                        myprintf( "%s: special %-20s = %s\n",
+                                                $side, $fhash->{name}, join( q{ }, @special ) ) ;
+                                        $special{ $special } = $fhash->{name} ;
+                                        $special{ $fhash->{name} } = $special ; # double entry value => key
+                                }
+                        }
+                }
         myprint( "\n" ) if ( %special ) ;
-	return( \%special ) ;
+        return( \%special ) ;
+}
+
+sub tests_special_from_folders_hash {
+	note( 'Entering tests_special_from_folders_hash()' ) ;
+
+
+        require Test::MockObject ;
+        my $imapT = Test::MockObject->new(  ) ;
+
+        is( undef, special_from_folders_hash(  ), 'special_from_folders_hash: no args' ) ;
+        is_deeply( {}, special_from_folders_hash( $imapT ), 'special_from_folders_hash: $imap void' ) ;
+
+        $imapT->mock( 'folders_hash', sub { return( [ { name => 'Sent', attrs => [ '\Sent' ] } ] ) } ) ;
+        is_deeply( { Sent => '\Sent', '\Sent' => 'Sent' }, special_from_folders_hash( $imapT ), 'special_from_folders_hash: $imap \Sent' ) ;
+
+	note( 'Leaving  tests_special_from_folders_hash()' ) ;
+        return(  ) ;
 }
 
 sub errors_incr {
-	my ( $mysync, @error ) = @ARG ;
-	$sync->{nb_errors}++ ;
-        
+        my ( $mysync, @error ) = @ARG ;
+        $sync->{nb_errors}++ ;
+
         if ( @error ) {
-		errors_log( $mysync, @error ) ;
+                errors_log( $mysync, @error ) ;
                 myprint( @error ) ;
         }
-        
+
         $mysync->{errorsmax} ||= $ERRORS_MAX ;
-	if ( $sync->{nb_errors} >= $mysync->{errorsmax} ) {
-		myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
+        if ( $sync->{nb_errors} >= $mysync->{errorsmax} ) {
+                myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
                 if ( $mysync->{errorsdump} ) {
                         myprint( errorsdump( $sync->{nb_errors}, errors_log( $mysync ) ) ) ;
                         # again since errorsdump(  ) can be very verbose and masq previous warning
-		        myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
-		}
+                        myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to 100 with --errorsmax 100 ). Exiting.\n"  ) ;
+                }
                 exit_clean( $mysync, $EXIT_WITH_ERRORS_MAX ) ;
-	}
-	return ;
+        }
+        return ;
 }
 
 sub errors_log {
@@ -2652,7 +3257,7 @@ sub errors_log {
         }
 
         if ( @error ) {
-		push  @{ $mysync->{errors_log} }, join( q{}, @error  ) ;
+                push  @{ $mysync->{errors_log} }, join( q{}, @error  ) ;
         }
         if ( @{ $mysync->{errors_log} } ) {
                 return @{ $mysync->{errors_log} } ;
@@ -2663,126 +3268,132 @@ sub errors_log {
 }
 
 sub tests_errors_log {
+	note( 'Entering tests_errors_log()' ) ;
 
 
+	note( 'Leaving  tests_errors_log()' ) ;
+	return ;
 }
 
 
 sub errorsdump {
         my( $nb_errors, @errors_log ) = @ARG ;
-	my $error_num = 0 ;
-	my $errors_list = q{} ;
-	if ( @errors_log ) {
-		$errors_list = "++++ Listing $nb_errors errors encountered during the sync ( avoid this listing with --noerrorsdump ).\n" ;
-		foreach my $error ( @errors_log ) {
-			$error_num++ ;
-			$errors_list .= "Err $error_num/$nb_errors: $error" ;
-		}
-	}
-	return( $errors_list ) ;
+        my $error_num = 0 ;
+        my $errors_list = q{} ;
+        if ( @errors_log ) {
+                $errors_list = "++++ Listing $nb_errors errors encountered during the sync ( avoid this listing with --noerrorsdump ).\n" ;
+                foreach my $error ( @errors_log ) {
+                        $error_num++ ;
+                        $errors_list .= "Err $error_num/$nb_errors: $error" ;
+                }
+        }
+        return( $errors_list ) ;
 }
 
 
 sub tests_live_result {
-	my $nb_errors = shift ;
-	if ( $nb_errors  ) {
-		myprint( "Live tests failed with $nb_errors errors\n"  ) ;
-	} else {
-		myprint( "Live tests ended successfully\n"  ) ;
-	}
-	return ;
+	note( 'Entering tests_live_result()' ) ;
+
+        my $nb_errors = shift ;
+        if ( $nb_errors  ) {
+                myprint( "Live tests failed with $nb_errors errors\n"  ) ;
+        } else {
+                myprint( "Live tests ended successfully\n"  ) ;
+        }
+	note( 'Leaving  tests_live_result()' ) ;
+        return ;
 }
 
 sub foldersizesatend {
-	timenext(  ) ;
-	return if ( $imap1->IsUnconnected(  ) ) ;
-	return if ( $imap2->IsUnconnected(  ) ) ;
-	# Get all folders on host2 again since new were created
-	@h2_folders_all = sort $imap2->folders();
-	for ( @h2_folders_all ) {
-        	$h2_folders_all{ $_ } = 1 ;
-        	$h2_folders_all_UPPER{ uc  $_  } = 1 ;
+        timenext(  ) ;
+        return if ( $imap1->IsUnconnected(  ) ) ;
+        return if ( $imap2->IsUnconnected(  ) ) ;
+        # Get all folders on host2 again since new were created
+        @h2_folders_all = sort $imap2->folders();
+        for ( @h2_folders_all ) {
+                $h2_folders_all{ $_ } = 1 ;
+                $h2_folders_all_UPPER{ uc  $_  } = 1 ;
         } ;
-	( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( 'Host1', $imap1, $search1, @h1_folders_wanted ) ;
-	( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( 'Host2', $imap2, $search2, @h2_folders_from_1_wanted ) ;
+        ( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( 'Host1', $imap1, $search1, $sync->{abletosearch1}, @h1_folders_wanted ) ;
+        ( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( 'Host2', $imap2, $search2, $sync->{abletosearch2}, @h2_folders_from_1_wanted ) ;
         if ( not all_defined( $h1_nb_msg_end, $h1_bytes_end, $h2_nb_msg_end, $h2_bytes_end ) ) {
                 my $error = "Failure getting foldersizes, final differences will not be calculated\n" ;
                 errors_incr( $sync, $error ) ;
         }
-	return ;
+        return ;
 }
 
 sub size_filtered_flag {
-	my $h1_size = shift ;
+        my $h1_size = shift ;
 
-	if (defined $maxsize and $h1_size >= $maxsize) {
-		return( 1 ) ;
-	}
-	if (defined $minsize and $h1_size <= $minsize) {
-		return( 1 ) ;
-	}
-	return( 0 ) ;
+        if (defined $maxsize and $h1_size >= $maxsize) {
+                return( 1 ) ;
+        }
+        if (defined $minsize and $h1_size <= $minsize) {
+                return( 1 ) ;
+        }
+        return( 0 ) ;
 }
 
 sub sync_flags_fir {
-	my ( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) = @_ ;
+        my ( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) = @_ ;
 
-	if ( not defined  $h1_msg  ) { return } ;
-	if ( not defined  $h2_msg  ) { return } ;
+        if ( not defined  $h1_msg  ) { return } ;
+        if ( not defined  $h2_msg  ) { return } ;
 
-	my $h1_size = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'} ;
-	return if size_filtered_flag( $h1_size ) ;
+        my $h1_size = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'} ;
+        return if size_filtered_flag( $h1_size ) ;
 
-	# used cached flag values for efficiency
-	my $h1_flags = $h1_fir_ref->{ $h1_msg }->{ 'FLAGS' } || q{} ;
-	my $h2_flags = $h2_fir_ref->{ $h2_msg }->{ 'FLAGS' } || q{} ;
+        # used cached flag values for efficiency
+        my $h1_flags = $h1_fir_ref->{ $h1_msg }->{ 'FLAGS' } || q{} ;
+        my $h2_flags = $h2_fir_ref->{ $h2_msg }->{ 'FLAGS' } || q{} ;
 
-	sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
+        sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
 
         return ;
 }
 
 sub sync_flags_after_copy {
-	my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $permanentflags2 ) = @_ ;
+        my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $permanentflags2 ) = @_ ;
 
         my @h2_flags = $imap2->flags( $h2_msg ) ;
         my $h2_flags = "@h2_flags" ;
         ( $debug or $debugflags ) and myprint( "Host2 flags before resync by STORE on msg $h2_msg: $h2_flags\n"  ) ;
-	sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
+        sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
         return ;
 }
 
 sub sync_flags {
-	my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) = @_ ;
+        my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) = @_ ;
 
-	( $debug or $debugflags ) and
+        ( $debug or $debugflags ) and
         myprint( "Host1: flags init msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n"  ) ;
 
-	$h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
+        $h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
 
-	$h2_flags = flagscase( $h2_flags ) ;
+        $h2_flags = flagscase( $h2_flags ) ;
 
-	( $debug or $debugflags ) and
+        ( $debug or $debugflags ) and
         myprint( "Host1 flags filt msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n"  ) ;
 
 
-	# compare flags - set flags if there a difference
-	my @h1_flags = sort split(q{ }, $h1_flags );
-	my @h2_flags = sort split(q{ }, $h2_flags );
-	my $diff = compare_lists( \@h1_flags, \@h2_flags );
+        # compare flags - set flags if there a difference
+        my @h1_flags = sort split(q{ }, $h1_flags );
+        my @h2_flags = sort split(q{ }, $h2_flags );
+        my $diff = compare_lists( \@h1_flags, \@h2_flags );
 
-	$diff and ( $debug or $debugflags )
-		and     myprint( "Host2 flags msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n" ) ;
-	# This sets flags so flags can be removed with this
-	# When you remove a \Seen flag on host1 you want to it
-	# to be removed on host2. Just add flags is not what
-	# we need most of the time.
+        $diff and ( $debug or $debugflags )
+                and     myprint( "Host2 flags msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n" ) ;
+        # This sets flags so flags can be removed with this
+        # When you remove a \Seen flag on host1 you want to it
+        # to be removed on host2. Just add flags is not what
+        # we need most of the time.
 
-	if ( not $dry and $diff and not $imap2->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) {
-		my $error_msg = join q{}, "Host2 flags msg $h2_fold/$h2_msg could not add flags [@h1_flags]: ",
-		  $imap2->LastError || q{}, "\n" ;
-		errors_incr( $sync, $error_msg ) ;
-	}
+        if ( not $sync->{dry} and $diff and not $imap2->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) {
+                my $error_msg = join q{}, "Host2 flags msg $h2_fold/$h2_msg could not add flags [@h1_flags]: ",
+                  $imap2->LastError || q{}, "\n" ;
+                errors_incr( $sync, $error_msg ) ;
+        }
 
         return ;
 }
@@ -2790,7 +3401,7 @@ sub sync_flags {
 
 
 sub _filter {
-	my $str = shift or return q{} ;
+        my $str = shift or return q{} ;
         my $sz  = $SIZE_MAX_STR ;
         my $len = length $str ;
         if ( not $debug and $len > $sz*2 ) {
@@ -2805,7 +3416,7 @@ sub _filter {
 
 
 sub lost_connection {
-	my( $imap, $error_message ) = @_;
+        my( $imap, $error_message ) = @_;
         if ( $imap->IsUnconnected(  ) ) {
                 $sync->{nb_errors}++ ;
                 my $lcomm = $imap->LastIMAPCommand || q{} ;
@@ -2819,203 +3430,298 @@ sub lost_connection {
                 return( 1 ) ;
         }
         else{
-        	return( 0 ) ;
+                return( 0 ) ;
         }
 }
 
 sub max {
-	my @list = @_ ;
-	return( undef ) if ( 0 == scalar  @list  ) ;
-	my @sorted = sort { $a <=> $b } @list ;
-	return( pop @sorted ) ;
+        my @list = @_ ;
+        return( undef ) if ( 0 == scalar  @list  ) ;
+        
+        no warnings 'numeric' ;
+        no warnings 'uninitialized' ;
+
+        my @sorted = sort { $a <=> $b || $a cmp $b } @list ;
+        return( pop @sorted ) ;
 }
 
 sub tests_max {
-	ok( 0  == max( 0 ),  'max 0' ) ;
-	ok( 1  == max( 1 ),  'max 1' ) ;
-	ok( $MINUS_ONE == max( $MINUS_ONE ), 'max -1') ;
-	ok( not ( defined max(  ) ), 'max no arg' ) ;
-	ok( $NUMBER_100 == max( 1, $NUMBER_100 ), 'max 1 100' ) ;
-	ok( $NUMBER_100 == max( $NUMBER_100, 1 ), 'max 100 1' ) ;
-	ok( $NUMBER_100 == max( $NUMBER_100, $NUMBER_42, 1 ), 'max 100 42 1' ) ;
-	ok( $NUMBER_100 == max( $NUMBER_100, '42', 1 ), 'max 100 42 1' ) ;
-	ok( $NUMBER_100 == max( '100', '42', 1 ), 'max 100 42 1' ) ;
-	#ok( 100 == max( 100, 'haha', 1 ), 'max 100 42 1') ;
+	note( 'Entering tests_max()' ) ;
+        is( 0, max( 0 ),  'max 0 => 0' ) ;
+        is( 1, max( 1 ),  'max 1 => 1' ) ;
+        is( $MINUS_ONE, max( $MINUS_ONE ), 'max -1 => -1') ;
+        is( undef, max(  ), 'max no arg => undef' ) ;
+        is( $NUMBER_100, max( 1, $NUMBER_100 ), 'max 1 100 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, 1 ), 'max 100 1 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, $NUMBER_42, 1 ), 'max 100 42 1 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, '42', 1 ), 'max 100 42 1 => 100' ) ;
+        is( $NUMBER_100, max( '100', '42', 1 ), 'max 100 42 1 => 100' ) ;
+        is( $NUMBER_100, max( $NUMBER_100, 'haha', 1 ), 'max 100 haha 1 => 100') ;
+	is( 1, max( $MINUS_ONE, 1 ), 'max -1 1 => 1') ;
+	is( 1, max( undef, 1 ), 'max undef 1 => 1' ) ;
+	is( 0, max( undef, 0 ), 'max undef 0 => 0' ) ;
+        is( 'haha', max( 'haha' ), 'max haha => haha') ;
+        is( 'bb', max( 'aa', 'bb' ), 'max aa bb => bb') ;
+        is( 'bb', max( 'bb', 'aa' ), 'max bb aa bb => bb') ;
+        is( 'bb', max( 'bb', 'aa', 'bb' ), 'max bb aa bb => bb') ;
+	note( 'Leaving  tests_max()' ) ;
+        return ;
+}
+
+sub min {
+        my @list = @_ ;
+        return( undef ) if ( 0 == scalar  @list  ) ;
+        no warnings 'numeric' ;
+        no warnings 'uninitialized' ;
+        my @sorted = sort { $a <=> $b || $a cmp $b } @list ;
+        return( shift @sorted ) ;
+}
+
+sub tests_min {
+	note( 'Entering tests_min()' ) ;
+
+        is( 0, min( 0 ),  'min 0 => 0' ) ;
+        is( 1, min( 1 ),  'min 1 => 1' ) ;
+        is( $MINUS_ONE, min( $MINUS_ONE ), 'min -1 => -1' ) ;
+        is( undef, min(  ), 'min no arg => undef' ) ;
+        is( 1, min( 1, $NUMBER_100 ), 'min 1 100 => 1' ) ;
+        is( 1, min( $NUMBER_100, 1 ), 'min 100 1 => 1' ) ;
+        is( 1, min( $NUMBER_100, $NUMBER_42, 1 ), 'min 100 42 1 => 1' ) ;
+        is( 1, min( $NUMBER_100, '42', 1 ), 'min 100 42 1 => 1' ) ;
+        is( 1, min( '100', '42', 1 ), 'min 100 42 1 => 1' ) ;
+        is( 'haha', min( 100, 'haha', 1 ), 'min 100 haha 1 => haha') ;
+	is( $MINUS_ONE, min( $MINUS_ONE, 1 ), 'min -1 1 => -1') ;
+	
+	is( undef, min( undef, 1 ), 'min undef 1 => undef' ) ;
+	is( undef, min( undef, 0 ), 'min undef 0 => undef' ) ;
+
+        is( 'haha', min( 'haha' ), 'min haha => haha') ;
+        is( 'aa', min( 'aa', 'bb' ), 'min aa bb => aa') ;
+        is( 'aa', min( 'bb', 'aa' ), 'min bb aa bb => aa') ;
+        is( 'aa', min( 'bb', 'aa', 'bb' ), 'min bb aa bb => aa') ;
+
+	note( 'Leaving  tests_min()' ) ;
         return ;
 }
 
 
 sub check_lib_version {
-	$debug and myprint( "IMAPClient $Mail::IMAPClient::VERSION\n"  ) ;
-	if ( '2.2.9' eq $Mail::IMAPClient::VERSION ) {
-		myprint( "imapsync no longer supports Mail::IMAPClient 2.2.9, upgrade it\n"  ) ;
-		return 0 ;
-	}
-	else{
-		# 3.x.x is no longer buggy with imapsync.
+        $debug and myprint( "IMAPClient $Mail::IMAPClient::VERSION\n"  ) ;
+        if ( '2.2.9' eq $Mail::IMAPClient::VERSION ) {
+                myprint( "imapsync no longer supports Mail::IMAPClient 2.2.9, upgrade it\n"  ) ;
+                return 0 ;
+        }
+        else{
+                # 3.x.x is no longer buggy with imapsync.
                 # 3.30 or currently superior is imposed in the Perl "use Mail::IMAPClient line".
-		return 1 ;
-	}
+                return 1 ;
+        }
         return ;
 }
 
 sub module_version_str {
-	my( $module_name, $module_version ) = @_ ;
-	my $str = mysprintf( "%-20s %s\n", $module_name, $module_version ) ;
+        my( $module_name, $module_version ) = @_ ;
+        my $str = mysprintf( "%-20s %s\n", $module_name, $module_version ) ;
         return( $str ) ;
 }
 
 sub modulesversion {
 
-	my @list_version;
+        my @list_version;
 
-	my $v ;
-	eval { require Mail::IMAPClient; $v = $Mail::IMAPClient::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Mail::IMAPClient', $v )  ;
+        my %modulesversion = (
+                'Authen::NTLM'          => sub { $Authen::NTLM::VERSION },
+                'Compress::Zlib'        => sub { $Compress::Zlib::VERSION },
+                'Crypt::OpenSSL::RSA'   => sub { $Crypt::OpenSSL::RSA::VERSION },
+                'Data::Uniqid'          => sub { $Data::Uniqid::VERSION },
+                'Digest::HMAC_MD5'      => sub { $Digest::HMAC_MD5::VERSION },
+                'Digest::HMAC_SHA1'     => sub { $Digest::HMAC_SHA1::VERSION },
+                'Digest::MD5'           => sub { $Digest::MD5::VERSION },
+                'File::Copy::Recursive' => sub { $File::Copy::Recursive::VERSION },
+                'File::Spec'            => sub { $File::Spec::VERSION },
+                'Getopt::Long'          => sub { $Getopt::Long::VERSION },
+                'HTML::Entities'        => sub { $HTML::Entities::VERSION },
+                'IO::Socket::INET6'     => sub { $IO::Socket::INET6::VERSION },
+                'IO::Socket::INET'      => sub { $IO::Socket::INET::VERSION },
+                'IO::Socket::SSL'       => sub { $IO::Socket::SSL::VERSION },
+                'IO::Socket'            => sub { $IO::Socket::VERSION },
+                'IO::Tee'               => sub { $IO::Tee::VERSION },
+                'JSON'                  => sub { $JSON::VERSION },
+                'JSON::WebToken'        => sub { $JSON::WebToken::VERSION },
+                'LWP'                   => sub { $LWP::VERSION },
+                'Mail::IMAPClient'      => sub { $Mail::IMAPClient::VERSION },
+                'Net::Ping'             => sub { $Net::Ping::VERSION },
+                'Net::SSLeay'           => sub { $Net::SSLeay::VERSION },
+                'Term::ReadKey'         => sub { $Term::ReadKey::VERSION },
+                'Test::MockObject'      => sub { $Test::MockObject::VERSION },
+                'Time::HiRes'           => sub { $Time::HiRes::VERSION },
+                'Unicode::String'       => sub { $Unicode::String::VERSION },
+                'URI::Escape'           => sub { $URI::Escape::VERSION },
+                #'Lalala'                => sub { $Lalala::VERSION },
+        ) ;
 
-	eval { require IO::Socket; $v = $IO::Socket::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket', $v )  ;
+        foreach my $module_name ( sort keys %modulesversion ) {
+                # trick from http://www.perlmonks.org/?node_id=152122
+                my $file_name = $module_name . '.pm' ;
+                $file_name =~s,::,/,xmgs; # Foo::Bar::Baz => Foo/Bar/Baz.pm
+                my $v ;
+                eval {
+                        require $file_name ;
+                        $v = defined $modulesversion{ $module_name } ? $modulesversion{ $module_name }->() : q{?} ;
+                } or $v = q{Not installed} ;
 
-	eval { require IO::Socket::INET; $v = $IO::Socket::INET::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket::INET', $v )  ;
+                push  @list_version, module_version_str( $module_name, $v )  ;
+        }
 
-	eval { require IO::Socket::INET6; $v = $IO::Socket::INET6::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket::INET6', $v )  ;
-
-	eval { require IO::Socket::SSL ; $v = $IO::Socket::SSL::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Socket::SSL ', $v )  ;
-
-	eval { require Net::SSLeay ; $v = $Net::SSLeay::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Net::SSLeay ', $v )  ;
-
-	eval { require Compress::Zlib; $v = $Compress::Zlib::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Compress::Zlib', $v )  ;
-
-	eval { require Digest::MD5; $v = $Digest::MD5::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Digest::MD5', $v )  ;
-
-	eval { require Digest::HMAC_MD5; $v = $Digest::HMAC_MD5::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Digest::HMAC_MD5', $v )  ;
-
-	eval { require Digest::HMAC_SHA1; $v = $Digest::HMAC_SHA1::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Digest::HMAC_SHA1', $v )  ;
-
-	eval { require Term::ReadKey; $v = $Term::ReadKey::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Term::ReadKey', $v )  ;
-
-	eval { require File::Spec; $v = $File::Spec::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'File::Spec', $v )  ;
-
-	eval { require Time::HiRes; $v = $Time::HiRes::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Time::HiRes', $v )  ;
-
-	eval { require Unicode::String; $v = $Unicode::String::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Unicode::String', $v )  ;
-
-	eval { require IO::Tee; $v = $IO::Tee::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'IO::Tee', $v )  ;
-
-	eval { require File::Copy::Recursive; $v = $File::Copy::Recursive::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'File::Copy::Recursive', $v )  ;
-
-	eval { require Authen::NTLM; $v = $Authen::NTLM::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Authen::NTLM', $v )  ;
-
-	eval { require URI::Escape; $v = $URI::Escape::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'URI::Escape', $v )  ;
-
-	eval { require Data::Uniqid; $v = $Data::Uniqid::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Data::Uniqid', $v )  ;
-
-	eval { require JSON; $v = $JSON::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'JSON', $v )  ;
-
-	eval { require JSON::WebToken; $v = $JSON::WebToken::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'JSON::WebToken', $v )  ;
-
-	eval { require Crypt::OpenSSL::RSA; $v = $Crypt::OpenSSL::RSA::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Crypt::OpenSSL::RSA', $v )  ;
-
-	eval { require LWP; $v = $LWP::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'LWP', $v )  ;
-
-	eval { require HTML::Entities; $v = $HTML::Entities::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'HTML::Entities', $v )  ;
-
-	#eval { require Filesys::DfPortable; $v = $Filesys::DfPortable::VERSION } or $v = q{?} ;
-	#push  @list_version, module_version_str( 'Filesys::DfPortable', $v )  ;
-
-	eval { require Getopt::Long; $v = $Getopt::Long::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Getopt::Long', $v )  ;
-
-	eval { require Test::MockObject; $v = $Test::MockObject::VERSION } or $v = q{?} ;
-	push  @list_version, module_version_str( 'Test::MockObject', $v )  ;
-
-	return( @list_version ) ;
+        return( @list_version ) ;
 }
 
 
 # Construct a command line copy with passwords replaced by MASKED.
 sub command_line_nopassword {
-	my @argv = @_ ;
-	my @argv_nopassword ;
+        my @argv = @_ ;
+        my @argv_nopassword ;
 
-        return( "@argv" ) if $showpasswords ;
-	while ( @argv ) {
-		my $arg = shift @argv ; # option name or value
-		if ( $arg =~ m/-password[12]/x ) {
-			shift @argv ; # password value
-			push  @argv_nopassword, $arg, 'MASKED'  ; # option name and fake value
-		}else{
-			push  @argv_nopassword, $arg ; # same option or value
-		}
-	}
-	return("@argv_nopassword") ;
+        return( "@argv" ) if $sync->{showpasswords} ;
+        while ( @argv ) {
+                my $arg = shift @argv ; # option name or value
+                if ( $arg =~ m/-password[12]/x ) {
+                        shift @argv ; # password value
+                        push  @argv_nopassword, $arg, 'MASKED'  ; # option name and fake value
+                }else{
+                        push  @argv_nopassword, $arg ; # same option or value
+                }
+        }
+        return("@argv_nopassword") ;
 }
 
 sub tests_command_line_nopassword {
+	note( 'Entering tests_command_line_nopassword()' ) ;
 
-	ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
-	ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
-	#myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
-	ok('--password1 MASKED' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
-	ok('--blabla --password1 MASKED --blibli'
-	eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
-	$showpasswords = 1 ;
-	ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
-	ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
-	#myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
-	ok('--password1 secret1' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
-	ok('--blabla --password1 secret1 --blibli'
-	eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
+        ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
+        ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
+        #myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
+        ok('--password1 MASKED' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
+        ok('--blabla --password1 MASKED --blibli'
+        eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
+        $sync->{showpasswords} = 1 ;
+        ok(q{} eq command_line_nopassword(), 'command_line_nopassword void');
+        ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
+        #myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
+        ok('--password1 secret1' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
+        ok('--blabla --password1 secret1 --blibli'
+        eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
+
+	note( 'Leaving  tests_command_line_nopassword()' ) ;
         return ;
 }
 
-sub ask_for_password {
-	my ( $user, $host ) = @_ ;
-	myprint( "What's the password for $user" . '@' . "$host? (not visible while you type, then enter RETURN) "  ) ;
-	Term::ReadKey::ReadMode( 2 ) ;
-	my $password = <> ;
-	chomp $password ;
-	myprint( "\nGot it\n" ) ;
-	Term::ReadKey::ReadMode( 0 ) ;
-	return $password ;
+sub ask_for_password  {
+        my ( $user, $host ) = @ARG ;
+        myprint( "What's the password for $user" . '@' . "$host? (not visible while you type, then enter RETURN) "  ) ;
+        Term::ReadKey::ReadMode( 2 ) ;
+        my $password =  ;
+        chomp $password ;
+        myprint( "\nGot it\n" ) ;
+        Term::ReadKey::ReadMode( 0 ) ;
+        return $password ;
 }
 
+# Have to refactor get_password1() get_password2()
+# to have only get_password() and two calls
+sub get_password1 {
+
+	my $mysync = shift ;
+
+	$mysync->{password1}
+	|| $passfile1
+	|| 'PREAUTH' eq $authmech1
+	|| 'EXTERNAL' eq $authmech1
+	|| $ENV{IMAPSYNC_PASSWORD1}
+	|| do {
+        myprint( << 'FIN_PASSFILE'  ) ;
+
+If you are afraid of giving password on the command line arguments, you can put the
+password of user1 in a file named file1 and use "--passfile1 file1" instead of typing it.
+Then give this file restrictive permissions with the command "chmod 600 file1".
+An other solution is to set the environment variable IMAPSYNC_PASSWORD1
+FIN_PASSFILE
+
+		$mysync->{password1} = ask_for_password( $authuser1 || $mysync->{user1}, $mysync->{host1} ) ;
+	} ;
+
+	if ( defined  $passfile1  ) {
+		if ( ! -e -r $passfile1 ) {
+			myprint( "Failure: file from parameter --passfile1 $passfile1 does not exist or is not readable\n" ) ;
+			exit_clean( $mysync, $EX_NOINPUT ) ;
+		}
+		# passfile1 readable
+		$mysync->{password1} = firstline ( $passfile1 ) ;
+		return ;
+	}
+	if ( $ENV{IMAPSYNC_PASSWORD1} ) {
+		$mysync->{password1} = $ENV{IMAPSYNC_PASSWORD1} ;
+		return ;
+	}
+	return ;
+}
+
+sub get_password2 {
+
+	my $mysync = shift ;
+
+	$mysync->{password2}
+	|| $passfile2
+	|| 'PREAUTH' eq $authmech2
+	|| 'EXTERNAL' eq $authmech2
+	|| $ENV{IMAPSYNC_PASSWORD2}
+	|| do {
+        myprint( << 'FIN_PASSFILE'  ) ;
+
+If you are afraid of giving password on the command line arguments, you can put the
+password of user2 in a file named file2 and use "--passfile2 file2" instead of typing it.
+Then give this file restrictive permissions with the command "chmod 600 file2".
+An other solution is to set the environment variable IMAPSYNC_PASSWORD2
+FIN_PASSFILE
+
+		$mysync->{password2} = ask_for_password( $authuser2 || $mysync->{user2}, $mysync->{host2} ) ;
+	} ;
+
+
+	if ( defined  $passfile2  ) {
+		if ( ! -e -r $passfile2 ) {
+			myprint( "Failure: file from parameter --passfile2 $passfile2 does not exist or is not readable\n" ) ;
+			exit_clean( $mysync, $EX_NOINPUT ) ;
+		}
+		# passfile2 readable
+		$mysync->{password2} = firstline ( $passfile2 ) ;
+		return ;
+	}
+	if ( $ENV{IMAPSYNC_PASSWORD2} ) {
+		$mysync->{password2} = $ENV{IMAPSYNC_PASSWORD2} ;
+		return ;
+	}
+	return ;
+}
+
+
+
+
+
 sub catch_exit {
         my $mysync = shift ;
         my $signame = shift ;
         if ( $signame ) {
                 myprint( "\nGot a signal $signame\n" ) ;
         }
-	stats( $mysync ) ;
+        stats( $mysync ) ;
         myprint( "Ended by a signal\n" ) ;
-	exit_clean( $mysync, $EXIT_BY_SIGNAL ) ;
+        exit_clean( $mysync, $EXIT_BY_SIGNAL ) ;
         return ;
 }
 
 sub catch_reconnect {
-	my $mysync = shift ;
+        my $mysync = shift ;
         my $signame = shift ;
         myprint( "\nGot a signal $signame\n",
                 "Hit 2 ctr-c within 2 seconds to exit the program\n",
@@ -3031,24 +3737,109 @@ sub catch_reconnect {
 
         if ( ! defined $mysync->{imap1} ) { return ; }
         if ( ! defined $mysync->{imap2} ) { return ; }
-        
+
 
         myprint( "Info: reconnecting to host1 imap server\n" ) ;
         $mysync->{imap1}->State( Mail::IMAPClient::Unconnected ) ;
+	$mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
         $mysync->{imap1}->reconnect(  ) ;
         myprint( "Info: reconnecting to host2 imap server\n" ) ;
         $mysync->{imap2}->State( Mail::IMAPClient::Unconnected ) ;
+	$mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
         $mysync->{imap2}->reconnect(  ) ;
         myprint( "Info: reconnected to both imap servers\n" ) ;
         return ;
 }
 
+sub tests_reconnect_12_if_needed {
+	note( 'Entering tests_reconnect_12_if_needed()' ) ;
+
+	my $mysync ;
+
+	$mysync->{imap1} = Mail::IMAPClient->new(  ) ;
+	$mysync->{imap2} = Mail::IMAPClient->new(  ) ;
+	$mysync->{imap1}->Server( 'test1.lamiral.info' ) ;
+	$mysync->{imap2}->Server( 'test2.lamiral.info' ) ;
+	is( 2, reconnect_12_if_needed( $mysync ), 'reconnect_12_if_needed: test1&test2 .lamiral.info => 1' ) ;
+	is( 1, $mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_12_if_needed: test1.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;
+	is( 1, $mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_12_if_needed: test2.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;
+
+	note( 'Leaving  tests_reconnect_12_if_needed()' ) ;
+	return ;
+}
+
+sub reconnect_12_if_needed {
+        my $mysync = shift ;
+	#return 2 ;
+	if ( ! reconnect_if_needed( $mysync->{imap1} ) ) {
+		return ;
+	}
+	if ( ! reconnect_if_needed( $mysync->{imap2} ) ) {
+		return ;
+	}
+	# both were good
+	return 2 ;
+}
+
+
+sub tests_reconnect_if_needed {
+	note( 'Entering tests_reconnect_if_needed()' ) ;
+
+
+	my $myimap ;
+
+	is( undef, reconnect_if_needed( ), 'reconnect_if_needed: no args => undef' ) ;
+	is( undef, reconnect_if_needed( $myimap ), 'reconnect_if_needed: undef arg => undef' ) ;
+
+	$myimap = Mail::IMAPClient->new(  ) ;
+        $myimap->Debug( 1 ) ;
+	is( undef, reconnect_if_needed( $myimap ), 'reconnect_if_needed: empty new Mail::IMAPClient => undef' ) ;
+	$myimap->Server( 'test.lamiral.info' ) ;
+	is( 1, reconnect_if_needed( $myimap ), 'reconnect_if_needed: test.lamiral.info => 1' ) ;
+	is( 1, $myimap->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_if_needed: test.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;
+
+	note( 'Leaving  tests_reconnect_if_needed()' ) ;
+	return ;
+}
+
+sub reconnect_if_needed {
+	# return undef upon failure.
+	# return 1 upon connection success, with or without reconnection.
+
+        my $imap = shift ;
+
+	if ( ! defined $imap ) { return ; }
+	if ( ! $imap->Server(  ) ) { return ; }
+
+	if ( $imap->IsUnconnected(  ) ) {
+		$imap->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
+		if ( $imap->reconnect( ) )  {
+			return 1 ;
+		}
+	}else{
+		return 1 ;
+	}
+
+	# A last forced one
+	$imap->State( Mail::IMAPClient::Unconnected ) ;
+	$imap->reconnect(  ) ;
+	$imap->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
+	if ( $imap->noop ) {
+		# NOOP is ok
+		return 1 ;
+	}
+
+	return ;
+}
+
+
+
 sub here_twice {
         my $mysync = shift ;
         my $now = time ;
         my $previous = $mysync->{lastcatch} || 0 ;
         $mysync->{lastcatch} = $now ;
-        
+
         if ( $INTERVAL_TO_EXIT >= $now - $previous ) {
                 return $TRUE ;
         }else{
@@ -3057,40 +3848,219 @@ sub here_twice {
 }
 
 
-
-
 sub justconnect {
 
-	$imap1 = connect_imap( $host1, $port1, $debugimap1, $ssl1, $tls1, 'Host1', $sync->{h1}->{timeout}, $sync->{h1} ) ;
-	myprint( 'Host1 banner: ', $imap1->Banner(  )  ) ;
-	myprint( 'Host1 capability: ', join(q{ }, $imap1->capability(  ) ), "\n"  ) ;
-	$imap2 = connect_imap( $host2, $port2, $debugimap2, $ssl2, $tls2, 'Host2', $sync->{h2}->{timeout}, $sync->{h2} ) ;
-	myprint( 'Host2 banner: ', $imap2->Banner(  )  ) ;
-	myprint( 'Host2 capability: ', join(q{ }, $imap2->capability(  ) ), "\n"  ) ;
-	$imap1->logout(  ) ;
-	$imap2->logout(  ) ;
+        $imap1 = connect_imap( $sync->{host1}, $sync->{port1}, $debugimap1, $sync->{ssl1}, $sync->{tls1}, 'Host1', $sync->{h1}->{timeout}, $sync->{h1} ) ;
+        $imap2 = connect_imap( $sync->{host2}, $sync->{port2}, $debugimap2, $sync->{ssl2}, $sync->{tls2}, 'Host2', $sync->{h2}->{timeout}, $sync->{h2} ) ;
+        $imap1->logout(  ) ;
+        $imap2->logout(  ) ;
         return ;
 }
 
+
+sub tests_mailimapclient_connect {
+        note( 'Entering tests_mailimapclient_connect()' ) ;
+        my $imap ;
+        # ipv4 
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv4: new' ) ;
+        is( 'Mail::IMAPClient', ref( $imap ), 'mailimapclient_connect ipv4: ref is Mail::IMAPClient' ) ;
+        SKIP: {
+
+        if ( 'macosx' eq hostname() ) { skip( 'Tests avoided on macosx get stuck', 1 ) ; }
+        is( undef, $imap->connect(  ), 'mailimapclient_connect ipv4: connect with no server => failure' ) ;
+        }
+
+        is( 'test.lamiral.info', $imap->Server( 'test.lamiral.info' ), 'mailimapclient_connect ipv4: setting Server(test.lamiral.info)' ) ;
+        is( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4: setting Debug( 1 )' ) ;
+        is( 143, $imap->Port( 143 ), 'mailimapclient_connect ipv4: setting Port( 143 )' ) ;
+        is( 3, $imap->Timeout( 3 ), 'mailimapclient_connect ipv4: setting Timout( 30 )' ) ;
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::INET/, 'mailimapclient_connect ipv4: connect to test.lamiral.info' ) ;
+        like( $imap->logout( ), qr/Mail::IMAPClient/, 'mailimapclient_connect ipv4: logout' ) ;
+        is( undef, undef $imap, 'mailimapclient_connect ipv4: free variable' ) ;
+
+        # ipv4 + ssl
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv4 + ssl: new' ) ;
+        is( 'test.lamiral.info', $imap->Server( 'test.lamiral.info' ), 'mailimapclient_connect ipv4 + ssl: setting Server(test.lamiral.info)' ) ;
+        is( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4 + ssl: setting Debug( 1 )' ) ;
+        ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE ] ), 'mailimapclient_connect ipv4 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ;
+        is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv4 + ssl: setting Port( 993 )' ) ;
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::SSL/, 'mailimapclient_connect ipv4 + ssl: connect to test.lamiral.info' ) ;
+        is( $imap->logout( ), undef, 'mailimapclient_connect ipv4 + ssl: logout in ssl causes failure' ) ;
+        is( undef, undef $imap, 'mailimapclient_connect ipv4 + ssl: free variable' ) ;
+        
+        # ipv6 + ssl
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv6 + ssl: new' ) ;
+        is( 'ks2ipv6.lamiral.info', $imap->Server( 'ks2ipv6.lamiral.info' ), 'mailimapclient_connect ipv6 + ssl: setting Server(ks2ipv6.lamiral.info)' ) ;
+        ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE ] ), 'mailimapclient_connect ipv6 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ;
+        is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv6 + ssl: setting Port( 993 )' ) ;
+        SKIP: {
+        if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE can not do ipv6', 2 ) ; }
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::SSL/, 'mailimapclient_connect ipv6 + ssl: connect to ks2ipv6.lamiral.info' ) ;
+        is( $imap->logout( ), undef, 'mailimapclient_connect ipv6 + ssl: logout in ssl causes failure' ) ;
+        }
+        is( undef, undef $imap, 'mailimapclient_connect ipv6 + ssl: free variable' ) ;
+
+
+        note( 'Leaving  tests_mailimapclient_connect()' ) ;
+        return ;
+}
+
+sub tests_mailimapclient_connect_bug {
+        note( 'Entering tests_mailimapclient_connect_bug()' ) ;
+        my $imap ;
+
+        # ipv6
+        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv6: new' ) ;
+        is( 'ks2ipv6.lamiral.info', $imap->Server( 'ks2ipv6.lamiral.info' ), 'mailimapclient_connect ipv6: setting Server(ks2ipv6.lamiral.info)' ) ;        
+        is( 143, $imap->Port( 143 ), 'mailimapclient_connect ipv6: setting Port( 993 )' ) ;
+        
+        SKIP: {
+        if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE can not do ipv6', 1 ) ; }
+        like( ref( $imap->connect(  ) ), qr/IO::Socket::INET/, 'mailimapclient_connect ipv6: connect to ks2ipv6.lamiral.info' ) 
+        or diag( 'mailimapclient_connect ipv6: ', $imap->LastError(  ), $!,  ) ;
+        }
+        #is( $imap->logout( ), undef, 'mailimapclient_connect ipv6: logout in ssl causes failure' ) ;
+        is( undef, undef $imap, 'mailimapclient_connect ipv6: free variable' ) ;
+
+        note( 'Leaving  tests_mailimapclient_connect_bug()' ) ;
+        return ;
+}
+
+sub mailimapclient_connect  {
+
+
+        return ;
+}
+
+
+      
+sub tests_connect_socket {
+        note( 'Entering tests_connect_socket()' ) ;
+        
+	is( undef, connect_socket(  ), 'connect_socket: no args' ) ;
+
+        my $socket ;
+        my $imap ;
+        SKIP: {
+                if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE cannot do ipv6', 2 ) ; }
+                
+	$socket = IO::Socket::INET6->new( 
+		PeerAddr => 'ks2ipv6.lamiral.info',
+		PeerPort => 143,
+	) ;
+
+	
+	ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 143 IO::Socket::INET6' ) ;
+        #$imap->Debug( 1 ) ;
+        #print $imap->capability(  ) ;
+	if ( $imap ) { 
+                $imap->logout(  ) ;
+        }
+	
+        #$IO::Socket::SSL::DEBUG = 4 ;
+	$socket = IO::Socket::SSL->new( 
+		PeerHost => 'ks2ipv6.lamiral.info',
+		PeerPort => 993,
+                SSL_verify_mode => SSL_VERIFY_NONE,
+	) ;
+	#print $socket ;
+	ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 993 IO::Socket::SSL' ) ;
+        #$imap->Debug( 1 ) ;
+        #print $imap->capability(  ) ;
+        $socket->close(  ) ;
+	if ( $imap ) { 
+                $socket->close(  ) ;
+        }
+        #$socket->close(SSL_no_shutdown => 1) ;
+        #$imap->logout(  ) ;
+        #print "\n" ;
+	#$imap->logout(  ) ;
+        }
+
+        note( 'Leaving  tests_connect_socket()' ) ;
+        return ;
+}
+
+sub connect_socket {
+	my( $socket ) = @ARG ;
+
+	if ( ! defined $socket ) { return ; }
+	
+	my $host = $socket->peerhost(  ) ;
+	my $port = $socket->peerport(  ) ;
+	#print "socket->peerhost: ", $socket->peerhost(  ), "\n" ;
+	#print "socket->peerport: ", $socket->peerport(  ), "\n" ;
+	my $imap = Mail::IMAPClient->new(  ) ;
+	$imap->Socket( $socket ) ;
+	my $banner = $imap->Results()->[0] ;
+	#myprint( "banner: $banner"  ) ;
+	return $imap ;
+}
+
+
+sub tests_probe_imapssl {
+        note( 'Entering tests_probe_imapssl()' ) ;
+
+        is( undef, probe_imapssl(  ),          'probe_imapssl: no args => undef' ) ;
+        is( undef, probe_imapssl( 'unknown' ), 'probe_imapssl: unknown => undef' ) ;
+
+	SKIP: {
+                if ( 'CUILLERE' eq hostname() ) { skip( 'Tests avoided on CUILLERE cannot do ipv6', 1 ) ; }
+                like( probe_imapssl( 'ks2ipv6.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: ks2ipv6.lamiral.info matches "* OK"' ) ;
+        } ;
+
+        like( probe_imapssl( 'test1.lamiral.info' ),   qr/^\* OK/, 'probe_imapssl: test1.lamiral.info matches "* OK"' ) ;
+        like( probe_imapssl( 'imap.gmail.com' ),       qr/^\* OK/, 'probe_imapssl: imap.gmail.com matches "* OK"' ) ;
+
+        note( 'Leaving  tests_probe_imapssl()' ) ;
+        return ;
+}
+
+sub probe_imapssl {
+        my $host = shift ;
+        
+        if ( ! $host ) { return ; }
+        
+  	my $socket = IO::Socket::SSL->new( 
+		PeerHost => $host,
+		PeerPort => $IMAP_SSL_PORT,
+                SSL_verify_mode => SSL_VERIFY_NONE,
+	) ;
+        #print "$socket\n" ;
+        if ( ! $socket ) { return ; }
+        
+        my $banner ;
+        $socket->sysread( $banner, 65_536 ) ;
+        #print "$banner" ;
+        $socket->close(  ) ;
+        return $banner ;
+
+}
+
 sub connect_imap {
-	my( $host, $port, $mydebugimap, $ssl, $tls, $Side, $mytimeout, $h ) = @_ ;
-	my $imap = Mail::IMAPClient->new() ;
-	if ( $ssl ) { set_ssl( $imap, $h ) }
-	if ( $tls ) { $imap->Tls( 1 ) }
-	$imap->Server( $host ) ;
-	$imap->Port( $port ) ;
-	$imap->Debug( $mydebugimap ) ;
+        my( $host, $port, $mydebugimap, $ssl, $tls, $Side, $mytimeout, $h ) = @_ ;
+        my $imap = Mail::IMAPClient->new(  ) ;
+        if ( $ssl ) { set_ssl( $imap, $h ) }
+        $imap->Server( $host ) ;
+        $imap->Port( $port ) ;
+        $imap->Debug( $mydebugimap ) ;
         $imap->Timeout( $mytimeout ) ;
-	$imap->connect(  )
-	  or die_clean( "$Side: Can not open imap connection on [$host]: $@\n" ) ;
 
+        my $side = lc $Side ;
+        myprint( "$Side: connecting on $side [$host] port [$port]\n"  ) ;
+
+        $imap->connect(  )
+          or die_clean( "$Side: Can not open imap connection on [$host]: " . $imap->LastError . " $OS_ERROR\n" ) ;
+		myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n"  ) ;
         my $banner = $imap->Results()->[0] ;
-        $imap->Banner( $banner ) ;
 
-        if ( $imap->Tls(  ) ) {
-        	set_tls( $imap, $h ) ;
-        	$imap->starttls(  )
-                or die_clean("$Side: Can not go to tls encryption on [$host]:", $imap->LastError, "\n" ) ;
+        myprint( "$Side banner: $banner"  ) ;
+        myprint( "$Side capability: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;
+
+        if ( $tls ) {
+                set_tls( $imap, $h ) ;
+                $imap->starttls(  )
+                or die_clean("$Side: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ;
                 myprint( "$Side: Socket successfuly converted to SSL\n"  ) ;
         }
         return( $imap ) ;
@@ -3099,57 +4069,63 @@ sub connect_imap {
 
 sub login_imap {
 
-	my @allargs = @_ ;
-	my(
-		$host, $port, $user, $domain, $password,
-		$mydebugimap, $mytimeout, $fastio,
-		$ssl, $tls, $authmech, $authuser, $reconnectretry,
-		$proxyauth, $uid, $split, $Side, $h ) = @allargs ;
+        my @allargs = @_ ;
+        my(
+                $host, $port, $user, $domain, $password,
+                $mydebugimap, $mytimeout, $fastio,
+                $ssl, $tls, $authmech, $authuser, $reconnectretry,
+                $proxyauth, $uid, $split, $Side, $h, $mysync ) = @allargs ;
 
-	my $side = lc $Side ;
-	myprint( "$Side: connecting and login on $side [$host] port [$port] with user [$user]\n"  ) ;
+        my $side = lc $Side ;
+        myprint( "$Side: connecting and login on $side [$host] port [$port] with user [$user]\n"  ) ;
 
-	my $imap = init_imap( @allargs ) ;
-
-	$imap->connect()
-	  or die_clean("$Side failure: can not open imap connection on $side [$host] with user [$user]: $@\n") ;
+        my $imap = init_imap( @allargs ) ;
 
+        $imap->connect()
+          or die_clean("$Side failure: can not open imap connection on $side [$host] with user [$user]: " . $imap->LastError . " $OS_ERROR\n" ) ;
+		myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n"  ) ;
         my $banner = $imap->Results()->[0] ;
-        $imap->Banner( $banner ) ;
-	myprint( "$Side banner: $banner"  ) ;
+
+        myprint( "$Side banner: $banner"  ) ;
+	myprint( "$Side capability before authentication: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;
+
+	if ( (! $ssl) and (! defined $tls ) and $imap->has_capability( 'STARTTLS' ) ) {
+		myprint( "$Side: going to ssl because STARTTLS is in CAPABILITY. Use --notls1 or --notls2 to avoid that behavior\n" ) ;
+		$tls = 1 ;
+	}
 
         if ( $authmech eq 'PREAUTH' ) {
-        	if ( $imap->IsAuthenticated( ) ) {
-        		$imap->Socket ;
-			myprintf("%s: Assuming PREAUTH for %s\n", $Side, $imap->Server ) ;
-        	}else{
-                	die_clean( "$Side failure: error login on $side [$host] with user [$user] auth [PREAUTH]" ) ;
+                if ( $imap->IsAuthenticated( ) ) {
+                        $imap->Socket ;
+                        myprintf("%s: Assuming PREAUTH for %s\n", $Side, $imap->Server ) ;
+                }else{
+                        die_clean( "$Side failure: error login on $side [$host] with user [$user] auth [PREAUTH]" ) ;
                 }
         }
 
-        if ( $imap->Tls(  ) ) {
-		set_tls( $imap, $h ) ;
-        	$imap->starttls(  )
+        if ( $tls ) {
+                set_tls( $imap, $h ) ;
+                $imap->starttls(  )
                 or die_clean("$Side failure: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ;
                 myprint( "$Side: Socket successfuly converted to SSL\n"  ) ;
         }
 
         authenticate_imap( $imap, @allargs ) ;
 
-	myprint( "$Side: success login on [$host] with user [$user] auth [$authmech]\n"  ) ;
-	return( $imap ) ;
+        myprint( "$Side: success login on [$host] with user [$user] auth [$authmech]\n"  ) ;
+        return( $imap ) ;
 }
 
 
 sub authenticate_imap {
 
-	my($imap,
+        my($imap,
            $host, $port, $user, $domain, $password,
-	   $mydebugimap, $mytimeout, $fastio,
-	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
-	   $proxyauth, $uid, $split, $Side, $h ) = @_ ;
+           $mydebugimap, $mytimeout, $fastio,
+           $ssl, $tls, $authmech, $authuser, $reconnectretry,
+           $proxyauth, $uid, $split, $Side, $h, $mysync ) = @_ ;
 
-	check_capability( $imap, $authmech, $Side ) ;
+        check_capability( $imap, $authmech, $Side ) ;
 
         if ( $proxyauth ) {
                 $imap->Authmechanism(q{}) ;
@@ -3159,29 +4135,29 @@ sub authenticate_imap {
                 $imap->User($user) ;
         }
 
-	$imap->Authcallback(\&xoauth)  if ( 'XOAUTH'  eq $authmech ) ;
-	$imap->Authcallback(\&xoauth2) if ( 'XOAUTH2' eq $authmech ) ;
-	$imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $authmech ) or ( 'EXTERNAL' eq $authmech )  ) ;
+        $imap->Authcallback(\&xoauth)  if ( 'XOAUTH'  eq $authmech ) ;
+        $imap->Authcallback(\&xoauth2) if ( 'XOAUTH2' eq $authmech ) ;
+        $imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $authmech ) or ( 'EXTERNAL' eq $authmech )  ) ;
 
         $imap->Domain($domain) if (defined $domain) ;
         $imap->Authuser($authuser) ;
         $imap->Password($password) ;
 
-	unless ( $authmech eq 'PREAUTH' or $imap->login( ) ) {
-		my $info  = "$Side failure: Error login on [$host] with user [$user] auth" ;
-		my $einfo = $imap->LastError || @{$imap->History}[$LAST] ;
-		chomp $einfo ;
-		my $error = "$info [$authmech]: $einfo\n" ;
+        unless ( $authmech eq 'PREAUTH' or $imap->login( ) ) {
+                my $info  = "$Side failure: Error login on [$host] with user [$user] auth" ;
+                my $einfo = $imap->LastError || @{$imap->History}[$LAST] ;
+                chomp $einfo ;
+                my $error = "$info [$authmech]: $einfo\n" ;
                 if ( $authmech eq 'LOGIN' or $imap->IsUnconnected(  ) or $authuser ) {
-                	die_clean( $error ) ;
+                        die_clean( $error ) ;
                 }else{
-			myprint( $error  ) ;
+                        myprint( $error  ) ;
                 }
-		myprint( "$Side info: trying LOGIN Auth mechanism on [$host] with user [$user]\n"  ) ;
-		$imap->Authmechanism(q{}) ;
-		$imap->login() or
-		  die_clean("$info [LOGIN]: ", $imap->LastError, "\n") ;
-	}
+                myprint( "$Side info: trying LOGIN Auth mechanism on [$host] with user [$user]\n"  ) ;
+                $imap->Authmechanism(q{}) ;
+                $imap->login() or
+                  die_clean("$info [LOGIN]: ", $imap->LastError, "\n") ;
+        }
 
         if ( $proxyauth ) {
                 if ( ! $imap->proxyauth( $user ) ) {
@@ -3192,41 +4168,50 @@ sub authenticate_imap {
                 }
         }
 
-	return ;
+        return ;
 }
 
-sub check_capability {
+sub check_capability  {
 
-	my( $imap, $authmech, $Side ) = @_ ;
+        my( $imap, $authmech, $Side ) = @_ ;
 
-	if ($imap->has_capability("AUTH=$authmech")
-	    or $imap->has_capability($authmech)
-	   ) {
-		myprintf("%s: %s says it has CAPABILITY for AUTHENTICATE %s\n",
-		       $Side, $imap->Server, $authmech);
+
+        if ($imap->has_capability( "AUTH=$authmech" )
+            or $imap->has_capability( $authmech ) ) {
+                myprintf("%s: %s says it has CAPABILITY for AUTHENTICATE %s\n",
+                       $Side, $imap->Server, $authmech) ;
+		return ;
+        }
+
+	if ( $authmech eq 'LOGIN' ) {
+		# Well, the warning is so common and useless that I prefer to remove it
+		# No more "... says it has NO CAPABILITY for AUTHENTICATE LOGIN"
+		return ;
 	}
-	else {
-		myprintf("%s: %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
-		       $Side, $imap->Server, $authmech);
-		if ($authmech eq 'PLAIN') {
-			myprint( "$Side: frequently PLAIN is only supported with SSL, ",
-			  "try --ssl or --tls options\n" ) ;
-		}
-	}
-	return ;
+
+
+	myprintf( "%s: %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
+                       $Side, $imap->Server, $authmech ) ;
+
+		       if ($authmech eq 'PLAIN') {
+		myprint( "$Side: frequently PLAIN is only supported with SSL, try --ssl or --tls options\n" ) ;
+        }
+
+        return ;
 }
 
 sub set_ssl {
-	my ( $imap, $h ) = @_ ;
+        my ( $imap, $h ) = @_ ;
         # SSL_version can be
         #    SSLv3 SSLv2 SSLv23 SSLv23:!SSLv2 (last one is the default in IO-Socket-SSL-1.953)
         #
 
         my $sslargs_hash = $h->{sslargs} ;
 
-	my $sslargs_default = {
-		SSL_verify_mode => $DEFAULT_SSL_VERIFY,
-        	SSL_verifycn_scheme => 'imap',
+        my $sslargs_default = {
+                SSL_verify_mode => $DEFAULT_SSL_VERIFY,
+                SSL_verifycn_scheme => 'imap',
+		SSL_cipher_list => 'DEFAULT:!DH',
         } ;
 
         # initiate with default values
@@ -3241,16 +4226,17 @@ sub set_ssl {
         my @sslargs_mix = %sslargs_mix ;
         #myprint( Data::Dumper->Dump( [ $sslargs_hash, $sslargs_default, \%sslargs_mix, \@sslargs_mix ] )  ) ;
         $imap->Ssl( \@sslargs_mix ) ;
-	return ;
+        return ;
 }
 
 sub set_tls {
-	my ( $imap, $h ) = @_ ;
+        my ( $imap, $h ) = @_ ;
 
         my $sslargs_hash = $h->{sslargs} ;
 
-	my $sslargs_default = {
-		SSL_verify_mode => $DEFAULT_SSL_VERIFY,
+        my $sslargs_default = {
+                SSL_verify_mode => $DEFAULT_SSL_VERIFY,
+		SSL_cipher_list => 'DEFAULT:!DH',
         } ;
 
         # initiate with default values
@@ -3265,42 +4251,47 @@ sub set_tls {
         my @sslargs_mix = %sslargs_mix ;
 
         $imap->Starttls( \@sslargs_mix ) ;
-	return ;
+        return ;
 }
 
 
 
 
 sub init_imap {
-	my(
-	   $host, $port, $user, $domain, $password,
-	   $mydebugimap, $mytimeout, $fastio,
-	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
-	   $proxyauth, $uid, $split, $Side, $h ) = @_ ;
+        my(
+           $host, $port, $user, $domain, $password,
+           $mydebugimap, $mytimeout, $fastio,
+           $ssl, $tls, $authmech, $authuser, $reconnectretry,
+           $proxyauth, $uid, $split, $Side, $h, $mysync ) = @_ ;
 
-	my ( $imap ) ;
+        my ( $imap ) ;
 
-	$imap = Mail::IMAPClient->new() ;
+        $imap = Mail::IMAPClient->new() ;
 
-	if ( $ssl ) { set_ssl( $imap, $h ) }
-	if ( $tls ) { $imap->Tls( 1 ) } # can not do set_tls() here because connect() will directly do a STARTTLS
-	$imap->Clear(1);
-	$imap->Server($host);
-	$imap->Port($port);
-	$imap->Fast_io($fastio);
-	$imap->Buffer($buffersize || $DEFAULT_BUFFER_SIZE);
-	$imap->Uid($uid);
-
-	$imap->Peek(1);
-	$imap->Debug($mydebugimap);
-	defined  $mytimeout  and $imap->Timeout( $mytimeout ) ;
-
-	$imap->Reconnectretry( $reconnectretry ) if ( $reconnectretry ) ;
-	$imap->Ignoresizeerrors( $allowsizemismatch ) ;
-	$split and $imap->Maxcommandlength( $SPLIT_FACTOR * $split ) ;
+        if ( $ssl ) { set_ssl( $imap, $h ) }
+        if ( $tls ) {  } # can not do set_tls() here because connect() will directly do a STARTTLS
+        $imap->Clear(1);
+        $imap->Server($host);
+        $imap->Port($port);
+        $imap->Fast_io($fastio);
+        $imap->Buffer($buffersize || $DEFAULT_BUFFER_SIZE);
+        $imap->Uid($uid);
 
 
-	return( $imap ) ;
+        $imap->Peek(1);
+        $imap->Debug($mydebugimap);
+	if ( $mysync->{ showpasswords } ) {
+		$imap->Showcredentials( 1 ) ;
+	}
+        defined  $mytimeout  and $imap->Timeout( $mytimeout ) ;
+
+        $imap->Reconnectretry( $reconnectretry ) if ( $reconnectretry ) ;
+	$imap->{IMAPSYNC_RECONNECT_COUNT} = 0 ;
+        $imap->Ignoresizeerrors( $allowsizemismatch ) ;
+        $split and $imap->Maxcommandlength( $SPLIT_FACTOR * $split ) ;
+
+
+        return( $imap ) ;
 
 }
 
@@ -3341,12 +4332,12 @@ sub plainauth {
 # If the password arg ends in .json, it will assume this new json method, otherwise it
 # will fallback to the "oauth client id;.p12" format it was previously using.
 sub xoauth2 {
-	require JSON::WebToken ;
-	require LWP::UserAgent ;
-	require HTML::Entities ;
-	require JSON ;
-	require JSON::WebToken::Crypt::RSA ;
-	require Crypt::OpenSSL::RSA ;
+        require JSON::WebToken ;
+        require LWP::UserAgent ;
+        require HTML::Entities ;
+        require JSON ;
+        require JSON::WebToken::Crypt::RSA ;
+        require Crypt::OpenSSL::RSA ;
         require Encode::Byte ;
         require IO::Socket::SSL ;
 
@@ -3355,11 +4346,11 @@ sub xoauth2 {
 
         my ($iss,$key);
 
-        if( $imap->Password =~ /^(.*\.json)$/ ) {
+        if( $imap->Password =~ /^(.*\.json)$/x ) {
             my $json = JSON->new( ) ;
             my $filename = $1;
             $debug and myprint( "XOAUTH2 json file: $filename\n" ) ;
-            open( my $FILE, '<', $filename ) or die_clean( "error [$filename]: $! " ) ;
+            open( my $FILE, '<', $filename ) or die_clean( "error [$filename]: $OS_ERROR " ) ;
             my $jsonfile = $json->decode( join q{}, <$FILE> ) ;
             close $FILE ;
 
@@ -3370,7 +4361,7 @@ sub xoauth2 {
         }
         else {
             # Get iss (service account address), keyfile name, and keypassword if necessary
-            ( $iss, my $keyfile, my $keypass ) = $imap->Password =~ /([\-\d\w\@\.]+);([a-zA-Z0-9 \_\-\.\/]+);?(.*)?/ ;
+            ( $iss, my $keyfile, my $keypass ) = $imap->Password =~ /([\-\d\w\@\.]+);([a-zA-Z0-9 \_\-\.\/]+);?(.*)?/x ;
 
             # Assume key password is google default if not provided
             $keypass = 'notasecret' if not $keypass;
@@ -3494,211 +4485,224 @@ sub xoauth {
         return encode_base64("$string", q{});
 }
 
-sub server_banner {
-	my $imap = shift;
-	my $banner = $imap->Banner() ||  "No banner\n";
-	return $banner;
- }
 
 
 sub banner_imapsync {
 
-	my @argv = @_ ;
+        my @argv = @_ ;
 
-	my $banner_imapsync = join q{},
-		q{$RCSfile: imapsync,v $ },
-		q{$Revision: 1.727 $ },
-		q{$Date: 2016/08/19 10:30:36 $ },
-		"\n", localhost_info(), "\n",
-		"Command line used:\n",
-		"$0 ", command_line_nopassword( @argv ), "\n" ;
+        my $banner_imapsync = join q{},
+                q{$RCSfile: imapsync,v $ },
+                q{$Revision: 1.836 $ },
+                q{$Date: 2017/09/05 16:14:53 $ },
+                "\n", localhost_info(), "\n",
+                "Command line used:\n",
+                "$PROGRAM_NAME ", command_line_nopassword( @argv ), "\n" ;
 
         return( $banner_imapsync ) ;
 }
 
-sub is_valid_directory {
-	my $dir = shift;
+sub do_valid_directory {
+        my $dir = shift;
 
-	# all good => return ok.
-	return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
+        # all good => return ok.
+        return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
 
-	# exist but bad
-	if ( -e $dir and not -d _ ) {
-		myprint( "Error: $dir exists but is not a directory\n"  ) ;
-		return( 0 ) ;
-	}
-	if ( -e $dir and not -w _ ) {
-		my $sb = stat $dir ;
-		myprintf( "Error: directory %s is not writable for user %s, permissions are %04o and owner is %s ( uid %s )\n",
-		         $dir, getpwuid_any_os( $EFFECTIVE_USER_ID ), ($sb->mode & oct($PERMISSION_FILTER) ), getpwuid_any_os( $sb->uid ), $sb->uid(  ) ) ;
-		return( 0 ) ;
-	}
-	# Trying to create it
-	myprint( "Creating directory $dir\n"  ) ;
-	eval { mkpath( $dir ) } ;
-	myprint( "$@" ) if ( $@ )  ;
-	return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
-	return( 0 ) ;
+        # exist but bad
+        if ( -e $dir and not -d _ ) {
+                myprint( "Error: $dir exists but is not a directory\n"  ) ;
+                return( 0 ) ;
+        }
+        if ( -e $dir and not -w _ ) {
+                my $sb = stat $dir ;
+                myprintf( "Error: directory %s is not writable for user %s, permissions are %04o and owner is %s ( uid %s )\n",
+                         $dir, getpwuid_any_os( $EFFECTIVE_USER_ID ), ($sb->mode & oct($PERMISSION_FILTER) ), getpwuid_any_os( $sb->uid ), $sb->uid(  ) ) ;
+                return( 0 ) ;
+        }
+        # Trying to create it
+        myprint( "Creating directory $dir\n"  ) ;
+        if ( ! eval { mkpath( $dir ) } ) {
+                myprint( "$EVAL_ERROR" ) if ( $EVAL_ERROR )  ;
+        }
+        return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
+        return( 0 ) ;
 }
 
-sub tests_is_valid_directory {
-        Readonly my $NB_UNIX_tests_is_valid_directory => 4 ;
-	SKIP: {
-		skip( 'Tests only for Unix', $NB_UNIX_tests_is_valid_directory ) if ( 'MSWin32' eq $OSNAME ) ;
-		ok( 1 == is_valid_directory( '.'), 'is_valid_directory: . good' ) ;
-		ok( 1 == is_valid_directory( './tmp/tests/valid/sub'), 'is_valid_directory: ./tmp/tests/valid/sub good' ) ;
-		diag( 'Error / not writable is on purpose' ) ;
-		ok( 0 == is_valid_directory( '/'), 'is_valid_directory: / bad' ) ;
-		diag( 'Error permission denied on /noway is on purpose' ) ;
-		ok( 0 == is_valid_directory( '/noway'), 'is_valid_directory: /noway bad' ) ;
-	}
-	return ;
+sub tests_do_valid_directory {
+	note( 'Entering tests_do_valid_directory()' ) ;
+
+        Readonly my $NB_UNIX_tests_do_valid_directory => 4 ;
+        SKIP: {
+                skip( 'Tests only for Unix', $NB_UNIX_tests_do_valid_directory ) if ( 'MSWin32' eq $OSNAME ) ;
+                ok( 1 == do_valid_directory( '.'), 'do_valid_directory: . good' ) ;
+                ok( 1 == do_valid_directory( './W/tmp/tests/valid/sub'), 'do_valid_directory: ./W/tmp/tests/valid/sub good' ) ;
+                diag( 'Error / not writable is on purpose' ) ;
+                ok( 0 == do_valid_directory( '/'), 'do_valid_directory: / bad' ) ;
+                diag( 'Error permission denied on /noway is on purpose' ) ;
+                ok( 0 == do_valid_directory( '/noway'), 'do_valid_directory: /noway bad' ) ;
+        }
+	note( 'Leaving  tests_do_valid_directory()' ) ;
+        return ;
 }
 
 sub write_pidfile {
-	my $pid_filename = shift ;
+        my $pid_filename = shift ;
         my $lock = shift ;
-        
-	myprint( "PID file is $pid_filename ( to change it use --pidfile filepath ; to avoid it use --pidfile \"\" )\n" ) ;
-	if ( -e $pid_filename and $lock ) {
-		myprint( "$pid_filename already exists, another imapsync may be curently running. Aborting imapsync.\n"  ) ;
+
+        myprint( "PID file is $pid_filename ( to change it use --pidfile filepath ; to avoid it use --pidfile \"\" )\n" ) ;
+        if ( -e $pid_filename and $lock ) {
+                myprint( "$pid_filename already exists, another imapsync may be curently running. Aborting imapsync.\n"  ) ;
                 exit $EXIT_PID_FILE_ALREADY_EXIST ;
-	}
-	if ( -e $pid_filename ) {
-		myprint( "$pid_filename already exists, overwriting it ( use --pidfilelocking to avoid concurrent runs )\n"  ) ;
-	}
+        }
+        if ( -e $pid_filename ) {
+                myprint( "$pid_filename already exists, overwriting it ( use --pidfilelocking to avoid concurrent runs )\n"  ) ;
+        }
 
-	open my $FILE_HANDLE, '>', $pid_filename
-        	or do {
-			myprint( "Could not open $pid_filename for writing. Check permissions or disk space."  ) ;
-		return ;
-	} ;
-        myprint( "Wrinting my PID $PROCESS_ID in $pid_filename\n"  ) ;
-	print $FILE_HANDLE $PROCESS_ID ;
-	close $FILE_HANDLE ;
+        open my $FILE_HANDLE, '>', $pid_filename
+                or do {
+                        myprint( "Could not open $pid_filename for writing. Check permissions or disk space."  ) ;
+                return ;
+        } ;
+        myprint( "Writing my PID $PROCESS_ID in $pid_filename\n"  ) ;
+        print $FILE_HANDLE $PROCESS_ID ;
+        close $FILE_HANDLE ;
 
-	return( $PROCESS_ID ) ;
+        return( $PROCESS_ID ) ;
 }
 
 sub remove_tmp_files {
-        my $mysync = shift ;
-	unlink $mysync->{pidfile} ;
-	return ;
+        my $mysync = shift or return ;
+	$mysync->{pidfile} or return ;
+        if ( -e $mysync->{pidfile} ) {
+		unlink $mysync->{pidfile} ;
+	}
+        return ;
 }
 
 
 sub exit_clean {
         my $mysync = shift ;
-	my $status = shift ;
-	$status = defined  $status  ? $status : $EXIT_UNKNOWN ;
+        my $status = shift ;
+        $status = defined  $status  ? $status : $EXIT_UNKNOWN ;
         remove_tmp_files( $mysync ) ;
         myprint( "Exiting with return value $status\n" ) ;
         if ( $mysync->{log} ) {
                 myprint( "Log file is $mysync->{logfile} ( to change it, use --logfile filepath ; or use --nolog to turn off logging )\n" ) ;
                 close $mysync->{logfile_handle} ;
         }
-	exit $status ;
+        exit $status ;
 }
 
 sub die_clean {
-	my @messages = @_ ;
+        my @messages = @_ ;
         remove_tmp_files( $sync ) ;
-	die @messages ;
+        myprint( @messages ) ;
+	exit 255 ;
 }
 
 sub missing_option {
-	my ( $option ) = @_ ;
-	die_clean( "$option option is mandatory, for help run $0 --help\n" ) ;
-	return ;
+        my ( $option ) = @_ ;
+        die_clean( "$option option is mandatory, for help run $PROGRAM_NAME --help\n" ) ;
+        return ;
 }
 
 
 sub fix_Inbox_INBOX_mapping {
-	my( $h1_all, $h2_all ) = @_ ;
+        my( $h1_all, $h2_all ) = @_ ;
 
-	my $regex = q{} ;
-	SWITCH: {
-		if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{INBOX}  ) { $regex = q{} ; last SWITCH ; } ;
-		if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{Inbox}  ) { $regex = q{} ; last SWITCH ; } ;
-		if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{Inbox}  ) { $regex = q{s/^INBOX$/Inbox/x} ; last SWITCH ; } ;
-		if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{INBOX}  ) { $regex = q{s/^Inbox$/INBOX/x} ; last SWITCH ; } ;
-	} ;
+        my $regex = q{} ;
+        SWITCH: {
+                if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{INBOX}  ) { $regex = q{} ; last SWITCH ; } ;
+                if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{Inbox}  ) { $regex = q{} ; last SWITCH ; } ;
+                if ( exists  $h1_all->{INBOX}  and exists  $h2_all->{Inbox}  ) { $regex = q{s/^INBOX$/Inbox/x} ; last SWITCH ; } ;
+                if ( exists  $h1_all->{Inbox}  and exists  $h2_all->{INBOX}  ) { $regex = q{s/^Inbox$/INBOX/x} ; last SWITCH ; } ;
+        } ;
         return( $regex ) ;
 }
 
 sub tests_fix_Inbox_INBOX_mapping {
+	note( 'Entering tests_fix_Inbox_INBOX_mapping()' ) ;
 
-	my( $h1_all, $h2_all ) ;
 
-	$h1_all = { 'INBOX' => q{} } ;
-	$h2_all = { 'INBOX' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX INBOX' ) ;
+        my( $h1_all, $h2_all ) ;
 
-	$h1_all = { 'Inbox' => q{} } ;
-	$h2_all = { 'Inbox' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox Inbox' ) ;
+        $h1_all = { 'INBOX' => q{} } ;
+        $h2_all = { 'INBOX' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX INBOX' ) ;
 
-	$h1_all = { 'INBOX' => q{} } ;
-	$h2_all = { 'Inbox' => q{} } ;
-	ok( q{s/^INBOX$/Inbox/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX Inbox' ) ;
+        $h1_all = { 'Inbox' => q{} } ;
+        $h2_all = { 'Inbox' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox Inbox' ) ;
 
-	$h1_all = { 'Inbox' => q{} } ;
-	$h2_all = { 'INBOX' => q{} } ;
-	ok( q{s/^Inbox$/INBOX/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox INBOX' ) ;
+        $h1_all = { 'INBOX' => q{} } ;
+        $h2_all = { 'Inbox' => q{} } ;
+        ok( q{s/^INBOX$/Inbox/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX Inbox' ) ;
 
-	$h1_all = { 'INBOX' => q{} } ;
-	$h2_all = { 'rrrrr' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX rrrrrr' ) ;
+        $h1_all = { 'Inbox' => q{} } ;
+        $h2_all = { 'INBOX' => q{} } ;
+        ok( q{s/^Inbox$/INBOX/x} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox INBOX' ) ;
 
-	$h1_all = { 'rrrrr' => q{} } ;
-	$h2_all = { 'Inbox' => q{} } ;
-	ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: rrrrr Inbox' ) ;
+        $h1_all = { 'INBOX' => q{} } ;
+        $h2_all = { 'rrrrr' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX rrrrrr' ) ;
 
-	return ;
+        $h1_all = { 'rrrrr' => q{} } ;
+        $h2_all = { 'Inbox' => q{} } ;
+        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: rrrrr Inbox' ) ;
+
+	note( 'Leaving  tests_fix_Inbox_INBOX_mapping()' ) ;
+        return ;
 }
 
 
 sub jux_utf8_list {
-	my @s_inp = @_ ;
-	my $s_out = q{} ;
-	foreach my $s ( @s_inp ) {
-		$s_out .= jux_utf8( $s ) . "\n" ;
-	}
-	return( $s_out ) ;
+        my @s_inp = @_ ;
+        my $s_out = q{} ;
+        foreach my $s ( @s_inp ) {
+                $s_out .= jux_utf8( $s ) . "\n" ;
+        }
+        return( $s_out ) ;
 }
 
 sub tests_jux_utf8_list {
-	ok( q{} eq jux_utf8_list(  ), 'jux_utf8_list: void' ) ;
-	ok( "[]\n" eq jux_utf8_list( q{} ), 'jux_utf8_list: empty string' ) ;
-	ok( "[INBOX]\n" eq jux_utf8_list( 'INBOX' ), 'jux_utf8_list: INBOX' ) ;
-	ok( "[&ANY-] = [Ö]\n" eq jux_utf8_list( '&ANY-' ), 'jux_utf8_list: &ANY-' ) ;
-	return( 0 ) ;
+	note( 'Entering tests_jux_utf8_list()' ) ;
+
+        ok( q{} eq jux_utf8_list(  ), 'jux_utf8_list: void' ) ;
+        ok( "[]\n" eq jux_utf8_list( q{} ), 'jux_utf8_list: empty string' ) ;
+        ok( "[INBOX]\n" eq jux_utf8_list( 'INBOX' ), 'jux_utf8_list: INBOX' ) ;
+        ok( "[&ANY-] = [Ö]\n" eq jux_utf8_list( '&ANY-' ), 'jux_utf8_list: &ANY-' ) ;
+
+	note( 'Leaving  tests_jux_utf8_list()' ) ;
+        return( 0 ) ;
 }
 
 sub jux_utf8 {
-	# juxtapose utf8 at the right if different
+        # juxtapose utf8 at the right if different
         my ( $s_utf7 ) =  shift ;
         my ( $s_utf8 ) =  imap_utf7_decode( $s_utf7 ) ;
 
         if ( $s_utf7 eq $s_utf8 ) {
-        	#myprint( "[$s_utf7]\n"  ) ;
-        	return( "[$s_utf7]" ) ;
+                #myprint( "[$s_utf7]\n"  ) ;
+                return( "[$s_utf7]" ) ;
         }else{
-        	#myprint( "[$s_utf7] = [$s_utf8]\n"  ) ;
-        	return( "[$s_utf7] = [$s_utf8]" ) ;
+                #myprint( "[$s_utf7] = [$s_utf8]\n"  ) ;
+                return( "[$s_utf7] = [$s_utf8]" ) ;
         }
 }
 
 # editing utf8 can be tricky without an utf8 editor
 sub tests_jux_utf8 {
-	ok( '[INBOX]' eq jux_utf8( 'INBOX'), 'jux_utf8: INBOX => [INBOX]' ) ;
-	ok( '[&ZTZO9nux-] = [收件箱]' eq jux_utf8( '&ZTZO9nux-'), 'jux_utf8: => [&ZTZO9nux-] = [收件箱]' ) ;
-	ok( '[&ANY-] = [Ö]' eq jux_utf8( '&ANY-'), 'jux_utf8: &ANY- => [&ANY-] = [Ö]' ) ;
+	note( 'Entering tests_jux_utf8()' ) ;
+
+        ok( '[INBOX]' eq jux_utf8( 'INBOX'), 'jux_utf8: INBOX => [INBOX]' ) ;
+        ok( '[&ZTZO9nux-] = [收件箱]' eq jux_utf8( '&ZTZO9nux-'), 'jux_utf8: => [&ZTZO9nux-] = [收件箱]' ) ;
+        ok( '[&ANY-] = [Ö]' eq jux_utf8( '&ANY-'), 'jux_utf8: &ANY- => [&ANY-] = [Ö]' ) ;
         ok( '[]' eq jux_utf8( q{} ), 'jux_utf8: void => []' ) ;
         ok( '[+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]' eq jux_utf8( '+BD8EQAQ1BDQEOwQ+BDM-' ), 'jux_utf8: => [+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]' ) ;
         ok( '[&BB8EQAQ+BDUEOgRC-] = [Проект]'      eq jux_utf8( '&BB8EQAQ+BDUEOgRC-' ),    'jux_utf8: => [&BB8EQAQ+BDUEOgRC-] = [Проект]' ) ;
 
-	return( 0 ) ;
+	note( 'Leaving  tests_jux_utf8()' ) ;
+        return ;
 }
 
 # Copied from http://cpansearch.perl.org/src/FABPOT/Unicode-IMAPUtf7-2.01/lib/Unicode/IMAPUtf7.pm
@@ -3711,64 +4715,64 @@ sub imap_utf7_decode {
         # On remplace , par / dans les BASE 64 (, entre & et -)
         # On remplace les &, non suivi d'un - par +
         # On remplace les &- par &
-        $s =~ s/&([^,&\-]*),([^,\-&]*)\-/&$1\/$2\-/g ;
-        $s =~ s/&(?!\-)/\+/g ;
-        $s =~ s/&\-/&/g ;
+        $s =~ s/&([^,&\-]*),([^,\-&]*)\-/&$1\/$2\-/xg ;
+        $s =~ s/&(?!\-)/\+/xg ;
+        $s =~ s/&\-/&/xg ;
         return( Unicode::String::utf7( $s )->utf8 ) ;
 }
 
 sub imap_utf7_encode {
-	my ( $s ) = @_ ;
+        my ( $s ) = @_ ;
 
-	$s = Unicode::String::utf8( $s )->utf7 ;
+        $s = Unicode::String::utf8( $s )->utf7 ;
 
-	$s =~ s/\+([^\/&\-]*)\/([^\/\-&]*)\-/\+$1,$2\-/g ;
-	$s =~ s/&/&\-/g ;
-	$s =~ s/\+([^+\-]+)?\-/&$1\-/g ;
-	return( $s ) ;
+        $s =~ s/\+([^\/&\-]*)\/([^\/\-&]*)\-/\+$1,$2\-/xg ;
+        $s =~ s/&/&\-/xg ;
+        $s =~ s/\+([^+\-]+)?\-/&$1\-/xg ;
+        return( $s ) ;
 }
 
 
 
 
 sub select_folder {
-	my ( $imap, $folder, $hostside ) = @_ ;
-	if ( ! $imap->select( $folder ) ) {
-		my $error = join q{},
-			"$hostside folder $folder: Could not select: ",
-			$imap->LastError,  "\n" ;
-		errors_incr( $sync, $error ) ;
-		return( 0 ) ;
-	}else{
-		# ok select succeeded
-		return( 1 ) ;
-	}
+        my ( $imap, $folder, $hostside ) = @_ ;
+        if ( ! $imap->select( $folder ) ) {
+                my $error = join q{},
+                        "$hostside folder $folder: Could not select: ",
+                        $imap->LastError,  "\n" ;
+                errors_incr( $sync, $error ) ;
+                return( 0 ) ;
+        }else{
+                # ok select succeeded
+                return( 1 ) ;
+        }
 }
 
 sub examine_folder {
-	my ( $imap, $folder, $hostside ) = @_ ;
-	if ( ! $imap->examine( $folder ) ) {
-		my $error = join q{},
-			"$hostside folder $folder: Could not examine: ",
-			$imap->LastError,  "\n" ;
-		errors_incr( $sync, $error ) ;
-		return( 0 ) ;
-	}else{
-		# ok select succeeded
-		return( 1 ) ;
-	}
+        my ( $imap, $folder, $hostside ) = @_ ;
+        if ( ! $imap->examine( $folder ) ) {
+                my $error = join q{},
+                        "$hostside folder $folder: Could not examine: ",
+                        $imap->LastError,  "\n" ;
+                errors_incr( $sync, $error ) ;
+                return( 0 ) ;
+        }else{
+                # ok select succeeded
+                return( 1 ) ;
+        }
 }
 
 
 
 
 sub count_from_select {
-	my @lines = @_ ;
+        my @lines = @_ ;
         my $count ;
         foreach my $line ( @lines ) {
-        	#myprint( "line = [$line]\n"  ) ;
-                if ( $line =~ m/^\*\s+(\d+)\s+EXISTS/ ) {
-                	$count = $1 ;
+                #myprint( "line = [$line]\n"  ) ;
+                if ( $line =~ m/^\*\s+(\d+)\s+EXISTS/x ) {
+                        $count = $1 ;
                         return( $count ) ;
                 }
         }
@@ -3793,34 +4797,34 @@ sub count_from_select {
 
 
 sub create_folder_old {
-	my( $imap, $h2_fold, $h1_fold ) = @_ ;
+        my( $imap, $h2_fold, $h1_fold ) = @_ ;
 
-	myprint( "Creating (old way) folder [$h2_fold] on host2\n" ) ;
+        myprint( "Creating (old way) folder [$h2_fold] on host2\n" ) ;
         if ( ( 'INBOX' eq uc  $h2_fold )
          and ( $imap->exists( $h2_fold ) ) ) {
                 myprint( "Folder [$h2_fold] already exists\n"  ) ;
                 return( 1 ) ;
         }
-	if ( ! $dry ){
-		if ( ! $imap->create( $h2_fold ) ) {
-			my $error = join q{},
-				"Could not create folder [$h2_fold] from [$h1_fold]: ",
-				$imap->LastError(  ), "\n" ;
-			errors_incr( $sync, $error ) ;
+        if ( ! $sync->{dry} ){
+                if ( ! $imap->create( $h2_fold ) ) {
+                        my $error = join q{},
+                                "Could not create folder [$h2_fold] from [$h1_fold]: ",
+                                $imap->LastError(  ), "\n" ;
+                        errors_incr( $sync, $error ) ;
                         # success if folder exists ("already exists" error)
                         return( 1 ) if $imap->exists( $h2_fold ) ;
                         # failure since create failed
-			return( 0 ) ;
-		}else{
-			#create succeeded
+                        return( 0 ) ;
+                }else{
+                        #create succeeded
                         myprint( "Created ( the old way ) folder [$h2_fold] on host2\n"  ) ;
-			return( 1 ) ;
-		}
-	}else{
-		# dry mode, no folder so many imap will fail, assuming failure
-                myprint( "Created ( the old way ) folder [$h2_fold] on host2 $dry_message\n"  ) ;
-		return( 0 ) ;
-	}
+                        return( 1 ) ;
+                }
+        }else{
+                # dry mode, no folder so many imap will fail, assuming failure
+                myprint( "Created ( the old way ) folder [$h2_fold] on host2 $sync->{dry_message}\n"  ) ;
+                return( 0 ) ;
+        }
 }
 
 
@@ -3833,9 +4837,9 @@ sub create_folder {
                 return( 0 ) ;
         }
 
-	if ( $create_folder_old ) {
-        	return( create_folder_old( $imap2 , $h2_fold , $h1_fold ) ) ;
-	}
+        if ( $create_folder_old ) {
+                return( create_folder_old( $imap2 , $h2_fold , $h1_fold ) ) ;
+        }
         myprint( "Creating folder [$h2_fold] on host2\n"  ) ;
         if ( ( 'INBOX' eq uc  $h2_fold  )
          and ( $imap2->exists( $h2_fold ) ) ) {
@@ -3854,20 +4858,20 @@ sub create_folder {
                 return( 0 ) ;
         }
 
-        @parts = split /\Q$h2_sep\E/, $h2_fold ;
+        @parts = split /\Q$h2_sep\E/x, $h2_fold ;
         pop @parts ;
         $parent = join $h2_sep, @parts ;
-        $parent =~ s/^\s+|\s+$//g ;
+        $parent =~ s/^\s+|\s+$//xg ;
         if ( ( $parent ne q{} ) and ( ! $imap2->exists( $parent ) ) ) {
                 create_folder( $imap2 , $parent , $h1_fold ) ;
         }
 
-        if ( ! $dry ) {
+        if ( ! $sync->{dry} ) {
                 if ( ! $imap2->create( $h2_fold ) ) {
-			my $error = join q{},
-				"Could not create folder [$h2_fold] from [$h1_fold]: " ,
-				$imap2->LastError(  ), "\n" ;
-			errors_incr( $sync, $error ) ;
+                        my $error = join q{},
+                                "Could not create folder [$h2_fold] from [$h1_fold]: " ,
+                                $imap2->LastError(  ), "\n" ;
+                        errors_incr( $sync, $error ) ;
                         # success if folder exists ("already exists" error)
                         return( 1 ) if $imap2->exists( $h2_fold ) ;
                         # failure since create failed
@@ -3879,395 +4883,412 @@ sub create_folder {
                 }
         }else{
                 # dry mode, no folder so many imap will fail, assuming failure
-                myprint( "Created  folder [$h2_fold] on host2 $dry_message\n"  ) ;
+                myprint( "Created  folder [$h2_fold] on host2 $sync->{dry_message}\n"  ) ;
                 if ( ! $justfolders ) {
-			myprint( "Since --dry mode is on and folder [$h2_fold] on host2 does not exist yet, syncing messages will not be simulated.\n"
-			. "To simulate message syncing, use --justfolders without --dry to first create the missing folders then rerun the --dry sync.\n" ) ;
+                        myprint( "Since --dry mode is on and folder [$h2_fold] on host2 does not exist yet, syncing messages will not be simulated.\n"
+                        . "To simulate message syncing, use --justfolders without --dry to first create the missing folders then rerun the --dry sync.\n" ) ;
                 }
-		return( 0 ) ;
+                return( 0 ) ;
         }
 }
 
 
 
 sub tests_folder_routines {
-	ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 1'               );
-	ok(  add_to_requested_folders('folder_foo'), 'add_to_requested_folders folder_foo'       );
-	ok(  is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 2'               );
-	ok( !is_requested_folder('folder_NO_EXIST'), 'is_requested_folder folder_NO_EXIST'       );
-	ok( !remove_from_requested_folders('folder_foo'), 'removed folder_foo'                   );
-	ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 3'               );
-	my @f ;
-	ok(  @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f"        );
-	ok(  is_requested_folder('folder_bar'), 'is_requested_folder 4'                          );
-	ok(  is_requested_folder('folder_toto'), 'is_requested_folder 5'                         );
-	ok(  remove_from_requested_folders('folder_toto'), 'remove_from_requested_folders: '       );
-	ok( !is_requested_folder('folder_toto'), 'is_requested_folder 6'                         );
-	ok( !remove_from_requested_folders('folder_bar'), 'remove_from_requested_folders: empty' ) ;
+	note( 'Entering tests_folder_routines()' ) ;
+
+        ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 1'               );
+        ok(  add_to_requested_folders('folder_foo'), 'add_to_requested_folders folder_foo'       );
+        ok(  is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 2'               );
+        ok( !is_requested_folder('folder_NO_EXIST'), 'is_requested_folder folder_NO_EXIST'       );
+        ok( !remove_from_requested_folders('folder_foo'), 'removed folder_foo'                   );
+        ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 3'               );
+        my @f ;
+        ok(  @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f"        );
+        ok(  is_requested_folder('folder_bar'), 'is_requested_folder 4'                          );
+        ok(  is_requested_folder('folder_toto'), 'is_requested_folder 5'                         );
+        ok(  remove_from_requested_folders('folder_toto'), 'remove_from_requested_folders: '       );
+        ok( !is_requested_folder('folder_toto'), 'is_requested_folder 6'                         );
+        ok( !remove_from_requested_folders('folder_bar'), 'remove_from_requested_folders: empty' ) ;
 
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [] ), 'sort_requested_folders: all empty' ) ;
-	ok(  add_to_requested_folders('M_55'), 'add_to_requested_folders M_55'       );
+        ok(  add_to_requested_folders('M_55'), 'add_to_requested_folders M_55'       );
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'M_55' ] ), 'sort_requested_folders: middle' ) ;
-	@folderfirst = ( 'Z_11' ) ;
+        @folderfirst = ( 'Z_11' ) ;
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_55' ] ), 'sort_requested_folders: first+middle' ) ;
-	@folderlast = ( 'A_99' ) ;
+        @folderlast = ( 'A_99' ) ;
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_55', 'A_99' ] ), 'sort_requested_folders: first+middle+last 1' ) ;
 
-	ok(  add_to_requested_folders('M_55', 'M_44',), 'add_to_requested_folders M_55 M_44'       );
+        ok(  add_to_requested_folders('M_55', 'M_44',), 'add_to_requested_folders M_55 M_44'       );
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_44', 'M_55', 'A_99' ] ), 'sort_requested_folders: first+middle+last 2' ) ;
-	@folderfirst = qw( Z_22  Z_11 ) ;
-	@folderlast  = qw( A_99  A_88 ) ;
+        @folderfirst = qw( Z_22  Z_11 ) ;
+        @folderlast  = qw( A_99  A_88 ) ;
         ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [  'Z_22', 'Z_11', 'M_44', 'M_55', 'A_99', 'A_88' ] ), 'sort_requested_folders: first+middle+last 3' ) ;
 
-	return ;
-}
-
-
-sub sort_requested_folders {
-	my @requested_folders_sorted = () ;
-
-	foreach my $folder ( @folderfirst ) {
-        	remove_from_requested_folders( $folder ) ;
-        }
-
-	foreach my $folder ( @folderlast ) {
-        	remove_from_requested_folders( $folder ) ;
-        }
-
-	my @middle = sort keys %requested_folder ;
-
-        @requested_folders_sorted = ( @folderfirst, @middle, @folderlast ) ;
-
-	return( @requested_folders_sorted ) ;
-}
-
-sub is_requested_folder {
-	my ( $folder ) = @_;
-
-	return( defined  $requested_folder{ $folder }  ) ;
-}
-
-
-sub add_to_requested_folders {
-	my @wanted_folders = @_ ;
-
-	foreach my $folder ( @wanted_folders ) {
-	 	++$requested_folder{ $folder } ;
-	}
-	return( keys  %requested_folder  ) ;
-}
-
-sub remove_from_requested_folders {
-	my @wanted_folders = @_ ;
-
-	foreach my $folder ( @wanted_folders ) {
-	 	delete $requested_folder{ $folder } ;
-	}
-	return( keys %requested_folder ) ;
-}
-
-sub compare_lists {
-	my ($list_1_ref, $list_2_ref) = @_;
-
-	return($MINUS_ONE) if ((not defined $list_1_ref) and defined $list_2_ref);
-	return(0)  if ((not defined $list_1_ref) and not defined $list_2_ref); # end if no list
-	return(1)  if (not defined $list_2_ref); # end if only one list
-
-	if (not ref $list_1_ref ) {$list_1_ref = [$list_1_ref]};
-	if (not ref $list_2_ref ) {$list_2_ref = [$list_2_ref]};
-
-
-	my $last_used_indice = $MINUS_ONE;
-
-
-	ELEMENT:
-	foreach my $indice ( 0 .. $#{ $list_1_ref } ) {
-		$last_used_indice = $indice ;
-
-		# End of list_2
-		return 1 if ($indice > $#{ $list_2_ref } ) ;
-
-		my $element_list_1 = $list_1_ref->[$indice] ;
-		my $element_list_2 = $list_2_ref->[$indice] ;
-		my $balance = $element_list_1 cmp $element_list_2 ;
-		next ELEMENT if ($balance == 0) ;
-		return $balance ;
-	}
-	# each element equal until last indice of list_1
-	return $MINUS_ONE if ($last_used_indice < $#{ $list_2_ref } ) ;
-
-	# same size, each element equal
-	return 0 ;
-}
-
-sub tests_compare_lists {
-
-
-	my $empty_list_ref = [];
-
-	ok( 0 == compare_lists()               , 'compare_lists, no args');
-	ok( 0 == compare_lists(undef)          , 'compare_lists, undef = nothing');
-	ok( 0 == compare_lists(undef, undef)   , 'compare_lists, undef = undef');
-	ok($MINUS_ONE == compare_lists(undef , [])     , 'compare_lists, undef < []');
-	ok($MINUS_ONE == compare_lists(undef , [1])    , 'compare_lists, undef < [1]');
-	ok($MINUS_ONE == compare_lists(undef , [0])    , 'compare_lists, undef < [0]');
-      	ok(+1 == compare_lists([])             , 'compare_lists, [] > nothing');
-        ok(+1 == compare_lists([], undef)      , 'compare_lists, [] > undef');
-	ok( 0 == compare_lists([] , [])        , 'compare_lists, [] = []');
-
-	ok($MINUS_ONE == compare_lists([] , [1])        , 'compare_lists, [] < [1]');
-	ok(+1 == compare_lists([1] , [])        , 'compare_lists, [1] > []');
-
-
-	ok( 0 == compare_lists([1],  1 )          , 'compare_lists, [1] =  1 ') ;
-	ok( 0 == compare_lists( 1 , [1])          , 'compare_lists,  1  = [1]') ;
-	ok( 0 == compare_lists( 1 ,  1 )          , 'compare_lists,  1  =  1 ') ;
-	ok($MINUS_ONE == compare_lists( 0 ,  1 )          , 'compare_lists,  0  <  1 ') ;
-	ok($MINUS_ONE == compare_lists($MINUS_ONE ,  0 )          , 'compare_lists, -1  <  0 ') ;
-	ok($MINUS_ONE == compare_lists( 1 ,  2 )          , 'compare_lists,  1  <  2 ') ;
-	ok(+1 == compare_lists( 2 ,  1 )          , 'compare_lists,  2  >  1 ') ;
-
-
-	ok( 0 == compare_lists([1,2], [1,2])   , 'compare_lists,  [1,2] = [1,2]' ) ;
-	ok($MINUS_ONE == compare_lists([1], [1,2])     , 'compare_lists,    [1] < [1,2]' ) ;
-	ok(+1 == compare_lists([2], [1,2])     , 'compare_lists,    [2] > [1,2]' ) ;
-	ok($MINUS_ONE == compare_lists([1], [1,1])     , 'compare_lists,    [1] < [1,1]' ) ;
-	ok(+1 == compare_lists([1, 1], [1])    , 'compare_lists, [1, 1] >   [1]' ) ;
-	ok( 0 == compare_lists([1 .. $NUMBER_20_000] , [1 .. $NUMBER_20_000])
-                                               , 'compare_lists, [1..20_000] = [1..20_000]' ) ;
-	ok($MINUS_ONE == compare_lists([1], [2])       , 'compare_lists, [1] < [2]') ;
-	ok( 0 == compare_lists([2], [2])       , 'compare_lists, [0] = [2]') ;
-	ok(+1 == compare_lists([2], [1])       , 'compare_lists, [2] > [1]') ;
-
-	ok($MINUS_ONE == compare_lists(['a'],  ['b'])   , 'compare_lists, ["a"] < ["b"]') ;
-	ok( 0 == compare_lists(['a'],  ['a'])   , 'compare_lists, ["a"] = ["a"]') ;
-	ok( 0 == compare_lists(['ab'], ['ab']) , 'compare_lists, ["ab"] = ["ab"]') ;
-	ok(+1 == compare_lists(['b'],  ['a'])   , 'compare_lists, ["b"] > ["a"]') ;
-	ok($MINUS_ONE == compare_lists(['a'],  ['aa'])  , 'compare_lists, ["a"] < ["aa"]') ;
-	ok($MINUS_ONE == compare_lists(['a'],  ['a', 'a']), 'compare_lists, ["a"] < ["a", "a"]') ;
-	ok( 0 == compare_lists([split q{ }, 'a b' ], ['a', 'b']), 'compare_lists, split') ;
-	ok( 0 == compare_lists([sort split q{ }, 'b a' ], ['a', 'b']), 'compare_lists, sort split') ;
+	note( 'Leaving  tests_folder_routines()' ) ;
         return ;
 }
 
 
-sub guess_prefix {
-	my @foldernames = @_ ;
+sub sort_requested_folders {
+        my @requested_folders_sorted = () ;
 
-	return( undef ) unless ( @foldernames ) ;
+        foreach my $folder ( @folderfirst ) {
+                remove_from_requested_folders( $folder ) ;
+        }
 
-	my $prefix_guessed = q{} ;
-	foreach my $folder ( @foldernames ) {
-		next if ( $folder =~ m{^INBOX$}i ) ; # no guessing from INBOX
-		if ( $folder !~ m{^INBOX}i ) {
-			$prefix_guessed = q{} ; # prefix empty guessed
-			last ;
-		}
-		if ( $folder =~ m{^(INBOX(?:\.|\/))}i ) {
-			$prefix_guessed = $1 ;  # prefix Inbox/ or INBOX. guessed
-		}
-	}
-	return( $prefix_guessed ) ;
+        foreach my $folder ( @folderlast ) {
+                remove_from_requested_folders( $folder ) ;
+        }
+
+        my @middle = sort keys %requested_folder ;
+
+        @requested_folders_sorted = ( @folderfirst, @middle, @folderlast ) ;
+
+        return( @requested_folders_sorted ) ;
+}
+
+sub is_requested_folder {
+        my ( $folder ) = @_;
+
+        return( defined  $requested_folder{ $folder }  ) ;
+}
+
+
+sub add_to_requested_folders {
+        my @wanted_folders = @_ ;
+
+        foreach my $folder ( @wanted_folders ) {
+                ++$requested_folder{ $folder } ;
+        }
+        return( keys  %requested_folder  ) ;
+}
+
+sub remove_from_requested_folders {
+        my @wanted_folders = @_ ;
+
+        foreach my $folder ( @wanted_folders ) {
+                delete $requested_folder{ $folder } ;
+        }
+        return( keys %requested_folder ) ;
+}
+
+sub compare_lists {
+        my ($list_1_ref, $list_2_ref) = @_;
+
+        return($MINUS_ONE) if ((not defined $list_1_ref) and defined $list_2_ref);
+        return(0)  if ((not defined $list_1_ref) and not defined $list_2_ref); # end if no list
+        return(1)  if (not defined $list_2_ref); # end if only one list
+
+        if (not ref $list_1_ref ) {$list_1_ref = [$list_1_ref]};
+        if (not ref $list_2_ref ) {$list_2_ref = [$list_2_ref]};
+
+
+        my $last_used_indice = $MINUS_ONE;
+
+
+        ELEMENT:
+        foreach my $indice ( 0 .. $#{ $list_1_ref } ) {
+                $last_used_indice = $indice ;
+
+                # End of list_2
+                return 1 if ($indice > $#{ $list_2_ref } ) ;
+
+                my $element_list_1 = $list_1_ref->[$indice] ;
+                my $element_list_2 = $list_2_ref->[$indice] ;
+                my $balance = $element_list_1 cmp $element_list_2 ;
+                next ELEMENT if ($balance == 0) ;
+                return $balance ;
+        }
+        # each element equal until last indice of list_1
+        return $MINUS_ONE if ($last_used_indice < $#{ $list_2_ref } ) ;
+
+        # same size, each element equal
+        return 0 ;
+}
+
+sub tests_compare_lists {
+	note( 'Entering tests_compare_lists()' ) ;
+
+        my $empty_list_ref = [];
+
+        ok( 0 == compare_lists()               , 'compare_lists, no args');
+        ok( 0 == compare_lists(undef)          , 'compare_lists, undef = nothing');
+        ok( 0 == compare_lists(undef, undef)   , 'compare_lists, undef = undef');
+        ok($MINUS_ONE == compare_lists(undef , [])     , 'compare_lists, undef < []');
+        ok($MINUS_ONE == compare_lists(undef , [1])    , 'compare_lists, undef < [1]');
+        ok($MINUS_ONE == compare_lists(undef , [0])    , 'compare_lists, undef < [0]');
+        ok(+1 == compare_lists([])             , 'compare_lists, [] > nothing');
+        ok(+1 == compare_lists([], undef)      , 'compare_lists, [] > undef');
+        ok( 0 == compare_lists([] , [])        , 'compare_lists, [] = []');
+
+        ok($MINUS_ONE == compare_lists([] , [1])        , 'compare_lists, [] < [1]');
+        ok(+1 == compare_lists([1] , [])        , 'compare_lists, [1] > []');
+
+
+        ok( 0 == compare_lists([1],  1 )          , 'compare_lists, [1] =  1 ') ;
+        ok( 0 == compare_lists( 1 , [1])          , 'compare_lists,  1  = [1]') ;
+        ok( 0 == compare_lists( 1 ,  1 )          , 'compare_lists,  1  =  1 ') ;
+        ok($MINUS_ONE == compare_lists( 0 ,  1 )          , 'compare_lists,  0  <  1 ') ;
+        ok($MINUS_ONE == compare_lists($MINUS_ONE ,  0 )          , 'compare_lists, -1  <  0 ') ;
+        ok($MINUS_ONE == compare_lists( 1 ,  2 )          , 'compare_lists,  1  <  2 ') ;
+        ok(+1 == compare_lists( 2 ,  1 )          , 'compare_lists,  2  >  1 ') ;
+
+
+        ok( 0 == compare_lists([1,2], [1,2])   , 'compare_lists,  [1,2] = [1,2]' ) ;
+        ok($MINUS_ONE == compare_lists([1], [1,2])     , 'compare_lists,    [1] < [1,2]' ) ;
+        ok(+1 == compare_lists([2], [1,2])     , 'compare_lists,    [2] > [1,2]' ) ;
+        ok($MINUS_ONE == compare_lists([1], [1,1])     , 'compare_lists,    [1] < [1,1]' ) ;
+        ok(+1 == compare_lists([1, 1], [1])    , 'compare_lists, [1, 1] >   [1]' ) ;
+        ok( 0 == compare_lists([1 .. $NUMBER_20_000] , [1 .. $NUMBER_20_000])
+                                               , 'compare_lists, [1..20_000] = [1..20_000]' ) ;
+        ok($MINUS_ONE == compare_lists([1], [2])       , 'compare_lists, [1] < [2]') ;
+        ok( 0 == compare_lists([2], [2])       , 'compare_lists, [0] = [2]') ;
+        ok(+1 == compare_lists([2], [1])       , 'compare_lists, [2] > [1]') ;
+
+        ok($MINUS_ONE == compare_lists(['a'],  ['b'])   , 'compare_lists, ["a"] < ["b"]') ;
+        ok( 0 == compare_lists(['a'],  ['a'])   , 'compare_lists, ["a"] = ["a"]') ;
+        ok( 0 == compare_lists(['ab'], ['ab']) , 'compare_lists, ["ab"] = ["ab"]') ;
+        ok(+1 == compare_lists(['b'],  ['a'])   , 'compare_lists, ["b"] > ["a"]') ;
+        ok($MINUS_ONE == compare_lists(['a'],  ['aa'])  , 'compare_lists, ["a"] < ["aa"]') ;
+        ok($MINUS_ONE == compare_lists(['a'],  ['a', 'a']), 'compare_lists, ["a"] < ["a", "a"]') ;
+        ok( 0 == compare_lists([split q{ }, 'a b' ], ['a', 'b']), 'compare_lists, split') ;
+        ok( 0 == compare_lists([sort split q{ }, 'b a' ], ['a', 'b']), 'compare_lists, sort split') ;
+
+	note( 'Leaving  tests_compare_lists()' ) ;
+        return ;
+}
+
+
+sub guess_prefix  {
+        my @foldernames = @_ ;
+
+        my $prefix_guessed = q{} ;
+        foreach my $folder ( @foldernames ) {
+                next if ( $folder =~ m{^INBOX$}xi ) ; # no guessing from INBOX
+                if ( $folder !~ m{^INBOX}xi ) {
+                        $prefix_guessed = q{} ; # prefix empty guessed
+                        last ;
+                }
+                if ( $folder =~ m{^(INBOX(?:\.|\/))}xi ) {
+                        $prefix_guessed = $1 ;  # prefix Inbox/ or INBOX. guessed
+                }
+        }
+        return( $prefix_guessed ) ;
 }
 
 sub tests_guess_prefix {
+	note( 'Entering tests_guess_prefix()' ) ;
 
-	ok( not( defined guess_prefix(  ) ), 'guess_prefix: no args' ) ;
-	ok( q{} eq guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
-	ok( q{} eq guess_prefix( 'Inbox' ), 'guess_prefix: Inbox alone' ) ;
-	ok( q{} eq guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
-	ok( 'INBOX/' eq guess_prefix( 'INBOX', 'INBOX/Junk' ), 'guess_prefix: INBOX INBOX/Junk' ) ;
-	ok( 'INBOX.' eq guess_prefix( 'INBOX', 'INBOX.Junk' ), 'guess_prefix: INBOX INBOX.Junk' ) ;
-	ok( 'Inbox/' eq guess_prefix( 'Inbox', 'Inbox/Junk' ), 'guess_prefix: Inbox Inbox/Junk' ) ;
-	ok( 'Inbox.' eq guess_prefix( 'Inbox', 'Inbox.Junk' ), 'guess_prefix: Inbox Inbox.Junk' ) ;
-	ok( 'INBOX/' eq guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr' ) ;
-	ok( q{} eq guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr', 'zzz' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr zzz' ) ;
-	ok( q{} eq guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
-	ok( q{} eq guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
+        is( guess_prefix(  ), q{}, 'guess_prefix: no args => empty string' ) ;
+        is( q{} , guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
+        is( q{} , guess_prefix( 'Inbox' ), 'guess_prefix: Inbox alone' ) ;
+        is( q{} , guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
+        is( 'INBOX/' , guess_prefix( 'INBOX', 'INBOX/Junk' ), 'guess_prefix: INBOX INBOX/Junk' ) ;
+        is( 'INBOX.' , guess_prefix( 'INBOX', 'INBOX.Junk' ), 'guess_prefix: INBOX INBOX.Junk' ) ;
+        is( 'Inbox/' , guess_prefix( 'Inbox', 'Inbox/Junk' ), 'guess_prefix: Inbox Inbox/Junk' ) ;
+        is( 'Inbox.' , guess_prefix( 'Inbox', 'Inbox.Junk' ), 'guess_prefix: Inbox Inbox.Junk' ) ;
+        is( 'INBOX/' , guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr' ) ;
+        is( q{} , guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr', 'zzz' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr zzz' ) ;
+        is( q{} , guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
+        is( q{} , guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
 
-	return ;
+	note( 'Leaving  tests_guess_prefix()' ) ;
+        return ;
 }
 
 sub get_prefix {
-	my( $imap, $prefix_in, $prefix_opt, $Side, $folders_ref ) = @_ ;
-	my( $prefix_out, $prefix_guessed ) ;
+        my( $imap, $prefix_in, $prefix_opt, $Side, $folders_ref ) = @_ ;
+        my( $prefix_out, $prefix_guessed ) ;
 
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting prefix\n"  ) ;
-	$prefix_guessed = guess_prefix( @{ $folders_ref } ) ;
-	myprint( "$Side: guessing prefix from folder listing: [$prefix_guessed]\n"  ) ;
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: Calling namespace capability\n"  ) ;
-	if ( $imap->has_capability( 'namespace' ) ) {
-		my $r_namespace = $imap->namespace(  ) ;
-		$prefix_out = $r_namespace->[0][0][0] ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting prefix\n"  ) ;
+        $prefix_guessed = guess_prefix( @{ $folders_ref } ) ;
+        myprint( "$Side: guessing prefix from folder listing: [$prefix_guessed]\n"  ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: Calling namespace capability\n"  ) ;
+        if ( $imap->has_capability( 'namespace' ) ) {
+                my $r_namespace = $imap->namespace(  ) ;
+                $prefix_out = $r_namespace->[0][0][0] ;
                 myprint( "$Side: prefix given by NAMESPACE: [$prefix_out]\n"  ) ;
-		if ( defined  $prefix_in  ) {
-                	myprint( "$Side: but using [$prefix_in] given by $prefix_opt\n"  ) ;
-                	$prefix_out = $prefix_in ;
-                	return( $prefix_out ) ;
+                if ( defined  $prefix_in  ) {
+                        myprint( "$Side: but using [$prefix_in] given by $prefix_opt\n"  ) ;
+                        $prefix_out = $prefix_in ;
+                        return( $prefix_out ) ;
                 }else{
-                	# all good
-	                return( $prefix_out ) ;
+                        # all good
+                        return( $prefix_out ) ;
                 }
-	}
-	else{
-        	if ( defined  $prefix_in  ) {
-                	myprint( "$Side: using [$prefix_in] given by $prefix_opt\n"  ) ;
-                	$prefix_out = $prefix_in ;
-                	return( $prefix_out ) ;
+        }
+        else{
+                if ( defined  $prefix_in  ) {
+                        myprint( "$Side: using [$prefix_in] given by $prefix_opt\n"  ) ;
+                        $prefix_out = $prefix_in ;
+                        return( $prefix_out ) ;
                 }else{
-			myprint(
-			  "$Side: No NAMESPACE capability so using guessed prefix [$prefix_guessed]\n",
-			  help_to_guess_prefix( $imap, $prefix_opt ) ) ;
-			return( $prefix_guessed ) ;
+                        myprint(
+                          "$Side: No NAMESPACE capability so using guessed prefix [$prefix_guessed]\n",
+                          help_to_guess_prefix( $imap, $prefix_opt ) ) ;
+                        return( $prefix_guessed ) ;
                 }
-	}
+        }
         return ;
 }
 
 
 sub guess_separator {
-	my @foldernames = @_ ;
+        my @foldernames = @_ ;
 
-	#return( undef ) unless ( @foldernames ) ;
+        #return( undef ) unless ( @foldernames ) ;
 
-	my $sep_guessed ;
-	my %counter ;
-	foreach my $folder ( @foldernames ) {
-		$counter{'/'}++  while ( $folder =~ m{/}g ) ;  # count /
-		$counter{'.'}++  while ( $folder =~ m{\.}g ) ; # count .
-		$counter{'\\\\'}++ while ( $folder =~ m{(\\){2}}g ) ; # count \\
-	}
-	my @race_sorted = sort { $counter{ $b } <=> $counter{ $a } } keys  %counter  ;
-	#myprint( "@race_sorted\n"  ) ;
-	$sep_guessed = shift @race_sorted || $LAST_RESSORT_SEPARATOR ; # / when nothing found.
-	return( $sep_guessed ) ;
+        my $sep_guessed ;
+        my %counter ;
+        foreach my $folder ( @foldernames ) {
+                $counter{'/'}++  while ( $folder =~ m{/}xg ) ;  # count /
+                $counter{'.'}++  while ( $folder =~ m{\.}xg ) ; # count .
+                $counter{'\\\\'}++ while ( $folder =~ m{(\\){2}}xg ) ; # count \\
+                $counter{'\\'}++ while ( $folder =~ m{[^\\](\\){1}(?=[^\\])}xg ) ; # count \
+        }
+        my @race_sorted = sort { $counter{ $b } <=> $counter{ $a } } keys  %counter  ;
+        $debug and myprint( "@foldernames\n@race_sorted\n", %counter, "\n"  ) ;
+        $sep_guessed = shift @race_sorted || $LAST_RESSORT_SEPARATOR ; # / when nothing found.
+        return( $sep_guessed ) ;
 }
 
 sub tests_guess_separator {
-	ok( '/' eq  guess_separator(  ), 'guess_separator: no args' ) ;
-	ok( '/' eq guess_separator( 'abcd' ), 'guess_separator: abcd' ) ;
-	ok( '/' eq guess_separator( 'a/b/c.d' ), 'guess_separator: a/b/c.d' ) ;
-	ok( '.' eq guess_separator( 'a.b/c.d' ), 'guess_separator: a.b/c.d' ) ;
-	ok( '\\\\' eq guess_separator( 'a\\\\b\\\\c.c\\\\d/e/f' ), 'guess_separator: a\\\\b\\\\c.c\\\\d/e/f' ) ;
-	return ;
+	note( 'Entering tests_guess_separator()' ) ;
+
+        ok( '/' eq  guess_separator(  ), 'guess_separator: no args' ) ;
+        ok( '/' eq guess_separator( 'abcd' ), 'guess_separator: abcd' ) ;
+        ok( '/' eq guess_separator( 'a/b/c.d' ), 'guess_separator: a/b/c.d' ) ;
+        ok( '.' eq guess_separator( 'a.b/c.d' ), 'guess_separator: a.b/c.d' ) ;
+        ok( '\\\\' eq guess_separator( 'a\\\\b\\\\c.c\\\\d/e/f' ), 'guess_separator: a\\\\b\\\\c.c\\\\d/e/f' ) ;
+        ok( '\\' eq guess_separator( 'a\\b\\c.c\\d/e/f' ), 'guess_separator: a\\b\\c.c\\d/e/f' ) ;
+        ok( '\\' eq guess_separator( 'a\\b' ), 'guess_separator: a\\b' ) ;
+        ok( '\\' eq guess_separator( 'a\\b\\c' ), 'guess_separator: a\\b\\c' ) ;
+
+	note( 'Leaving  tests_guess_separator()' ) ;
+        return ;
 }
 
 sub get_separator {
-	my( $imap, $sep_in, $sep_opt, $Side, $folders_ref ) = @_ ;
-	my( $sep_out, $sep_guessed ) ;
+        my( $imap, $sep_in, $sep_opt, $Side, $folders_ref ) = @_ ;
+        my( $sep_out, $sep_guessed ) ;
 
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting separator\n"  ) ;
-	$sep_guessed = guess_separator( @{ $folders_ref } ) ;
-	myprint( "$Side: guessing separator from folder listing: [$sep_guessed]\n"  ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: Getting separator\n"  ) ;
+        $sep_guessed = guess_separator( @{ $folders_ref } ) ;
+        myprint( "$Side: guessing separator from folder listing: [$sep_guessed]\n"  ) ;
 
-	( $debug or $sync->{debugfolders} ) and myprint( "$Side: calling namespace capability\n"  ) ;
-	if ( $imap->has_capability( 'namespace' ) ) {
-		$sep_out = $imap->separator(  ) ;
-		if ( defined  $sep_out  ) {
-                	myprint( "$Side: separator given by NAMESPACE: [$sep_out]\n"  ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "$Side: calling namespace capability\n"  ) ;
+        if ( $imap->has_capability( 'namespace' ) ) {
+                $sep_out = $imap->separator(  ) ;
+                if ( defined  $sep_out  ) {
+                        myprint( "$Side: separator given by NAMESPACE: [$sep_out]\n"  ) ;
                         if ( defined  $sep_in  ) {
-                		myprint( "$Side: but using [$sep_in] given by $sep_opt\n"  ) ;
-                        	$sep_out = $sep_in ;
-                        	return( $sep_out ) ;
+                                myprint( "$Side: but using [$sep_in] given by $sep_opt\n"  ) ;
+                                $sep_out = $sep_in ;
+                                return( $sep_out ) ;
                         }else{
-                        	return( $sep_out ) ;
+                                return( $sep_out ) ;
                         }
-		}else{
-                	if ( defined  $sep_in  ) {
-                        	myprint( "$Side: NAMESPACE request failed but using [$sep_in] given by $sep_opt\n"  ) ;
-                        	$sep_out = $sep_in ;
-                        	return( $sep_out ) ;
-                        }else{
-				myprint(
-		  		"$Side: NAMESPACE request failed so using guessed separator [$sep_guessed]\n",
-                  		help_to_guess_sep( $imap, $sep_opt ) ) ;
-				return( $sep_guessed ) ;
-                        }
-                }
-	}
-	else{
-        	if ( defined  $sep_in  ) {
-                	myprint( "$Side: No NAMESPACE capability but using [$sep_in] given by $sep_opt\n"  ) ;
-                	$sep_out = $sep_in ;
-                	return( $sep_out ) ;
                 }else{
-			myprint(
-		  	"$Side: No NAMESPACE capability, so using guessed separator [$sep_guessed]\n",
-		      	help_to_guess_sep( $imap, $sep_opt ) ) ;
-			return( $sep_guessed ) ;
+                        if ( defined  $sep_in  ) {
+                                myprint( "$Side: NAMESPACE request failed but using [$sep_in] given by $sep_opt\n"  ) ;
+                                $sep_out = $sep_in ;
+                                return( $sep_out ) ;
+                        }else{
+                                myprint(
+                                "$Side: NAMESPACE request failed so using guessed separator [$sep_guessed]\n",
+                                help_to_guess_sep( $imap, $sep_opt ) ) ;
+                                return( $sep_guessed ) ;
+                        }
                 }
-	}
+        }
+        else{
+                if ( defined  $sep_in  ) {
+                        myprint( "$Side: No NAMESPACE capability but using [$sep_in] given by $sep_opt\n"  ) ;
+                        $sep_out = $sep_in ;
+                        return( $sep_out ) ;
+                }else{
+                        myprint(
+                        "$Side: No NAMESPACE capability, so using guessed separator [$sep_guessed]\n",
+                        help_to_guess_sep( $imap, $sep_opt ) ) ;
+                        return( $sep_guessed ) ;
+                }
+        }
         return ;
 }
 
 sub help_to_guess_sep {
-	my( $imap, $sep_opt ) = @_ ;
+        my( $imap, $sep_opt ) = @_ ;
 
-	my $help_to_guess_sep = "You can set the separator character with the $sep_opt option,\n"
-	. "the complete listing of folders may help you to find it\n"
-	. folders_list_to_help( $imap ) ;
+        my $help_to_guess_sep = "You can set the separator character with the $sep_opt option,\n"
+        . "the complete listing of folders may help you to find it\n"
+        . folders_list_to_help( $imap ) ;
 
-	return( $help_to_guess_sep ) ;
+        return( $help_to_guess_sep ) ;
 }
 
 sub help_to_guess_prefix {
-	my( $imap, $prefix_opt ) = @_ ;
+        my( $imap, $prefix_opt ) = @_ ;
 
-	my $help_to_guess_prefix = "You can set the prefix namespace with the $prefix_opt option,\n"
-	. "the folowing listing of folders may help you to find it:\n"
-	. folders_list_to_help( $imap ) ;
+        my $help_to_guess_prefix = "You can set the prefix namespace with the $prefix_opt option,\n"
+        . "the folowing listing of folders may help you to find it:\n"
+        . folders_list_to_help( $imap ) ;
 
-	return( $help_to_guess_prefix ) ;
+        return( $help_to_guess_prefix ) ;
 }
 
 
 sub folders_list_to_help {
-	my($imap) = @_ ;
+        my($imap) = @_ ;
 
-	my @folders = $imap->folders ;
-	my $listing = join q{}, map { "[$_]\n" } @folders ;
-	return( $listing ) ;
+        my @folders = $imap->folders ;
+        my $listing = join q{}, map { "[$_]\n" } @folders ;
+        return( $listing ) ;
 }
 
 
 sub tests_separator_invert {
-	$fixslash2 = 0 ;
-	ok( not( defined separator_invert(  )  ), 'separator_invert: no args' ) ;
-	ok( not( defined separator_invert( q{} ) ), 'separator_invert: not enough args' ) ;
-	ok( not( defined separator_invert( q{}, q{} ) ), 'separator_invert: not enough args' ) ;
+	note( 'Entering tests_separator_invert()' ) ;
 
-	ok( q{} eq separator_invert( q{}, q{}, q{} ), 'separator_invert: 3 empty strings' ) ;
-	ok( 'lalala' eq separator_invert( 'lalala', q{}, q{} ), 'separator_invert: empty separator' ) ;
-	ok( 'lalala' eq separator_invert( 'lalala', '/', '/' ), 'separator_invert: same separator /' ) ;
-	ok( 'lal/ala' eq separator_invert( 'lal/ala', '/', '/' ), 'separator_invert: same separator / 2' ) ;
-	ok( 'lal.ala' eq separator_invert( 'lal/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
-	ok( 'lal/ala' eq separator_invert( 'lal.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
-	ok( 'la.l/ala' eq separator_invert( 'la/l.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
+        $fixslash2 = 0 ;
+        ok( not( defined separator_invert(  )  ), 'separator_invert: no args' ) ;
+        ok( not( defined separator_invert( q{} ) ), 'separator_invert: not enough args' ) ;
+        ok( not( defined separator_invert( q{}, q{} ) ), 'separator_invert: not enough args' ) ;
 
-	ok( 'l/al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
+        ok( q{} eq separator_invert( q{}, q{}, q{} ), 'separator_invert: 3 empty strings' ) ;
+        ok( 'lalala' eq separator_invert( 'lalala', q{}, q{} ), 'separator_invert: empty separator' ) ;
+        ok( 'lalala' eq separator_invert( 'lalala', '/', '/' ), 'separator_invert: same separator /' ) ;
+        ok( 'lal/ala' eq separator_invert( 'lal/ala', '/', '/' ), 'separator_invert: same separator / 2' ) ;
+        ok( 'lal.ala' eq separator_invert( 'lal/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
+        ok( 'lal/ala' eq separator_invert( 'lal.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
+        ok( 'la.l/ala' eq separator_invert( 'la/l.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
+
+        ok( 'l/al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
         $fixslash2 = 1 ;
-	ok( 'l_al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
+        ok( 'l_al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
 
-	return ;
+	note( 'Leaving  tests_separator_invert()' ) ;
+        return ;
 }
 
 sub separator_invert {
-	my( $h1_fold, $h1_separator, $h2_separator ) = @_ ;
+        my( $h1_fold, $h1_separator, $h2_separator ) = @_ ;
 
-	return( undef ) if ( not defined  $h1_fold  or not defined  $h1_separator  or not defined  $h2_separator  ) ;
-	# The separator we hope we'll never encounter: 00000000 == 0x00
-	my $o_sep = "\000" ;
+        return( undef ) if ( not defined  $h1_fold  or not defined  $h1_separator  or not defined  $h2_separator  ) ;
+        # The separator we hope we'll never encounter: 00000000 == 0x00
+        my $o_sep = "\000" ;
 
-	my $h2_fold = $h1_fold ;
-	$h2_fold =~ s,\Q$h2_separator,$o_sep,xg ;
-	$h2_fold =~ s,\Q$h1_separator,$h2_separator,xg ;
-	$h2_fold =~ s,\Q$o_sep,$h1_separator,xg ;
+        my $h2_fold = $h1_fold ;
+        $h2_fold =~ s,\Q$h2_separator,$o_sep,xg ;
+        $h2_fold =~ s,\Q$h1_separator,$h2_separator,xg ;
+        $h2_fold =~ s,\Q$o_sep,$h1_separator,xg ;
         $h2_fold =~ s,/,_,xg if( $fixslash2 and '/' ne $h2_separator and '/' eq $h1_separator ) ;
-	return( $h2_fold ) ;
+        return( $h2_fold ) ;
 }
 
 
 sub tests_imap2_folder_name {
+	note( 'Entering tests_imap2_folder_name()' ) ;
 
 $h1_prefix = $h2_prefix = q{};
 $h1_sep = '/';
@@ -4344,459 +5365,480 @@ ok( 'TEST/TEST/TEST/TEST' eq imap2_folder_name( 'INBOX.TEST.test.Test.tesT' ), '
 ok( 'test/test/test/test' eq imap2_folder_name( 'INBOX.TEST.test.Test.tesT' ), 'imap2_folder_name: INBOX.TEST.test.Test.tesT' ) ;
 
 
-return ;
+	note( 'Leaving  tests_imap2_folder_name()' ) ;
+	return ;
 
 }
 
 sub imap2_folder_name {
-	my ( $h1_fold ) = @_ ;
-	my ( $h2_fold ) ;
-	if ( $sync->{f1f2}{ $h1_fold } ) {
-		$h2_fold = $sync->{f1f2}{ $h1_fold } ;
-		( $debug or $sync->{debugfolders} ) and myprint( "f1f2 [$h1_fold] -> [$h2_fold]\n"  ) ;
-		return( $h2_fold ) ;
-	}
-	if ( $sync->{f1f2auto}{ $h1_fold } ) {
-		$h2_fold = $sync->{f1f2auto}{ $h1_fold } ;
-		( $debug or $sync->{debugfolders} ) and myprint( "automap [$h1_fold] -> [$h2_fold]\n"  ) ;
-		return( $h2_fold ) ;
-	}
+        my ( $h1_fold ) = @_ ;
+        my ( $h2_fold ) ;
+        if ( $sync->{f1f2}{ $h1_fold } ) {
+                $h2_fold = $sync->{f1f2}{ $h1_fold } ;
+                ( $debug or $sync->{debugfolders} ) and myprint( "f1f2 [$h1_fold] -> [$h2_fold]\n"  ) ;
+                return( $h2_fold ) ;
+        }
+        if ( $sync->{f1f2auto}{ $h1_fold } ) {
+                $h2_fold = $sync->{f1f2auto}{ $h1_fold } ;
+                ( $debug or $sync->{debugfolders} ) and myprint( "automap [$h1_fold] -> [$h2_fold]\n"  ) ;
+                return( $h2_fold ) ;
+        }
 
-	$h2_fold = prefix_seperator_invertion( $h1_fold ) ;
-	$h2_fold = regextrans2( $h2_fold ) ;
-	return( $h2_fold ) ;
+        $h2_fold = prefix_seperator_invertion( $h1_fold ) ;
+        $h2_fold = regextrans2( $h2_fold ) ;
+        return( $h2_fold ) ;
 }
 
 sub prefix_seperator_invertion {
-	my ( $h1_fold ) = @_ ;
-	my ( $h2_fold ) ;
+        my ( $h1_fold ) = @_ ;
+        my ( $h2_fold ) ;
 
-	# first we remove the prefix
-	$h1_fold =~ s/^\Q$h1_prefix\E//x ;
-	( $debug or $sync->{debugfolders} ) and myprint( "removed host1 prefix: [$h1_fold]\n"  ) ;
-	$h2_fold = separator_invert( $h1_fold, $h1_sep, $h2_sep ) ;
-	( $debug or $sync->{debugfolders} ) and myprint( "inverted  separators: [$h2_fold]\n"  ) ;
-	# Adding the prefix supplied by namespace or the --prefix2 option
-	$h2_fold = $h2_prefix . $h2_fold
-	  unless( ( $h2_prefix eq 'INBOX' . $h2_sep ) and ( $h2_fold =~ m/^INBOX$/xi ) ) ;
-	( $debug or $sync->{debugfolders} ) and myprint( "added   host2 prefix: [$h2_fold]\n"  ) ;
-	return( $h2_fold ) ;
+        # first we remove the prefix
+        $h1_fold =~ s/^\Q$h1_prefix\E//x ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "removed host1 prefix: [$h1_fold]\n"  ) ;
+        $h2_fold = separator_invert( $h1_fold, $h1_sep, $h2_sep ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "inverted  separators: [$h2_fold]\n"  ) ;
+        # Adding the prefix supplied by namespace or the --prefix2 option
+        $h2_fold = $h2_prefix . $h2_fold
+          unless( ( $h2_prefix eq 'INBOX' . $h2_sep ) and ( $h2_fold =~ m/^INBOX$/xi ) ) ;
+        ( $debug or $sync->{debugfolders} ) and myprint( "added   host2 prefix: [$h2_fold]\n"  ) ;
+        return( $h2_fold ) ;
 }
 
 sub regextrans2 {
-	my( $h2_fold ) = @_ ;
-	# Transforming the folder name by the --regextrans2 option(s)
-	foreach my $regextrans2 ( @regextrans2 ) {
-	        my $h2_fold_before = $h2_fold ;
-		my $ret = eval "\$h2_fold =~ $regextrans2 ; 1 " ;
-		( $debug or $sync->{debugfolders} ) and myprint( "[$h2_fold_before] -> [$h2_fold] using regextrans2 [$regextrans2]\n"  ) ;
-                if ( not ( defined  $ret  ) or $@ ) {
-			die_clean( "error: eval regextrans2 '$regextrans2': $@\n" ) ;
+        my( $h2_fold ) = @_ ;
+        # Transforming the folder name by the --regextrans2 option(s)
+        foreach my $regextrans2 ( @regextrans2 ) {
+                my $h2_fold_before = $h2_fold ;
+                my $ret = eval "\$h2_fold =~ $regextrans2 ; 1 " ;
+                ( $debug or $sync->{debugfolders} ) and myprint( "[$h2_fold_before] -> [$h2_fold] using regextrans2 [$regextrans2]\n"  ) ;
+                if ( not ( defined  $ret  ) or $EVAL_ERROR ) {
+                        die_clean( "error: eval regextrans2 '$regextrans2': $EVAL_ERROR\n" ) ;
                 }
-	}
-	return( $h2_fold ) ;
+        }
+        return( $h2_fold ) ;
 }
 
 
 sub tests_decompose_regex {
-	ok( 1, 'decompose_regex 1' ) ;
-	ok( 0 == compare_lists( [ q{}, q{} ], [ decompose_regex( q{} ) ] ), 'decompose_regex empty string' ) ;
-	ok( 0 == compare_lists( [ '.*', 'lala' ], [ decompose_regex( 's/.*/lala/' ) ] ), 'decompose_regex s/.*/lala/' ) ;
-	return ;
+	note( 'Entering tests_decompose_regex()' ) ;
+
+        ok( 1, 'decompose_regex 1' ) ;
+        ok( 0 == compare_lists( [ q{}, q{} ], [ decompose_regex( q{} ) ] ), 'decompose_regex empty string' ) ;
+        ok( 0 == compare_lists( [ '.*', 'lala' ], [ decompose_regex( 's/.*/lala/' ) ] ), 'decompose_regex s/.*/lala/' ) ;
+
+	note( 'Leaving  tests_decompose_regex()' ) ;
+        return ;
 }
 
 sub decompose_regex {
-	my $regex = shift ;
-	my( $left_part, $right_part ) ;
+        my $regex = shift ;
+        my( $left_part, $right_part ) ;
 
-	( $left_part, $right_part ) = $regex =~ m{^s/((?:[^/]|\\/)+)/((?:[^/]|\\/)+)/}x;
+        ( $left_part, $right_part ) = $regex =~ m{^s/((?:[^/]|\\/)+)/((?:[^/]|\\/)+)/}x;
         return( q{}, q{} ) if not $left_part ;
-	return( $left_part, $right_part ) ;
+        return( $left_part, $right_part ) ;
 }
 
 
 sub foldersizes {
 
-	my ( $side, $imap, $search_cmd, @folders ) = @_ ;
-	my $total_size = 0 ;
-	my $total_nb = 0 ;
-	my $biggest_in_all = 0 ;
+        my ( $side, $imap, $search_cmd, $abletosearch, @folders ) = @_ ;
+        my $total_size = 0 ;
+        my $total_nb = 0 ;
+        my $biggest_in_all = 0 ;
 
-	my $nb_folders = scalar  @folders  ;
-	my $ct_folders = 0 ; # folder counter.
-	myprint( "++++ Calculating sizes of $nb_folders folders on $side\n"  ) ;
-	foreach my $folder ( @folders )     {
-		my $stot = 0 ;
-		my $nb_msgs = 0 ;
-		$ct_folders++ ;
-		myprintf( "$side folder %7s %-35s", "$ct_folders/$nb_folders", jux_utf8( $folder ) ) ;
+        my $nb_folders = scalar  @folders  ;
+        my $ct_folders = 0 ; # folder counter.
+        myprint( "++++ Calculating sizes of $nb_folders folders on $side\n"  ) ;
+        foreach my $folder ( @folders )     {
+                my $stot = 0 ;
+                my $nb_msgs = 0 ;
+                $ct_folders++ ;
+                myprintf( "$side folder %7s %-35s", "$ct_folders/$nb_folders", jux_utf8( $folder ) ) ;
                 if ( 'Host2' eq $side and not exists  $h2_folders_all_UPPER{ uc  $folder  }  ) {
-		        myprint( " does not exist yet\n") ;
-			next ;
-		}
+                        myprint( " does not exist yet\n") ;
+                        next ;
+                }
                 if ( 'Host1' eq $side and not exists  $h1_folders_all{ $folder }  ) {
-		        myprint( " does not exist\n" ) ;
-			next ;
-		}
+                        myprint( " does not exist\n" ) ;
+                        next ;
+                }
 
-		last if $imap->IsUnconnected(  ) ;
-		# FTGate is RFC buggy with EXAMINE it does not act as SELECT
-		#unless ( $imap->examine( $folder ) ) {
-		unless ( $imap->select( $folder ) ) {
-			my $error = join q{},
-				"$side Folder $folder: Could not select: ",
-				$imap->LastError,  "\n"  ;
-			errors_incr( $sync, $error ) ;
-			next ;
-		}
-		last if $imap->IsUnconnected(  ) ;
+                last if $imap->IsUnconnected(  ) ;
+                # FTGate is RFC buggy with EXAMINE it does not act as SELECT
+                #unless ( $imap->examine( $folder ) ) {
+                unless ( $imap->select( $folder ) ) {
+                        my $error = join q{},
+                                "$side Folder $folder: Could not select: ",
+                                $imap->LastError,  "\n"  ;
+                        errors_incr( $sync, $error ) ;
+                        next ;
+                }
+                last if $imap->IsUnconnected(  ) ;
 
-		my $hash_ref = { } ;
-		my @msgs = select_msgs( $imap, undef, $search_cmd, $folder ) ;
-		$nb_msgs = scalar  @msgs  ;
-		my $biggest_in_folder = 0 ;
-		@{ $hash_ref }{ @msgs } = ( undef ) if @msgs ;
+                my $hash_ref = { } ;
+                my @msgs = select_msgs( $imap, undef, $search_cmd, $abletosearch, $folder ) ;
+                $nb_msgs = scalar  @msgs  ;
+                my $biggest_in_folder = 0 ;
+                @{ $hash_ref }{ @msgs } = ( undef ) if @msgs ;
 
-		last if $imap->IsUnconnected(  ) ;
-		if ( $nb_msgs > 0 and @msgs ) {
-                	if ( $abletosearch ) {
-				if ( ! $imap->fetch_hash( \@msgs, 'RFC822.SIZE', $hash_ref) ) {
-                                        my $error = "$side failure with fetch_hash: $@" ;
+                last if $imap->IsUnconnected(  ) ;
+                if ( $nb_msgs > 0 and @msgs ) {
+                        if ( $abletosearch ) {
+                                if ( ! $imap->fetch_hash( \@msgs, 'RFC822.SIZE', $hash_ref) ) {
+                                        my $error = "$side failure with fetch_hash: $EVAL_ERROR" ;
                                         errors_incr( $sync, $error ) ;
                                         return ;
                                 }
                         }else{
-				my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
-				my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-				if ( ! $imap->fetch_hash( $fetch_hash_uids, 'RFC822.SIZE', $hash_ref ) ) {
-                                        my $error = "$side failure with fetch_hash: $@" ;
+                                my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
+                                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+                                if ( ! $imap->fetch_hash( $fetch_hash_uids, 'RFC822.SIZE', $hash_ref ) ) {
+                                        my $error = "$side failure with fetch_hash: $EVAL_ERROR" ;
                                         errors_incr( $sync, $error ) ;
                                         return ;
                                 }
                         }
-			for ( keys %{ $hash_ref } ) {
-                        	my $size =  $hash_ref->{ $_ }->{ 'RFC822.SIZE' } ;
-                        	$stot    += $size ;
+                        for ( keys %{ $hash_ref } ) {
+                                my $size =  $hash_ref->{ $_ }->{ 'RFC822.SIZE' } ;
+                                $stot    += $size ;
                                 $biggest_in_folder =  max( $biggest_in_folder, $size ) ;
                         }
-		}
+                }
 
-		myprintf( ' Size: %9s', $stot ) ;
-		myprintf( ' Messages: %5s', $nb_msgs ) ;
-		myprintf( " Biggest: %9s\n", $biggest_in_folder ) ;
-		$total_size += $stot ;
-		$total_nb += $nb_msgs ;
+                myprintf( ' Size: %9s', $stot ) ;
+                myprintf( ' Messages: %5s', $nb_msgs ) ;
+                myprintf( " Biggest: %9s\n", $biggest_in_folder ) ;
+                $total_size += $stot ;
+                $total_nb += $nb_msgs ;
                 $biggest_in_all =  max( $biggest_in_all, $biggest_in_folder ) ;
-	}
-	myprintf( "%s Nb folders:      %11s folders\n",    $side, $nb_folders ) ;
-	myprintf( "%s Nb messages:     %11s messages\n",   $side, $total_nb ) ;
-	myprintf( "%s Total size:      %11s bytes (%s)\n", $side, $total_size, bytes_display_string( $total_size ) ) ;
-	myprintf( "%s Biggest message: %11s bytes (%s)\n", $side, $biggest_in_all, bytes_display_string( $biggest_in_all ) ) ;
-	myprintf( "%s Time spent:      %11.1f seconds\n",  $side, timenext(  ) ) ;
+        }
+        myprintf( "%s Nb folders:      %11s folders\n",    $side, $nb_folders ) ;
+        myprintf( "%s Nb messages:     %11s messages\n",   $side, $total_nb ) ;
+        myprintf( "%s Total size:      %11s bytes (%s)\n", $side, $total_size, bytes_display_string( $total_size ) ) ;
+        myprintf( "%s Biggest message: %11s bytes (%s)\n", $side, $biggest_in_all, bytes_display_string( $biggest_in_all ) ) ;
+        myprintf( "%s Time spent:      %11.1f seconds\n",  $side, timenext(  ) ) ;
         return( $total_nb, $total_size ) ;
 }
 
 sub timenext {
-	my ( $timenow, $timediff ) ;
-	# $timebefore is global, beurk !
-	$timenow    = time ;
-	$timediff   = $timenow - $timebefore ;
-	$timebefore = $timenow ;
-	return( $timediff ) ;
+        my ( $timenow, $timediff ) ;
+        # $timebefore is global, beurk !
+        $timenow    = time ;
+        $timediff   = $timenow - $timebefore ;
+        $timebefore = $timenow ;
+        return( $timediff ) ;
 }
 
 sub timesince {
-	my $timeinit = shift ;
-	my ( $timenow, $timediff ) ;
-	$timenow    = time ;
-	$timediff   = $timenow - $timeinit ;
-	return( $timediff ) ;
+        my $timeinit = shift || 0 ;
+        my ( $timenow, $timediff ) ;
+        $timenow    = time ;
+        $timediff   = $timenow - $timeinit ;
+	# Often used in a division so no 0
+        return( max( 1, $timediff) ) ;
 }
 
 
 
 
 sub tests_flags_regex {
+	note( 'Entering tests_flags_regex()' ) ;
 
-	ok( q{} eq flags_regex(q{} ), 'flags_regex, null string q{}' ) ;
-	ok( q'\Seen NonJunk $Spam' eq flags_regex( q'\Seen NonJunk $Spam' ), 'flags_regex, nothing to do');
+        ok( q{} eq flags_regex(q{} ), 'flags_regex, null string q{}' ) ;
+        ok( q{\Seen NonJunk $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, nothing to do} ) ;
 
-	@regexflag = ('I am BAD' ) ;
+        @regexflag = ('I am BAD' ) ;
         ok( not ( defined flags_regex( q{} ) ), 'flags_regex, bad regex' ) ;
 
-	@regexflag = ( 's/NonJunk//g' ) ;
-	ok( q'\Seen  $Spam' eq flags_regex( q'\Seen NonJunk $Spam' ), q{flags_regex, remove NonJunk: 's/NonJunk//g'} ) ;
-	@regexflag = ( q's/\$Spam//g' ) ;
-	ok( '\Seen NonJunk ' eq flags_regex( q'\Seen NonJunk $Spam' ), q{flags_regex, remove $Spam: 's/\$Spam//g'} ) ;
+        @regexflag = ( 's/NonJunk//g' ) ;
+        ok( q{\Seen  $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove NonJunk: 's/NonJunk//g'} ) ;
+        @regexflag = ( q's/\$Spam//g' ) ;
+        ok( q{\Seen NonJunk } eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove $Spam: 's/\$Spam//g'} ) ;
 
-	@regexflag = ( 's/\\\\Seen//g' ) ;
+        @regexflag = ( 's/\\\\Seen//g' ) ;
 
-	ok( q' NonJunk $Spam' eq flags_regex( q'\Seen NonJunk $Spam' ), q{flags_regex, remove \Seen: 's/\\\\\\\\Seen//g'} ) ;
+        ok( q{ NonJunk $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove \Seen: 's/\\\\\\\\Seen//g'} ) ;
 
-	@regexflag = ( 's/(\s|^)[^\\\\]\w+//g' ) ;
-	ok( '\Seen \Middle \End'   eq flags_regex( q'\Seen NonJunk \Middle $Spam \End' ), q{flags_regex: only \word among \Seen NonJunk \Middle $Spam \End} ) ;
-	ok( ' \Seen \Middle \End1' eq flags_regex( q'Begin \Seen NonJunk \Middle $Spam \End1 End' ), 
-                     q'flags_regex: only \word among Begin \Seen NonJunk \Middle $Spam \End1 End' ) ;
+        @regexflag = ( 's/(\s|^)[^\\\\]\w+//g' ) ;
+        ok( q{\Seen \Middle \End}   eq flags_regex( q{\Seen NonJunk \Middle $Spam \End} ), q{flags_regex: only \word among \Seen NonJunk \Middle $Spam \End} ) ;
+        ok( q{ \Seen \Middle \End1} eq flags_regex( q{Begin \Seen NonJunk \Middle $Spam \End1 End} ),
+                     q{flags_regex: only \word among Begin \Seen NonJunk \Middle $Spam \End1 End} ) ;
 
-	@regexflag = ( q's/.*?(Keep1|Keep2|Keep3)/$1 /g' ) ;
-	ok('Keep1 Keep2  ReB' eq flags_regex('ReA Keep1 REM Keep2 ReB'), 'Keep only regex' ) ;
-	
-	ok('Keep1 Keep2 ' eq flags_regex( 'REM REM Keep1 Keep2'), 'Keep only regex' ) ;
-	ok('Keep1 Keep2 ' eq flags_regex( 'Keep1 REM REM Keep2'), 'Keep only regex' ) ;
-	ok('Keep1 Keep2 ' eq flags_regex( 'REM Keep1 REM REM  Keep2'), 'Keep only regex' ) ;
-	ok('Keep1 Keep2 ' eq flags_regex( 'Keep1 Keep2'), 'Keep only regex' ) ;
-	ok('Keep1 ' eq flags_regex( 'REM Keep1'), 'Keep only regex' ) ;
+        @regexflag = ( q{s/.*?(Keep1|Keep2|Keep3)/$1 /g} ) ;
+        ok( 'Keep1 Keep2  ReB' eq flags_regex('ReA Keep1 REM Keep2 ReB'), 'Keep only regex' ) ;
 
-	@regexflag = ( q's/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g' ) ;
-	ok('Keep1 Keep2 ' eq flags_regex( 'Keep1 Keep2 ReB'), 'Keep only regex' ) ;
-	ok('Keep1 Keep2 ' eq flags_regex( 'Keep1 Keep2 REM REM  REM'), 'Keep only regex' ) ;
-	ok('Keep2 ' eq flags_regex('Keep2 REM REM  REM'), 'Keep only regex' ) ;
-	
+        ok( 'Keep1 Keep2 ' eq flags_regex( 'REM REM Keep1 Keep2'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex( 'Keep1 REM REM Keep2'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex( 'REM Keep1 REM REM  Keep2'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex( 'Keep1 Keep2'), 'Keep only regex' ) ;
+        ok( 'Keep1 ' eq flags_regex( 'REM Keep1'), 'Keep only regex' ) ;
 
-	@regexflag = ( q's/.*?(Keep1|Keep2|Keep3)/$1 /g',
-	   's/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g');
-	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), 'Keep only regex');
-	ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), 'Keep only regex');
-	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), 'Keep only regex');
-	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), 'Keep only regex');
-	ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), 'Keep only regex');
-	ok('Keep1 ' eq flags_regex('REM  REM Keep1 REM REM REM '), 'Keep only regex');
-	ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), 'Keep only regex');
-
-	@regexflag = ('s/(.*)/$1 jrdH8u/');
-	ok('REM  REM  REM REM REM jrdH8u' eq flags_regex('REM  REM  REM REM REM'), q{Keep only regex 's/(.*)/\$1 jrdH8u/'} ) ;
-	@regexflag = ('s/jrdH8u *//');
-	ok('REM  REM  REM REM REM ' eq flags_regex('REM  REM  REM REM REM jrdH8u'), q{Keep only regex s/jrdH8u *//} ) ;
-
-	@regexflag = (
-	's/(.*)/$1 jrdH8u/',
-	's/.*?(Keep1|Keep2|Keep3|jrdH8u)/$1 /g',
-	's/(Keep1|Keep2|Keep3|jrdH8u) (?!(Keep1|Keep2|Keep3|jrdH8u)).*/$1 /g',
-	's/jrdH8u *//'
-	);
-
-	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), q{Keep only regex 'REM Keep1 REM Keep2 REM'} ) ;
-	ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), 'Keep only regex');
-	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), 'Keep only regex');
-	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), 'Keep only regex');
-	ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), 'Keep only regex');
-	ok('Keep1 ' eq flags_regex('REM  REM Keep1 REM REM REM '), 'Keep only regex');
-	ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), 'Keep only regex');
-	ok(q{} eq flags_regex('REM  REM REM REM REM'), 'Keep only regex');
-
-	@regexflag = (
-	's/(.*)/$1 jrdH8u/',
-	's/.*?(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)/$1 /g',
-	's/(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u) (?!(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)).*/$1 /g',
-	's/jrdH8u *//'
-	);
-
-	ok('\\Deleted \\Answered '
-	    eq flags_regex('Blabla $Junk \\Deleted machin \\Answered truc'), 'Keep only regex: Exchange case' ) ;
-	ok( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string' ) ;
-	ok( q{}
-	   eq flags_regex('Blabla $Junk  machin  truc'), 'Keep only regex: Exchange case, no accepted flags' ) ;
-	ok( '\\Deleted \\Answered \\Draft \\Flagged '
-	    eq flags_regex('\\Deleted    \\Answered  \\Draft \\Flagged '), 'Keep only regex: Exchange case' ) ;
+        @regexflag = ( q{s/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g} ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex( 'Keep1 Keep2 ReB'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex( 'Keep1 Keep2 REM REM  REM'), 'Keep only regex' ) ;
+        ok( 'Keep2 ' eq flags_regex('Keep2 REM REM  REM'), 'Keep only regex' ) ;
 
 
-	@regexflag = (
-	's/.*?(?:(\\\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg'
-	);
+        @regexflag = ( q{s/.*?(Keep1|Keep2|Keep3)/$1 /g},
+           's/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), 'Keep only regex' ) ;
+        ok( 'Keep1 ' eq flags_regex('REM  REM Keep1 REM REM REM '), 'Keep only regex' ) ;
+        ok( 'Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), 'Keep only regex' ) ;
 
-	ok( '\\Deleted \\Answered '
-	eq flags_regex('Blabla \$Junk \\Deleted machin \\Answered truc'),
-	'Keep only regex: Exchange case (Phil)' ) ;
+        @regexflag = ( 's/(.*)/$1 jrdH8u/' ) ;
+        ok('REM  REM  REM REM REM jrdH8u' eq flags_regex('REM  REM  REM REM REM'), q{Keep only regex 's/(.*)/\$1 jrdH8u/'} ) ;
+        @regexflag = ('s/jrdH8u *//');
+        ok('REM  REM  REM REM REM ' eq flags_regex('REM  REM  REM REM REM jrdH8u'), q{Keep only regex s/jrdH8u *//} ) ;
 
-	ok( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string (Phil)' ) ;
+        @regexflag = (
+        's/(.*)/$1 jrdH8u/',
+        's/.*?(Keep1|Keep2|Keep3|jrdH8u)/$1 /g',
+        's/(Keep1|Keep2|Keep3|jrdH8u) (?!(Keep1|Keep2|Keep3|jrdH8u)).*/$1 /g',
+        's/jrdH8u *//'
+        );
 
-	ok( q{}
-	eq flags_regex('Blabla $Junk  machin  truc'),
-	'Keep only regex: Exchange case, no accepted flags (Phil)' ) ;
+        ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), q{Keep only regex 'REM Keep1 REM Keep2 REM'} ) ;
+        ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), 'Keep only regex');
+        ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), 'Keep only regex');
+        ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), 'Keep only regex');
+        ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), 'Keep only regex');
+        ok('Keep1 ' eq flags_regex('REM  REM Keep1 REM REM REM '), 'Keep only regex');
+        ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), 'Keep only regex');
+        ok(q{} eq flags_regex('REM  REM REM REM REM'), 'Keep only regex');
 
-	ok('\\Deleted \\Answered \\Draft \\Flagged '
-	eq flags_regex('\\Deleted    \\Answered  \\Draft \\Flagged '),
-	'Keep only regex: Exchange case (Phil)' ) ;
+        @regexflag = (
+        's/(.*)/$1 jrdH8u/',
+        's/.*?(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)/$1 /g',
+        's/(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u) (?!(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)).*/$1 /g',
+        's/jrdH8u *//'
+        );
 
-	return ;
+        ok('\\Deleted \\Answered '
+            eq flags_regex('Blabla $Junk \\Deleted machin \\Answered truc'), 'Keep only regex: Exchange case' ) ;
+        ok( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string' ) ;
+        ok( q{}
+           eq flags_regex('Blabla $Junk  machin  truc'), 'Keep only regex: Exchange case, no accepted flags' ) ;
+        ok( '\\Deleted \\Answered \\Draft \\Flagged '
+            eq flags_regex('\\Deleted    \\Answered  \\Draft \\Flagged '), 'Keep only regex: Exchange case' ) ;
+
+
+        @regexflag = (
+        's/.*?(?:(\\\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg'
+        );
+
+        ok( '\\Deleted \\Answered '
+        eq flags_regex('Blabla \$Junk \\Deleted machin \\Answered truc'),
+        'Keep only regex: Exchange case (Phil)' ) ;
+
+        ok( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string (Phil)' ) ;
+
+        ok( q{}
+        eq flags_regex('Blabla $Junk  machin  truc'),
+        'Keep only regex: Exchange case, no accepted flags (Phil)' ) ;
+
+        ok('\\Deleted \\Answered \\Draft \\Flagged '
+        eq flags_regex('\\Deleted    \\Answered  \\Draft \\Flagged '),
+        'Keep only regex: Exchange case (Phil)' ) ;
+
+	note( 'Leaving  tests_flags_regex()' ) ;
+        return ;
 }
 
 sub flags_regex {
-	my ( $h1_flags ) = @_ ;
-	foreach my $regexflag ( @regexflag ) {
-		my $h1_flags_orig = $h1_flags ;
-		$debugflags and myprint( "eval \$h1_flags =~ $regexflag\n"  ) ;
-		my $ret = eval "\$h1_flags =~ $regexflag ; 1 " ;
-		$debugflags and myprint( "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n"  ) ;
-                if( not ( defined $ret ) or $@ ) {
-			myprint( "Error: eval regexflag '$regexflag': $@\n"  ) ;
+        my ( $h1_flags ) = @_ ;
+        foreach my $regexflag ( @regexflag ) {
+                my $h1_flags_orig = $h1_flags ;
+                $debugflags and myprint( "eval \$h1_flags =~ $regexflag\n"  ) ;
+                my $ret = eval "\$h1_flags =~ $regexflag ; 1 " ;
+                $debugflags and myprint( "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n"  ) ;
+                if( not ( defined $ret ) or $EVAL_ERROR ) {
+                        myprint( "Error: eval regexflag '$regexflag': $EVAL_ERROR\n"  ) ;
                         return( undef ) ;
                 }
-	}
-	return( $h1_flags ) ;
+        }
+        return( $h1_flags ) ;
 }
 
 sub acls_sync {
-	my($h1_fold, $h2_fold) = @_ ;
-	if ( $syncacls ) {
-		my $h1_hash = $imap1->getacl($h1_fold)
-		  or myprint( "Could not getacl for $h1_fold: $@\n" ) ;
-		my $h2_hash = $imap2->getacl($h2_fold)
-		  or myprint( "Could not getacl for $h2_fold: $@\n" ) ;
-		my %users = map { ($_, 1) } ( keys  %{ $h1_hash} , keys %{ $h2_hash }  ) ;
-		foreach my $user (sort keys %users ) {
-			my $acl = $h1_hash->{$user} || 'none' ;
-			myprint( "acl $user: [$acl]\n" ) ;
-			next if ($h1_hash->{$user} && $h2_hash->{$user} &&
-				 $h1_hash->{$user} eq $h2_hash->{$user});
-			unless ($dry) {
-				myprint( "setting acl $h2_fold $user $acl\n" ) ;
-				$imap2->setacl($h2_fold, $user, $acl)
-				  or myprint( "Could not set acl: $@\n" ) ;
-			}
-		}
-	}
+        my($h1_fold, $h2_fold) = @_ ;
+        if ( $syncacls ) {
+                my $h1_hash = $imap1->getacl($h1_fold)
+                  or myprint( "Could not getacl for $h1_fold: $EVAL_ERROR\n" ) ;
+                my $h2_hash = $imap2->getacl($h2_fold)
+                  or myprint( "Could not getacl for $h2_fold: $EVAL_ERROR\n" ) ;
+                my %users = map { ($_, 1) } ( keys  %{ $h1_hash} , keys %{ $h2_hash }  ) ;
+                foreach my $user (sort keys %users ) {
+                        my $acl = $h1_hash->{$user} || 'none' ;
+                        myprint( "acl $user: [$acl]\n" ) ;
+                        next if ($h1_hash->{$user} && $h2_hash->{$user} &&
+                                 $h1_hash->{$user} eq $h2_hash->{$user});
+                        unless ($sync->{dry}) {
+                                myprint( "setting acl $h2_fold $user $acl\n" ) ;
+                                $imap2->setacl($h2_fold, $user, $acl)
+                                  or myprint( "Could not set acl: $EVAL_ERROR\n" ) ;
+                        }
+                }
+        }
         return ;
 }
 
 
 sub tests_permanentflags {
+	note( 'Entering tests_permanentflags()' ) ;
 
-	my $string;
-	ok(q{} eq permanentflags(' * OK [PERMANENTFLAGS (\* \Draft \Answered)] Limited'),
-	   'permanentflags \*');
-	ok('\Draft \Answered' eq permanentflags(' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited'),
-	   'permanentflags \Draft \Answered');
-	ok('\Draft \Answered'
-	   eq permanentflags('Blabla',
-	                     ' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited',
-			     'Blabla'),
-	   'permanentflags \Draft \Answered'
-	);
-	ok(q{} eq permanentflags('Blabla'), 'permanentflags nothing');
+        my $string;
+        ok(q{} eq permanentflags(' * OK [PERMANENTFLAGS (\* \Draft \Answered)] Limited'),
+           'permanentflags \*');
+        ok('\Draft \Answered' eq permanentflags(' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited'),
+           'permanentflags \Draft \Answered');
+        ok('\Draft \Answered'
+           eq permanentflags('Blabla',
+                             ' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited',
+                             'Blabla'),
+           'permanentflags \Draft \Answered'
+        );
+        ok(q{} eq permanentflags('Blabla'), 'permanentflags nothing');
+
+	note( 'Leaving  tests_permanentflags()' ) ;
         return ;
 }
 
 sub permanentflags {
-	my @lines = @_ ;
+        my @lines = @_ ;
 
-	foreach my $line (@lines) {
-		if ( $line =~ m{\[PERMANENTFLAGS\s\(([^)]+?)\)\]}x ) {
-			( $debugflags or $debug ) and myprint( "permanentflags: $line"  ) ;
-			my $permanentflags = $1 ;
-			if ( $permanentflags =~ m{\\\*}x ) {
-				$permanentflags = q{} ;
-			}
-			return($permanentflags) ;
-		} ;
-	}
+        foreach my $line (@lines) {
+                if ( $line =~ m{\[PERMANENTFLAGS\s\(([^)]+?)\)\]}x ) {
+                        ( $debugflags or $debug ) and myprint( "permanentflags: $line"  ) ;
+                        my $permanentflags = $1 ;
+                        if ( $permanentflags =~ m{\\\*}x ) {
+                                $permanentflags = q{} ;
+                        }
+                        return($permanentflags) ;
+                } ;
+        }
         return( q{} ) ;
 }
 
 sub tests_flags_filter {
+	note( 'Entering tests_flags_filter()' ) ;
 
-	ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' );
-	ok( q{} eq flags_filter('\Seen', '\Draft  \Answered'), 'flags_filter ' );
-	ok( '\Seen' eq flags_filter('\Seen', '\Seen'), 'flags_filter ' );
-	ok( '\Seen' eq flags_filter('\Seen', ' \Seen '), 'flags_filter ' );
-	ok( '\Seen \Draft'
-	   eq flags_filter('\Seen \Draft', '\Draft \Seen \Answered'), 'flags_filter ' );
-	ok( '\Seen \Draft'
-	   eq flags_filter('\Seen \Draft', ' \Draft \Seen \Answered '), 'flags_filter ' );
-        return ;
+        ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' );
+        ok( q{} eq flags_filter('\Seen', '\Draft  \Answered'), 'flags_filter ' );
+        ok( '\Seen' eq flags_filter('\Seen', '\Seen'), 'flags_filter ' );
+        ok( '\Seen' eq flags_filter('\Seen', ' \Seen '), 'flags_filter ' );
+        ok( '\Seen \Draft'
+           eq flags_filter('\Seen \Draft', '\Draft \Seen \Answered'), 'flags_filter ' );
+        ok( '\Seen \Draft'
+           eq flags_filter('\Seen \Draft', ' \Draft \Seen \Answered '), 'flags_filter ' );
+
+	note( 'Leaving  tests_flags_filter()' ) ;
+	return ;
 }
 
 sub flags_filter {
-	my( $flags, $allowed_flags ) = @_ ;
+        my( $flags, $allowed_flags ) = @_ ;
 
-	my @flags = split  /\s+/x, $flags ;
-	my %allowed_flags = map { $_ => 1 } split q{ }, $allowed_flags ;
-	my @flags_out     = map { exists $allowed_flags{$_} ? $_ : () } @flags ;
+        my @flags = split  /\s+/x, $flags ;
+        my %allowed_flags = map { $_ => 1 } split q{ }, $allowed_flags ;
+        my @flags_out     = map { exists $allowed_flags{$_} ? $_ : () } @flags ;
 
-	my $flags_out = join q{ }, @flags_out ;
+        my $flags_out = join q{ }, @flags_out ;
 
-	return( $flags_out ) ;
+        return( $flags_out ) ;
 }
 
 sub flagscase {
-	my $flags = shift ;
+        my $flags = shift ;
 
-	my @flags = split /\s+/x, $flags ;
-	my %rfc_flags = map { $_ => 1 } split q{ }, '\Answered \Flagged \Deleted \Seen \Draft' ;
-	my @flags_out = map { exists $rfc_flags{ ucsecond( lc $_ ) } ? ucsecond( lc $_ ) : $_ } @flags ;
+        my @flags = split /\s+/x, $flags ;
+        my %rfc_flags = map { $_ => 1 } split q{ }, '\Answered \Flagged \Deleted \Seen \Draft' ;
+        my @flags_out = map { exists $rfc_flags{ ucsecond( lc $_ ) } ? ucsecond( lc $_ ) : $_ } @flags ;
 
-	my $flags_out = join q{ }, @flags_out ;
+        my $flags_out = join q{ }, @flags_out ;
 
-	return( $flags_out ) ;
+        return( $flags_out ) ;
 }
 
 sub tests_flagscase {
-	ok( '\Seen' eq flagscase( '\Seen' ), 'flagscase: \Seen -> \Seen' ) ;
-	ok( '\Seen' eq flagscase( '\SEEN' ), 'flagscase: \SEEN -> \Seen' ) ;
+	note( 'Entering tests_flagscase()' ) ;
 
-	ok( '\Seen \Draft' eq flagscase( '\SEEN \DRAFT' ), 'flagscase: \SEEN \DRAFT -> \Seen \Draft' ) ;
-	ok( '\Draft \Seen' eq flagscase( '\DRAFT \SEEN' ), 'flagscase: \DRAFT \SEEN -> \Draft \Seen' ) ;
+        ok( '\Seen' eq flagscase( '\Seen' ), 'flagscase: \Seen -> \Seen' ) ;
+        ok( '\Seen' eq flagscase( '\SEEN' ), 'flagscase: \SEEN -> \Seen' ) ;
 
-	ok( '\Draft LALA \Seen' eq flagscase( '\DRAFT  LALA \SEEN' ), 'flagscase: \DRAFT  LALA \SEEN -> \Draft LALA \Seen' ) ;
-	ok( '\Draft lala \Seen' eq flagscase( '\DRAFT  lala \SEEN' ), 'flagscase: \DRAFT  lala \SEEN -> \Draft lala \Seen' ) ;
+        ok( '\Seen \Draft' eq flagscase( '\SEEN \DRAFT' ), 'flagscase: \SEEN \DRAFT -> \Seen \Draft' ) ;
+        ok( '\Draft \Seen' eq flagscase( '\DRAFT \SEEN' ), 'flagscase: \DRAFT \SEEN -> \Draft \Seen' ) ;
+
+        ok( '\Draft LALA \Seen' eq flagscase( '\DRAFT  LALA \SEEN' ), 'flagscase: \DRAFT  LALA \SEEN -> \Draft LALA \Seen' ) ;
+        ok( '\Draft lala \Seen' eq flagscase( '\DRAFT  lala \SEEN' ), 'flagscase: \DRAFT  lala \SEEN -> \Draft lala \Seen' ) ;
+
+	note( 'Leaving  tests_flagscase()' ) ;
         return ;
 }
 
 
 
 sub ucsecond {
-	my $string = shift ;
-	my $output ;
+        my $string = shift ;
+        my $output ;
 
-	return( $string )  if ( 1 >= length $string ) ;
-	
-	$output = ( substr( $string, 0, 1) ) . ( uc substr $string, 1, 1 ) . ( substr $string, 2 ) ;
-	#myprint( "UUU $string -> $output\n"  ) ;
-	return( $output ) ;
+        return( $string )  if ( 1 >= length $string ) ;
+
+        $output = ( substr( $string, 0, 1) ) . ( uc substr $string, 1, 1 ) . ( substr $string, 2 ) ;
+        #myprint( "UUU $string -> $output\n"  ) ;
+        return( $output ) ;
 }
 
 
 sub tests_ucsecond {
-	ok( 'aBcde' eq ucsecond( 'abcde' ), 'ucsecond: abcde -> aBcde' ) ;
-	ok( 'ABCDE' eq ucsecond( 'ABCDE' ), 'ucsecond: ABCDE -> ABCDE'  ) ;
-	ok( 'ABCDE' eq ucsecond( 'AbCDE' ), 'ucsecond: AbCDE -> ABCDE'  ) ;
-	ok( 'ABCde' eq ucsecond( 'AbCde' ), 'ucsecond: AbCde -> ABCde'  ) ;
-	ok( 'A'     eq ucsecond( 'A' ),     'ucsecond: A  -> A'  ) ;
-	ok( 'AB'    eq ucsecond( 'Ab' ),    'ucsecond: Ab -> AB' ) ;
-	ok( '\B'    eq ucsecond( '\b' ),    'ucsecond: \b -> \B' ) ;
-	ok( '\Bcde' eq ucsecond( '\bcde' ), 'ucsecond: \bcde -> \Bcde' ) ;
+	note( 'Entering tests_ucsecond()' ) ;
+        ok( 'aBcde' eq ucsecond( 'abcde' ), 'ucsecond: abcde -> aBcde' ) ;
+        ok( 'ABCDE' eq ucsecond( 'ABCDE' ), 'ucsecond: ABCDE -> ABCDE'  ) ;
+        ok( 'ABCDE' eq ucsecond( 'AbCDE' ), 'ucsecond: AbCDE -> ABCDE'  ) ;
+        ok( 'ABCde' eq ucsecond( 'AbCde' ), 'ucsecond: AbCde -> ABCde'  ) ;
+        ok( 'A'     eq ucsecond( 'A' ),     'ucsecond: A  -> A'  ) ;
+        ok( 'AB'    eq ucsecond( 'Ab' ),    'ucsecond: Ab -> AB' ) ;
+        ok( '\B'    eq ucsecond( '\b' ),    'ucsecond: \b -> \B' ) ;
+        ok( '\Bcde' eq ucsecond( '\bcde' ), 'ucsecond: \bcde -> \Bcde' ) ;
+
+	note( 'Leaving  tests_ucsecond()' ) ;
         return ;
 }
 
 
 sub select_msgs {
-	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
-	my ( @msgs ) ;
+        my ( $imap, $msgs_all_hash_ref, $search_cmd, $abletosearch, $folder ) = @_ ;
+        my ( @msgs ) ;
 
-	if ( $abletosearch ) {
-		@msgs = select_msgs_by_search( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
-	}else{
-		@msgs = select_msgs_by_fetch( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
-	}
-	return(  @msgs ) ;
+        if ( $abletosearch ) {
+                @msgs = select_msgs_by_search( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
+        }else{
+                @msgs = select_msgs_by_fetch( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
+        }
+        return(  @msgs ) ;
 
 }
 
 sub select_msgs_by_search {
-	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
-	my ( @msgs, @msgs_all ) ;
+        my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
+        my ( @msgs, @msgs_all ) ;
 
         # Need to have the whole list in msgs_all_hash_ref
         # without calling messages() several times.
         # Need all messages list to avoid deleting useful cache part
         # in case of --search or --minage or --maxage
 
-	if ( ( defined  $msgs_all_hash_ref  and $usecache )
+        if ( ( defined  $msgs_all_hash_ref  and $usecache )
         or ( not defined  $maxage  and not defined  $minage  and not defined  $search_cmd  )
         ) {
 
-       		$debugdev and myprint( "Calling messages()\n"  ) ;
-		@msgs_all = $imap->messages(  ) ;
+                $debugdev and myprint( "Calling messages()\n"  ) ;
+                @msgs_all = $imap->messages(  ) ;
 
                 return if ( $#msgs_all == 0 && !defined  $msgs_all[0]  ) ;
 
@@ -4807,22 +5849,22 @@ sub select_msgs_by_search {
                 if ( not defined  $maxage  and not defined  $minage  and not defined  $search_cmd  ) {
                         return( @msgs_all ) ;
                 }
-	}
+        }
 
         if ( defined  $search_cmd  ) {
-        	@msgs = $imap->search( $search_cmd ) ;
+                @msgs = $imap->search( $search_cmd ) ;
                 return( @msgs ) ;
         }
 
-	# we are here only if $maxage or $minage is defined
+        # we are here only if $maxage or $minage is defined
         @msgs = select_msgs_by_age( $imap ) ;
-	return( @msgs );
+        return( @msgs );
 }
 
 
 sub select_msgs_by_fetch {
-	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
-	my ( @msgs, @msgs_all, %fetch ) ;
+        my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
+        my ( @msgs, @msgs_all, %fetch ) ;
 
         # Need to have the whole list in msgs_all_hash_ref
         # without calling messages() several times.
@@ -4830,10 +5872,10 @@ sub select_msgs_by_fetch {
         # in case of --search or --minage or --maxage
 
 
-	$debugdev and myprint( "Calling fetch_hash()\n"  ) ;
-	my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
-	my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
-	%fetch = %{$imap->fetch_hash( $fetch_hash_uids, 'INTERNALDATE' ) } ;
+        $debugdev and myprint( "Calling fetch_hash()\n"  ) ;
+        my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
+        my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+        %fetch = %{$imap->fetch_hash( $fetch_hash_uids, 'INTERNALDATE' ) } ;
 
         @msgs_all = sort { $a <=> $b } keys  %fetch  ;
         $debugdev and myprint( "Done fetch_hash()\n"  ) ;
@@ -4849,138 +5891,142 @@ sub select_msgs_by_fetch {
         }
 
         if ( defined  $search_cmd  ) {
-		myprint( "Warning: strange to see --search with --noabletosearch, an error can happen\n"  ) ;
-        	@msgs = $imap->search( $search_cmd ) ;
+                myprint( "Warning: strange to see --search with --noabletosearch, an error can happen\n"  ) ;
+                @msgs = $imap->search( $search_cmd ) ;
                 return( @msgs ) ;
         }
 
-	# we are here only if $maxage or $minage is defined
-	my( @max, @min, $maxage_epoch, $minage_epoch ) ;
-	if ( defined  $maxage  ) { $maxage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ; }
-	if ( defined  $minage  ) { $minage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ; }
-	foreach my $msg ( @msgs_all ) {
-		my $idate = $fetch{ $msg }->{'INTERNALDATE'} ;
-		#myprint( "$idate\n"  ) ;
-		if ( defined  $maxage  and ( epoch( $idate ) >= $maxage_epoch ) ) {
-			push  @max, $msg  ;
-		}
-		if ( defined  $minage  and ( epoch( $idate ) <= $minage_epoch ) ) {
-			push  @min, $msg  ;
-		}
-	}
+        # we are here only if $maxage or $minage is defined
+        my( @max, @min, $maxage_epoch, $minage_epoch ) ;
+        if ( defined  $maxage  ) { $maxage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ; }
+        if ( defined  $minage  ) { $minage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ; }
+        foreach my $msg ( @msgs_all ) {
+                my $idate = $fetch{ $msg }->{'INTERNALDATE'} ;
+                #myprint( "$idate\n"  ) ;
+                if ( defined  $maxage  and ( epoch( $idate ) >= $maxage_epoch ) ) {
+                        push  @max, $msg  ;
+                }
+                if ( defined  $minage  and ( epoch( $idate ) <= $minage_epoch ) ) {
+                        push  @min, $msg  ;
+                }
+        }
         @msgs = msgs_from_maxmin( \@max, \@min ) ;
-	return( @msgs ) ;
+        return( @msgs ) ;
 }
 
 sub select_msgs_by_age {
-	my( $imap ) = @_ ;
+        my( $imap ) = @_ ;
 
-	my( @max, @min, @msgs, @inter, @union ) ;
+        my( @max, @min, @msgs, @inter, @union ) ;
 
-	if ( defined  $maxage  ) {
-		@max = $imap->sentsince( $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ) ;
-	}
-	if ( defined  $minage  ) {
-		@min = $imap->sentbefore( $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ) ;
-	}
+        if ( defined  $maxage  ) {
+                @max = $imap->sentsince( $timestart_int - $NB_SECONDS_IN_A_DAY * $maxage ) ;
+        }
+        if ( defined  $minage  ) {
+                @min = $imap->sentbefore( $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ) ;
+        }
 
-	@msgs = msgs_from_maxmin( \@max, \@min ) ;
-	return( @msgs ) ;
+        @msgs = msgs_from_maxmin( \@max, \@min ) ;
+        return( @msgs ) ;
 }
 
 sub msgs_from_maxmin {
-	my( $max_ref, $min_ref ) = @_ ;
-	my( @max, @min, @msgs, @inter, @union ) ;
+        my( $max_ref, $min_ref ) = @_ ;
+        my( @max, @min, @msgs, @inter, @union ) ;
 
-	@max = @{ $max_ref } ;
-	@min = @{ $min_ref } ;
+        @max = @{ $max_ref } ;
+        @min = @{ $min_ref } ;
 
-	SWITCH: {
-		unless( defined  $minage  ) { @msgs = @max ; last SWITCH } ;
-		unless( defined  $maxage  ) { @msgs = @min ; last SWITCH } ;
-		my ( %union, %inter ) ;
-		foreach my $m ( @min, @max ) { $union{ $m }++ && $inter{ $m }++ }
-		@inter = sort { $a <=> $b } keys  %inter  ;
-		@union = sort { $a <=> $b } keys  %union  ;
-		# normal case
-		if ( $minage <= $maxage )  { @msgs = @inter ; last SWITCH } ;
-		# just exclude messages between
-		if ( $minage > $maxage )  { @msgs = @union ; last SWITCH } ;
+        SWITCH: {
+                unless( defined  $minage  ) { @msgs = @max ; last SWITCH } ;
+                unless( defined  $maxage  ) { @msgs = @min ; last SWITCH } ;
+                my ( %union, %inter ) ;
+                foreach my $m ( @min, @max ) { $union{ $m }++ && $inter{ $m }++ }
+                @inter = sort { $a <=> $b } keys  %inter  ;
+                @union = sort { $a <=> $b } keys  %union  ;
+                # normal case
+                if ( $minage <= $maxage )  { @msgs = @inter ; last SWITCH } ;
+                # just exclude messages between
+                if ( $minage > $maxage )  { @msgs = @union ; last SWITCH } ;
 
-	}
-	return( @msgs ) ;
+        }
+        return( @msgs ) ;
 }
 
 sub tests_msgs_from_maxmin {
-	my @msgs ;
-	$maxage = $NUMBER_200 ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '1', '2' ], \@msgs ), 'msgs_from_maxmin: maxage++' ) ;
-	$minage = $NUMBER_100 ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '2' ], \@msgs ), 'msgs_from_maxmin:  -maxage++minage-' ) ;
-	$minage = $NUMBER_300 ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '1', '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++maxage-minage++' ) ;
-	$maxage = undef ;
-	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
-	ok( 0 == compare_lists( [ '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++minage-' ) ;
-	return ;
+	note( 'Entering tests_msgs_from_maxmin()' ) ;
+
+        my @msgs ;
+        $maxage = $NUMBER_200 ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '1', '2' ], \@msgs ), 'msgs_from_maxmin: maxage++' ) ;
+        $minage = $NUMBER_100 ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '2' ], \@msgs ), 'msgs_from_maxmin:  -maxage++minage-' ) ;
+        $minage = $NUMBER_300 ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '1', '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++maxage-minage++' ) ;
+        $maxage = undef ;
+        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+        ok( 0 == compare_lists( [ '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++minage-' ) ;
+
+	note( 'Leaving  tests_msgs_from_maxmin()' ) ;
+        return ;
 }
 
 
 sub lastuid {
-	my $imap   = shift ;
-	my $folder = shift ;
-	my $lastuid_guess  = shift ;
-	my $lastuid ;
+        my $imap   = shift ;
+        my $folder = shift ;
+        my $lastuid_guess  = shift ;
+        my $lastuid ;
 
-	# rfc3501: The only reliable way to identify recent messages is to
-	#          look at message flags to see which have the \Recent flag
-	#          set, or to do a SEARCH RECENT.
-	# SEARCH RECENT doesn't work this way on courrier.
+        # rfc3501: The only reliable way to identify recent messages is to
+        #          look at message flags to see which have the \Recent flag
+        #          set, or to do a SEARCH RECENT.
+        # SEARCH RECENT doesn't work this way on courrier.
 
-	my @recent_messages ;
-	# SEARCH RECENT for each transfer can be expensive with a big folder
-	# Call commented for now
-	#@recent_messages = $imap->recent(  ) ;
-	#myprint( "Recent: @recent_messages\n" ) ;
+        my @recent_messages ;
+        # SEARCH RECENT for each transfer can be expensive with a big folder
+        # Call commented for now
+        #@recent_messages = $imap->recent(  ) ;
+        #myprint( "Recent: @recent_messages\n" ) ;
 
-	my $max_recent ;
-	$max_recent = max( @recent_messages ) ;
+        my $max_recent ;
+        $max_recent = max( @recent_messages ) ;
 
-	if ( defined  $max_recent  and ($lastuid_guess <= $max_recent ) ) {
-		$lastuid = $max_recent ;
-	}else{
-		$lastuid = $lastuid_guess
-	}
-	return( $lastuid ) ;
+        if ( defined  $max_recent  and ($lastuid_guess <= $max_recent ) ) {
+                $lastuid = $max_recent ;
+        }else{
+                $lastuid = $lastuid_guess
+        }
+        return( $lastuid ) ;
 }
 
 sub size_filtered {
-	my( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) = @_ ;
+        my( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) = @_ ;
 
         $h1_size = 0 if ( ! $h1_size ) ; # null if empty or undef
-	if (defined $maxsize and $h1_size > $maxsize) {
-		myprint( "msg $h1_fold/$h1_msg skipped ($h1_size exceeds maxsize limit $maxsize bytes)\n" ) ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-		return( 1 ) ;
-	}
-	if (defined $minsize and $h1_size <= $minsize) {
-		myprint( "msg $h1_fold/$h1_msg skipped ($h1_size smaller than minsize $minsize bytes)\n" ) ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-		return( 1 ) ;
-	}
-	return( 0 ) ;
+        if (defined $maxsize and $h1_size > $maxsize) {
+                myprint( "msg $h1_fold/$h1_msg skipped ($h1_size exceeds maxsize limit $maxsize bytes)\n" ) ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                return( 1 ) ;
+        }
+        if (defined $minsize and $h1_size <= $minsize) {
+                myprint( "msg $h1_fold/$h1_msg skipped ($h1_size smaller than minsize $minsize bytes)\n" ) ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                return( 1 ) ;
+        }
+        return( 0 ) ;
 }
 
 sub message_exists {
-	my( $imap, $msg ) = @_ ;
-	return( 1 ) if not $imap->Uid(  ) ;
+        my( $imap, $msg ) = @_ ;
+        return( 1 ) if not $imap->Uid(  ) ;
 
-	my $search_uid ;
+        my $search_uid ;
         ( $search_uid ) = $imap->search( "UID $msg" ) ;
         #myprint( "$search ? $msg\n"  ) ;
         return( 1 ) if ( $search_uid eq $msg ) ;
@@ -4988,82 +6034,82 @@ sub message_exists {
 }
 
 sub copy_message {
-	# copy
+        # copy
 
-	my ( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ;
-	( $debug or $dry) and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $dry_message\n" ) ;
+        my ( $mysync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ;
+        ( $debug or $mysync->{dry}) and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $mysync->{dry_message}\n" ) ;
 
-	my $h1_size  = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'}  || 0 ;
-	my $h1_flags = $h1_fir_ref->{$h1_msg}->{'FLAGS'}        || q{} ;
-	my $h1_idate = $h1_fir_ref->{$h1_msg}->{'INTERNALDATE'} || q{} ;
+        my $h1_size  = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'}  || 0 ;
+        my $h1_flags = $h1_fir_ref->{$h1_msg}->{'FLAGS'}        || q{} ;
+        my $h1_idate = $h1_fir_ref->{$h1_msg}->{'INTERNALDATE'} || q{} ;
 
 
         if ( size_filtered( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) ) {
-        	$h1_nb_msg_processed +=1 ;
+                $h1_nb_msg_processed +=1 ;
                 return ;
         }
 
-	debugsleep( $sync ) ;
-	myprint( "- msg $h1_fold/$h1_msg S[$h1_size] F[$h1_flags] I[$h1_idate] has RFC822.SIZE null!\n" ) if ( ! $h1_size )   ;
+        debugsleep( $mysync ) ;
+        myprint( "- msg $h1_fold/$h1_msg S[$h1_size] F[$h1_flags] I[$h1_idate] has RFC822.SIZE null!\n" ) if ( ! $h1_size )   ;
 
 
         if ( $checkmessageexists and not message_exists( $imap1, $h1_msg ) ) {
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-        	$h1_nb_msg_processed +=1 ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                $h1_nb_msg_processed +=1 ;
                 return ;
         }
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("C1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	my ( $string, $string_len ) ;
-        ( $string_len ) = message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, \$string ) ;
+        my ( $string, $string_len ) ;
+        ( $string_len ) = message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, \$string ) ;
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("C2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
         # not defined or empty $string
-        if ( ( not $string ) and ( not $string_len ) ) {
-		myprint( "- msg $h1_fold/$h1_msg skipped.\n"  ) ;
-		$total_bytes_skipped += $h1_size;
-		$nb_msg_skipped += 1;
-                $h1_nb_msg_processed +=1 ;
+        if ( ( not $string ) or ( not $string_len ) ) {
+                myprint( "- msg $h1_fold/$h1_msg skipped.\n"  ) ;
+                $total_bytes_skipped += $h1_size;
+                $nb_msg_skipped += 1;
+                $h1_nb_msg_processed += 1 ;
                 return ;
         }
 
         # Lines too long (or not enough) => do no copy or fix
         if ( ( defined $maxlinelength ) or ( defined $minmaxlinelength ) ) {
-		$string = linelengthstuff( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate ) ;
-		if ( not defined  $string  ) {
-			$h1_nb_msg_processed +=1 ;
-			$total_bytes_skipped += $h1_size ;
-			$nb_msg_skipped += 1 ;
-			return ;
-		}
-	}
-
-	my $h1_date = date_for_host2( $h1_msg, $h1_idate ) ;
-
-	( $debug or $debugflags ) and
-        myprint( "Host1 flags init msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
-
-	$h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
-
-	( $debug or $debugflags ) and
-        myprint( "Host1 flags filt msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
-
-	$h1_date = undef if ($h1_date eq q{});
-
-	my $new_id = append_message_on_host2( \$string, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) ;
-
-	if ( $new_id and $syncflagsaftercopy ) {
-        	sync_flags_after_copy( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $new_id, $permanentflags2 ) ;
+                $string = linelengthstuff( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate ) ;
+                if ( not defined  $string  ) {
+                        $h1_nb_msg_processed +=1 ;
+                        $total_bytes_skipped += $h1_size ;
+                        $nb_msg_skipped += 1 ;
+                        return ;
+                }
         }
 
-	if ( $sync->{debugmemory} ) {
-        	myprintf("C3: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
+        my $h1_date = date_for_host2( $h1_msg, $h1_idate ) ;
+
+        ( $debug or $debugflags ) and
+        myprint( "Host1 flags init msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
+
+        $h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
+
+        ( $debug or $debugflags ) and
+        myprint( "Host1 flags filt msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"  ) ;
+
+        $h1_date = undef if ($h1_date eq q{});
+
+        my $new_id = append_message_on_host2( \$string, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) ;
+
+        if ( $new_id and $syncflagsaftercopy ) {
+                sync_flags_after_copy( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $new_id, $permanentflags2 ) ;
+        }
+
+        if ( $mysync->{debugmemory} ) {
+                myprintf("C3: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
         return $new_id ;
@@ -5072,51 +6118,51 @@ sub copy_message {
 
 
 sub linelengthstuff {
-	my( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate  ) = @_ ;
-	my $maxlinelength_string = max_line_length( $string ) ;
+        my( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate  ) = @_ ;
+        my $maxlinelength_string = max_line_length( $string ) ;
         $debugmaxlinelength and myprint( "msg $h1_fold/$h1_msg maxlinelength: $maxlinelength_string\n"  ) ;
 
         if ( ( defined $minmaxlinelength )  and ( $maxlinelength_string <= $minmaxlinelength ) ) {
-		my $subject = subject( $string ) ;
-         	$debugdev and myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
-                      	. "(Subject:[$subject]) (max line length under minmaxlinelength $minmaxlinelength bytes)\n" ) ;
-         	return ;
+                my $subject = subject( $string ) ;
+                $debugdev and myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
+                        . "(Subject:[$subject]) (max line length under minmaxlinelength $minmaxlinelength bytes)\n" ) ;
+                return ;
         }
 
         if ( ( defined $maxlinelength )  and ( $maxlinelength_string > $maxlinelength ) ) {
-         	my $subject = subject( $string ) ;
-		if ( $maxlinelengthcmd ) {
-			$string = pipemess( $string, $maxlinelengthcmd ) ;
-			# string undef means something was bad.
-			if ( not ( defined  $string  ) ) {
-				myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] "
-				      . "(Subject:[$subject]) could not be successfully transformed by --maxlinelengthcmd option\n" ) ;
-				return ;
-			}else{
-				return $string ;
-			}
-		}
-         	myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
+                my $subject = subject( $string ) ;
+                if ( $maxlinelengthcmd ) {
+                        $string = pipemess( $string, $maxlinelengthcmd ) ;
+                        # string undef means something was bad.
+                        if ( not ( defined  $string  ) ) {
+                                myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] "
+                                      . "(Subject:[$subject]) could not be successfully transformed by --maxlinelengthcmd option\n" ) ;
+                                return ;
+                        }else{
+                                return $string ;
+                        }
+                }
+                myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
                       . "(Subject:[$subject]) (line length exceeds maxlinelength $maxlinelength bytes)\n" ) ;
-		return ;
-	}
-	return $string ;
+                return ;
+        }
+        return $string ;
 }
 
 
 sub message_for_host2 {
 
-# global variable list: 
+# global variable list:
 # @skipmess
 # @regexmess
 # @pipemess
 # $addheader
 # $debugcontent
 # $debug
-# 
+#
 # API current
 #
-# at failure: 
+# at failure:
 #   * return nothing ( will then be undef or () )
 #   * $string_ref content is undef or empty
 # at success:
@@ -5124,78 +6170,78 @@ sub message_for_host2 {
 #   * $string_ref content filled with message
 
 # API future
-# 
-# 
-	my ( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) = @_ ;
+#
+#
+        my ( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) = @_ ;
 
         # abort when missing a parameter
-        if ( (!$sync) or  (!$h1_msg) or (!$h1_fold) or (!$h1_size) or (!defined $h1_flags) or (!$h1_idate) or (!$h1_fir_ref) or (!$string_ref) ) {
+        if ( (!$sync) or  (!$h1_msg) or (!$h1_fold) or (!$h1_size) or (!defined $h1_flags) or (!defined $h1_idate) or (!$h1_fir_ref) or (!$string_ref) ) {
                 return ;
         }
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("M1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-        my $imap1 = $sync->{imap1} ;
-	my $string_ok = $imap1->message_to_file( $string_ref, $h1_msg ) ;
+        my $imap1 = $mysync->{imap1} ;
+        my $string_ok = $imap1->message_to_file( $string_ref, $h1_msg ) ;
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("M2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	my $string_len = length_ref( $string_ref  ) ;
+        my $string_len = length_ref( $string_ref  ) ;
 
 
-	unless ( defined  $string_ok  and $string_len ) {
-		# undef or 0 length
-		my $error = join q{},
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] could not be fetched: ",
-			$imap1->LastError || q{}, "\n"  ;
-		errors_incr( $sync, $error ) ;
-		$total_bytes_error += $h1_size if ( $h1_size ) ;
+        unless ( defined  $string_ok  and $string_len ) {
+                # undef or 0 length
+                my $error = join q{},
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] could not be fetched: ",
+                        $imap1->LastError || q{}, "\n"  ;
+                errors_incr( $mysync, $error ) ;
+                $total_bytes_error += $h1_size if ( $h1_size ) ;
                 $h1_nb_msg_processed +=1 ;
-		return ;
-	}
+                return ;
+        }
 
-	if ( @skipmess ) {
-		my $match = skipmess( ${ $string_ref } ) ;
+        if ( @skipmess ) {
+                my $match = skipmess( ${ $string_ref } ) ;
                 # string undef means the eval regex was bad.
                 if ( not ( defined  $match  ) ) {
-                	myprint(
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
+                        myprint(
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                         . " could not be skipped by --skipmess option, bad regex\n" ) ;
-                	return ;
+                        return ;
                 }
                 if ( $match ) {
                         my $subject = subject( ${ $string_ref } ) ;
                         myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                             . " (Subject:[$subject]) skipped by --skipmess\n" ) ;
-                	return ;
+                        return ;
                 }
-	}
+        }
 
-	if ( @regexmess ) {
-		${ $string_ref } = regexmess( ${ $string_ref } ) ;
+        if ( @regexmess ) {
+                ${ $string_ref } = regexmess( ${ $string_ref } ) ;
                 # string undef means the eval regex was bad.
                 if ( not ( defined  ${ $string_ref }  ) ) {
-                	myprint(
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
+                        myprint(
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                         . " could not be transformed by --regexmess\n" ) ;
-                	return ;
+                        return ;
                 }
-	}
+        }
 
-	if ( @pipemess ) {
-		${ $string_ref } = pipemess( ${ $string_ref }, @pipemess ) ;
+        if ( @pipemess ) {
+                ${ $string_ref } = pipemess( ${ $string_ref }, @pipemess ) ;
                 # string undef means something was bad.
                 if ( not ( defined  ${ $string_ref }  ) ) {
-                	myprint(
-			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
+                        myprint(
+                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                         . " could not be successfully transformed by --pipemess option\n" ) ;
-                	return ;
+                        return ;
                 }
-	}
+        }
 
         if ( $addheader and defined $h1_fir_ref->{$h1_msg}->{'NO_HEADER'} ) {
                 my $header = add_header( $h1_msg ) ;
@@ -5205,85 +6251,89 @@ sub message_for_host2 {
 
         $string_len = length_ref( $string_ref  ) ;
 
-	$debugcontent and myprint(
-		q{=} x $STD_CHAR_PER_LINE, "\n",
-		"F message content begin next line ($string_len characters long)\n",
-		${ $string_ref },
-		"F message content ended on previous line\n", q{=} x $STD_CHAR_PER_LINE, "\n" ) ;
+        $debugcontent and myprint(
+                q{=} x $STD_CHAR_PER_LINE, "\n",
+                "F message content begin next line ($string_len characters long)\n",
+                ${ $string_ref },
+                "F message content ended on previous line\n", q{=} x $STD_CHAR_PER_LINE, "\n" ) ;
 
-        if ( $sync->{debugmemory} ) {
+        if ( $mysync->{debugmemory} ) {
                 myprintf("M3: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	return $string_len ;
+        return $string_len ;
 }
 
 sub tests_message_for_host2 {
-        
-        my ( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) ;
-        
+	note( 'Entering tests_message_for_host2()' ) ;
+
+
+        my ( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) ;
+
         is( undef, message_for_host2(  ), q{message_for_host2: no args} ) ;
-        is( undef, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), q{message_for_host2: undef args} ) ;
+        is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), q{message_for_host2: undef args} ) ;
 
         require Test::MockObject ;
         my $imapT = Test::MockObject->new(  ) ;
-        $sync->{imap1} = $imapT ;
+        $mysync->{imap1} = $imapT ;
         my $string ;
-        
+
         $h1_msg = 1 ;
         $h1_fold = 'FoldFoo';
-        $h1_size =  9 ; 
-        $h1_flags = '' ; 
+        $h1_size =  9 ;
+        $h1_flags = '' ;
         $h1_idate = '10-Jul-2015 09:00:00 +0200' ;
         $h1_fir_ref = {} ;
         $string_ref = \$string ;
-        $imapT->mock( 'message_to_file',   
+        $imapT->mock( 'message_to_file',
                 sub {
-                        my ( $imap, $string_ref, $msg ) = @_ ;
-                        ${$string_ref} = 'blablabla' ;
-                        return length ${$string_ref} ;
+                        my ( $imap, $mystring_ref, $msg ) = @_ ;
+                        ${$mystring_ref} = 'blablabla' ;
+                        return length ${$mystring_ref} ;
                 }
         ) ;
-        is( 9, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+        is( 9, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
         q{message_for_host2: msg 1 == "blablabla", length} ) ;
         is( 'blablabla', $string, q{message_for_host2: msg 1 == "blablabla", value} ) ;
- 
+
         # so far so good
         # now the --pipemess stuff
 
-	SKIP: {
+        SKIP: {
                 Readonly my $NB_WIN_tests_message_for_host2 => 0 ;
-		skip( 'Not on MSWin32', $NB_WIN_tests_message_for_host2 ) if ('MSWin32' ne $OSNAME) ;
-		# Windows
-		# "type" command does not accept redirection of STDIN with <
-		# "sort" does
+                skip( 'Not on MSWin32', $NB_WIN_tests_message_for_host2 ) if ('MSWin32' ne $OSNAME) ;
+                # Windows
+                # "type" command does not accept redirection of STDIN with <
+                # "sort" does
 
-	} ;
+        } ;
 
-	SKIP: {
+        SKIP: {
                 Readonly my $NB_UNX_tests_message_for_host2 => 6 ;
-		skip( 'Not on Unix', $NB_UNX_tests_message_for_host2 ) if ('MSWin32' eq $OSNAME) ;
-		# Unix
-                
+                skip( 'Not on Unix', $NB_UNX_tests_message_for_host2 ) if ('MSWin32' eq $OSNAME) ;
+                # Unix
+
                 # no change by cat
                 @pipemess = ( 'cat' ) ;
-                is( 9, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+                is( 9, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                 q{message_for_host2: --pipemess 'cat', length} ) ;
                 is( 'blablabla', $string, q{message_for_host2: --pipemess 'cat', value} ) ;
 
-                
+
                 # failure by false
                 @pipemess = ( 'false' ) ;
-                is( undef, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+                is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                 q{message_for_host2: --pipemess 'false', length} ) ;
                 is( undef, $string, q{message_for_host2: --pipemess 'false', value} ) ;
 
                 # failure by true since no output
                 @pipemess = ( 'true' ) ;
-                is( undef, message_for_host2( $sync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), 
+                is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                 q{message_for_host2: --pipemess 'true', length} ) ;
                 is( undef, $string, q{message_for_host2: --pipemess 'true', value} ) ;
         }
+
+	note( 'Leaving  tests_message_for_host2()' ) ;
         return ;
 }
 
@@ -5294,6 +6344,8 @@ sub length_ref {
 }
 
 sub tests_length_ref {
+	note( 'Entering tests_length_ref()' ) ;
+
         my $notdefined ;
         is( q{}, length_ref( \$notdefined ), q{length_ref: value not defined} ) ;
         my $notref ;
@@ -5302,200 +6354,257 @@ sub tests_length_ref {
         my $lala = 'lala' ;
         is( 4, length_ref( \$lala ), q{length_ref: lala length == 4} ) ;
         is( 4, length_ref( \'lili' ), q{length_ref: lili length == 4} ) ;
+
+	note( 'Leaving  tests_length_ref()' ) ;
         return ;
 }
 
 sub date_for_host2 {
-	my( $h1_msg, $h1_idate ) = @_ ;
+        my( $h1_msg, $h1_idate ) = @_ ;
 
-	my $h1_date = q{} ;
+        my $h1_date = q{} ;
 
-	if ( $syncinternaldates ) {
-		$h1_date = $h1_idate ;
-		$debug and myprint( "internal date from host1: [$h1_date]\n"  ) ;
-		$h1_date = good_date( $h1_date ) ;
-		$debug and myprint( "internal date from host1: [$h1_date] (fixed)\n"  ) ;
-	}
+        if ( $syncinternaldates ) {
+                $h1_date = $h1_idate ;
+                $debug and myprint( "internal date from host1: [$h1_date]\n"  ) ;
+                $h1_date = good_date( $h1_date ) ;
+                $debug and myprint( "internal date from host1: [$h1_date] (fixed)\n"  ) ;
+        }
 
-	if ( $idatefromheader ) {
-		$h1_date = $imap1->get_header( $h1_msg, 'Date' ) ;
-		$debug and myprint( "header date from host1: [$h1_date]\n"  ) ;
-		$h1_date = good_date( $h1_date ) ;
-		$debug and myprint( "header date from host1: [$h1_date] (fixed)\n"  ) ;
-	}
+        if ( $idatefromheader ) {
+                $h1_date = $imap1->get_header( $h1_msg, 'Date' ) ;
+                $debug and myprint( "header date from host1: [$h1_date]\n"  ) ;
+                $h1_date = good_date( $h1_date ) ;
+                $debug and myprint( "header date from host1: [$h1_date] (fixed)\n"  ) ;
+        }
 
-	return( $h1_date ) ;
+        return( $h1_date ) ;
 }
 
 sub flags_for_host2 {
-	my( $h1_flags, $permanentflags2 ) = @_ ;
-	# RFC 2060: This flag can not be altered by any client
-	$h1_flags =~ s@\\Recent\s?@@xgi ;
+        my( $h1_flags, $permanentflags2 ) = @_ ;
+        # RFC 2060: This flag can not be altered by any client
+        $h1_flags =~ s@\\Recent\s?@@xgi ;
         my $h1_flags_re ;
         if ( @regexflag and defined( $h1_flags_re = flags_regex( $h1_flags ) ) ) {
                 $h1_flags = $h1_flags_re ;
         }
-	$h1_flags = flagscase( $h1_flags ) if $flagscase ;
+        $h1_flags = flagscase( $h1_flags ) if $flagscase ;
         $h1_flags = flags_filter( $h1_flags, $permanentflags2) if ( $permanentflags2 and $filterflags ) ;
 
-	return( $h1_flags ) ;
+        return( $h1_flags ) ;
 }
 
 sub subject {
-	my $string = shift ;
-	my $subject = q{} ;
+        my $string = shift ;
+        my $subject = q{} ;
 
         my $header = extract_header( $string ) ;
 
         if( $header =~ m/^Subject:\s*([^\n\r]*)\r?$/msx ) {
-        	#myprint( "MMM[$1]\n"  ) ;
-        	$subject = $1 ;
+                #myprint( "MMM[$1]\n"  ) ;
+                $subject = $1 ;
         }
-	return( $subject ) ;
+        return( $subject ) ;
 }
 
 sub tests_subject {
-	ok( q{} eq subject( q{} ), 'subject: null') ;
-	ok( 'toto le hero' eq subject( 'Subject: toto le hero' ), 'subject: toto le hero') ;
-	ok( 'toto le hero' eq subject( 'Subject:toto le hero' ), 'subject: toto le hero blank') ;
-	ok( 'toto le hero' eq subject( "Subject:toto le hero\r\n" ), 'subject: toto le hero\r\n') ;
+	note( 'Entering tests_subject()' ) ;
+
+        ok( q{} eq subject( q{} ), 'subject: null') ;
+        ok( 'toto le hero' eq subject( 'Subject: toto le hero' ), 'subject: toto le hero') ;
+        ok( 'toto le hero' eq subject( 'Subject:toto le hero' ), 'subject: toto le hero blank') ;
+        ok( 'toto le hero' eq subject( "Subject:toto le hero\r\n" ), 'subject: toto le hero\r\n') ;
 
         my $MESS ;
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 From: lalala
 Subject: toto le hero
 Date: zzzzzz
 
 Boogie boogie
 EOF
-	ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 2') ;
+        ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 2') ;
 
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 Subject: toto le hero
 From: lalala
 Date: zzzzzz
 
 Boogie boogie
 EOF
-	ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 3') ;
+        ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 3') ;
 
 
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 From: lalala
 Subject: cuicui
 Date: zzzzzz
 
 Subject: toto le hero
 EOF
-	ok( 'cuicui' eq subject( $MESS ), 'subject: cuicui') ;
+        ok( 'cuicui' eq subject( $MESS ), 'subject: cuicui') ;
 
-	$MESS = <<'EOF';
+        $MESS = <<'EOF';
 From: lalala
 Date: zzzzzz
 
 Subject: toto le hero
 EOF
-	ok( q{} eq subject( $MESS ), 'subject: null but body could') ;
+        ok( q{} eq subject( $MESS ), 'subject: null but body could') ;
 
-	return ;
+	note( 'Leaving  tests_subject()' ) ;
+        return ;
 }
 
 
 # GlobVar
-# $dry
+# $sync
 # $max_msg_size_in_bytes
 # $imap2
 # $imap1
 # $total_bytes_error
 # $h1_nb_msg_processed
 # $h2_uidguess
-# $total_bytes_transferred
-# $nb_msg_transferred
-# $begin_transfer_time
-# $time_spent
 # ...
 #
 #
 sub append_message_on_host2 {
-	my( $string_ref, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) = @_ ;
-	if ( $sync->{debugmemory} ) {
-        	myprintf("A1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
+        my( $string_ref, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) = @_ ;
+        if ( $sync->{debugmemory} ) {
+                myprintf("A1: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
         }
 
-	my $new_id ;
-	if ( ! $dry ) {
-		$max_msg_size_in_bytes = max( $h1_size, $max_msg_size_in_bytes ) ;
-		$new_id = $imap2->append_string( $h2_fold, ${ $string_ref }, $h1_flags, $h1_date ) ;
-	        if ( $sync->{debugmemory} ) {
-        	        myprintf("A2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
+        my $new_id ;
+        if ( ! $sync->{dry} ) {
+                $max_msg_size_in_bytes = max( $h1_size, $max_msg_size_in_bytes ) ;
+                $new_id = $imap2->append_string( $h2_fold, ${ $string_ref }, $h1_flags, $h1_date ) ;
+                if ( $sync->{debugmemory} ) {
+                        myprintf("A2: Memory consumption: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI) ;
                 }
-		if ( ! $new_id){
-                	my $subject = subject( ${ $string_ref } ) ;
+                if ( ! $new_id){
+                        my $subject = subject( ${ $string_ref } ) ;
                         my $error_imap = $imap2->LastError || q{} ;
-			my $error = "- msg $h1_fold/$h1_msg {$string_len} couldn't append  (Subject:[$subject]) to folder $h2_fold: $error_imap\n" ;
-			errors_incr( $sync, $error ) ;
-			$total_bytes_error += $h1_size;
+                        my $error = "- msg $h1_fold/$h1_msg {$string_len} could not append ( Subject:[$subject], Date:[$h1_date], Size:[$h1_size] ) to folder $h2_fold: $error_imap\n" ;
+                        errors_incr( $sync, $error ) ;
+                        $total_bytes_error += $h1_size;
                         $h1_nb_msg_processed +=1 ;
-			return ;
-		}
-		else{
-			# good
-			# $new_id is an id if the IMAP server has the
-			# UIDPLUS capability else just a ref
-			if ( $new_id !~ m{^\d+$}x ) {
-				$new_id = lastuid( $imap2, $h2_fold, $h2_uidguess ) ;
-			}
-			$h2_uidguess += 1 ;
-			$total_bytes_transferred += $h1_size ;
-			$nb_msg_transferred += 1 ;
+                        return ;
+                }
+                else{
+                        # good
+                        # $new_id is an id if the IMAP server has the
+                        # UIDPLUS capability else just a ref
+                        if ( $new_id !~ m{^\d+$}x ) {
+                                $new_id = lastuid( $imap2, $h2_fold, $h2_uidguess ) ;
+                        }
+                        $h2_uidguess += 1 ;
+                        $sync->{total_bytes_transferred} += $h1_size ;
+                        $sync->{nb_msg_transferred} += 1 ;
                         $h1_nb_msg_processed +=1 ;
 
-                        my $time_spent = timesince( $begin_transfer_time ) ;
-                        my $rate = bytes_display_string( $total_bytes_transferred / $time_spent ) ;
+                        my $time_spent = timesince( $sync->{begin_transfer_time} ) ;
+                        my $rate = bytes_display_string( $sync->{total_bytes_transferred} / $time_spent ) ;
                         my $eta = eta( $time_spent,
-                                       $h1_nb_msg_processed, $h1_nb_msg_start, $nb_msg_transferred ) ;
-                        my $amount_transferred = bytes_display_string( $total_bytes_transferred ) ;
-			myprintf( "msg %s/%-19s copied to %s/%-10s %.2f msgs/s  %s/s %s copied  %s\n",
-                        $h1_fold, "$h1_msg {$string_len}", $h2_fold, $new_id, $nb_msg_transferred/$time_spent, $rate,
+                                       $h1_nb_msg_processed, $h1_nb_msg_start, $sync->{nb_msg_transferred} ) ;
+                        my $amount_transferred = bytes_display_string( $sync->{total_bytes_transferred} ) ;
+                        myprintf( "msg %s/%-19s copied to %s/%-10s %.2f msgs/s  %s/s %s copied  %s\n",
+                        $h1_fold, "$h1_msg {$string_len}", $h2_fold, $new_id, $sync->{nb_msg_transferred}/$time_spent, $rate,
                         $amount_transferred,
                         $eta );
-                        sleep_if_needed( $time_spent, $total_bytes_transferred, $nb_msg_transferred ) ;
+                        sleep_if_needed( $sync ) ;
                         if ( $usecache and $cacheaftercopy and $new_id =~ m{^\d+$}x ) {
-				$debugcache and myprint( "touch $cache_dir/${h1_msg}_$new_id\n"  ) ;
-				touch( "$cache_dir/${h1_msg}_$new_id" )
-                        	or croak( "Couldn't touch $cache_dir/${h1_msg}_$new_id" ) ;
+                                $debugcache and myprint( "touch $cache_dir/${h1_msg}_$new_id\n"  ) ;
+                                touch( "$cache_dir/${h1_msg}_$new_id" )
+                                or croak( "Couldn't touch $cache_dir/${h1_msg}_$new_id" ) ;
                         }
-			if ( $delete ) {
-				delete_message_on_host1( $h1_msg, $h1_fold ) ;
-			}
-			#myprint( "PRESS ENTER" ) and my $a = <> ;
+                        if ( $delete1 ) {
+                                delete_message_on_host1( $h1_msg, $h1_fold ) ;
+                        }
+                        #myprint( "PRESS ENTER" ) and my $a = <> ;
                         return( $new_id ) ;
-		}
-	}
-	else{
-		# NOOP to avoid timeout on large folders.
-		$imap2->noop(  ) ;
-		$nb_msg_skipped_dry_mode += 1 ;
+                }
+        }
+        else{
+                $nb_msg_skipped_dry_mode += 1 ;
                 $h1_nb_msg_processed +=1 ;
-	}
+        }
 
+        return ;
+}
+
+sub tests_sleep_if_needed {
+	note( 'Entering tests_sleep_if_needed()' ) ;
+
+	is( undef, sleep_if_needed(  ), 'sleep_if_needed: no args => undef' ) ;
+	my $mysync ;
+	is( undef, sleep_if_needed( $mysync ), 'sleep_if_needed: arg undef => undef' ) ;
+
+	$mysync->{maxbytespersecond} = 1000 ;
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: maxbytespersecond only => no sleep => 0' ) ;
+	$mysync->{begin_transfer_time} = time ; # now
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: begin_transfer_time now => no sleep => 0' ) ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 0 => no sleep => 0' ) ;
+
+	$mysync->{total_bytes_transferred} = 2200 ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before
+	is( '0.20', sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 2200 since 2s => sleep 0.2s' ) ;
+	is( '0',  sleep_if_needed( $mysync ),   'sleep_if_needed: total_bytes_transferred == 2200 since 2+2 == 4s => no sleep' ) ;
+
+	$mysync->{maxsleep} = 0.1 ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before again
+	is( '0.10', sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 4000 since 2s but maxsleep 0.1s => sleep 0.1s' ) ;
+	
+	$mysync->{maxbytesafter} = 4000 ;
+	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before again
+	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: maxbytesafter == total_bytes_transferred => no sleep => 0' ) ;
+
+	note( 'Leaving  tests_sleep_if_needed()' ) ;
 	return ;
 }
 
+
 sub sleep_if_needed {
-	my( $time_spent, $total_bytes_transferred, $nb_msg_transferred ) = @_ ;
-        my $sleep_max_messages = sleep_max_messages( $nb_msg_transferred, $time_spent, $maxmessagespersecond ) ;
-        my $sleep_max_bytes = sleep_max_bytes( $total_bytes_transferred, $time_spent, $maxbytespersecond  ) ;
-        my $sleep_max = max( $sleep_max_messages, $sleep_max_bytes ) ;
+        my( $mysync ) = shift ;
+
+	if ( ! $mysync ) {
+		return ;
+	}
+	# No need to go further if there is no limit set
+	if (  not ( $mysync->{maxmessagespersecond}
+		or $mysync->{maxbytespersecond} )
+	) {
+		return ;
+	}
+	
+	$mysync->{maxsleep} = defined $mysync->{maxsleep} ? $mysync->{maxsleep} : $MAX_SLEEP ;
+	
+	my $time_spent = timesince( $mysync->{begin_transfer_time} ) ;
+        my $sleep_max_messages = sleep_max_messages( $mysync->{nb_msg_transferred}, $time_spent, $mysync->{maxmessagespersecond} ) ;
+
+	my $maxbytesafter = $mysync->{maxbytesafter} || 0 ;
+	my $total_bytes_transferred = $mysync->{total_bytes_transferred} || 0 ;
+	my $total_bytes_to_consider = $total_bytes_transferred - $maxbytesafter ;
+
+	#myprint( "maxbytesafter:$maxbytesafter\n" ) ;
+	#myprint( "total_bytes_to_consider:$total_bytes_to_consider\n" ) ;
+
+        my $sleep_max_bytes = sleep_max_bytes( $total_bytes_to_consider, $time_spent, $mysync->{maxbytespersecond}  ) ;
+        my $sleep_max = min( $mysync->{maxsleep}, max( $sleep_max_messages, $sleep_max_bytes ) ) ;
+	$sleep_max = mysprintf( "%.2f", $sleep_max ) ; # round with 2 decimals.
         if ( $sleep_max > 0 ) {
-        	myprintf( "sleeping %.2f s\n", $sleep_max ) ;
+                myprint( "sleeping $sleep_max s\n" ) ;
                 sleep $sleep_max ;
+		# Slept
+		return $sleep_max ;
         }
-	return ;
+	# No sleep
+        return 0 ;
 }
 
 sub sleep_max_messages {
-	# how long we have to sleep to go under max_messages_per_second
+        # how long we have to sleep to go under max_messages_per_second
         my( $nb_msg_transferred, $time_spent, $maxmessagespersecond ) = @_ ;
         if ( ( not defined  $maxmessagespersecond  ) or $maxmessagespersecond <= 0 ) { return( 0 ) } ;
         my $sleep = ( $nb_msg_transferred / $maxmessagespersecond ) - $time_spent ;
@@ -5505,417 +6614,454 @@ sub sleep_max_messages {
 
 
 sub tests_sleep_max_messages {
-	ok( 0 == sleep_max_messages( 4, 2, undef ),  'sleep_max_messages: maxmessagespersecond = undef') ;
-	ok( 0 == sleep_max_messages( 4, 2, 0 ),  'sleep_max_messages: maxmessagespersecond = 0') ;
-	ok( 0 == sleep_max_messages( 4, 2, $MINUS_ONE ), 'sleep_max_messages: maxmessagespersecond = -1') ;
-	ok( 0 == sleep_max_messages( 4, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max reached') ;
-	ok( 2 == sleep_max_messages( 8, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max over') ;
-	ok( 0 == sleep_max_messages( 2, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max not reached') ;
-	return ;
+	note( 'Entering tests_sleep_max_messages()' ) ;
+
+        ok( 0 == sleep_max_messages( 4, 2, undef ),  'sleep_max_messages: maxmessagespersecond = undef') ;
+        ok( 0 == sleep_max_messages( 4, 2, 0 ),  'sleep_max_messages: maxmessagespersecond = 0') ;
+        ok( 0 == sleep_max_messages( 4, 2, $MINUS_ONE ), 'sleep_max_messages: maxmessagespersecond = -1') ;
+        ok( 0 == sleep_max_messages( 4, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max reached') ;
+        ok( 2 == sleep_max_messages( 8, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max over') ;
+        ok( 0 == sleep_max_messages( 2, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max not reached') ;
+
+	note( 'Leaving  tests_sleep_max_messages()' ) ;
+        return ;
 }
 
 
 sub sleep_max_bytes {
-	# how long we have to sleep to go under max_bytes_per_second
-        my( $total_bytes_transferred, $time_spent, $maxbytespersecond ) = @_ ;
+        # how long we have to sleep to go under max_bytes_per_second
+        my( $total_bytes_to_consider, $time_spent, $maxbytespersecond ) = @_ ;
+	$total_bytes_to_consider ||= 0 ;
+	$time_spent ||= 0 ;
+
         if ( ( not defined  $maxbytespersecond  ) or $maxbytespersecond <= 0 ) { return( 0 ) } ;
-        my $sleep = ( $total_bytes_transferred / $maxbytespersecond ) - $time_spent ;
+	#myprint( "total_bytes_to_consider:$total_bytes_to_consider\n" ) ;
+        my $sleep = ( $total_bytes_to_consider / $maxbytespersecond ) - $time_spent ;
         # the sleep must be positive
         return( max( 0, $sleep ) ) ;
 }
 
 
 sub tests_sleep_max_bytes {
-	ok( 0 == sleep_max_bytes( 4000, 2, undef ),  'sleep_max_bytes: maxbytespersecond = undef') ;
-	ok( 0 == sleep_max_bytes( 4000, 2, 0 ),  'sleep_max_bytes: maxbytespersecond = 0') ;
-	ok( 0 == sleep_max_bytes( 4000, 2, $MINUS_ONE ), 'sleep_max_bytes: maxbytespersecond = -1') ;
-	ok( 0 == sleep_max_bytes( 4000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max reached') ;
-	ok( 2 == sleep_max_bytes( 8000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max over') ;
-	ok( 0 == sleep_max_bytes( 2000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max not reached') ;
-	return ;
+	note( 'Entering tests_sleep_max_bytes()' ) ;
+
+        ok( 0 == sleep_max_bytes( 4000, 2, undef ),  'sleep_max_bytes: maxbytespersecond == undef => sleep 0' ) ;
+        ok( 0 == sleep_max_bytes( 4000, 2, 0 ),  'sleep_max_bytes: maxbytespersecond = 0 => sleep 0') ;
+        ok( 0 == sleep_max_bytes( 4000, 2, $MINUS_ONE ), 'sleep_max_bytes: maxbytespersecond = -1 => sleep 0') ;
+        ok( 0 == sleep_max_bytes( 4000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max reached sharp => sleep 0') ;
+        ok( 2 == sleep_max_bytes( 8000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max over => sleep a little') ;
+        ok( 0 == sleep_max_bytes( -8000, 2, 2000 ), 'sleep_max_bytes: maxbytespersecond = 2k max not reached => sleep 0') ;
+        ok( 0 == sleep_max_bytes( 2000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max not reached => sleep 0') ;
+        ok( 0 == sleep_max_bytes( -2000, 2, 1000 ), 'sleep_max_bytes: maxbytespersecond = 1k max not reached => sleep 0') ;
+
+	note( 'Leaving  tests_sleep_max_bytes()' ) ;
+        return ;
 }
 
 
 
 
-# 6 GlobVar: $dry_message $dry $imap1 $h1_nb_msg_deleted $expunge $expunge1
+# 6 GlobVar: $sync $imap1 $h1_nb_msg_deleted  $expunge1
 sub delete_message_on_host1  {
-	my( $h1_msg, $h1_fold ) = @_ ;
-	my $expunge_message = q{} ;
-	$expunge_message = 'and expunged' if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ;
-	myprint( "Host1 msg $h1_fold/$h1_msg marked deleted $expunge_message $dry_message\n"  ) ;
-        if ( ! $dry ) {
-        	$imap1->delete_message( $h1_msg ) ;
-        	$h1_nb_msg_deleted += 1 ;
-        	$imap1->expunge(  ) if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ;
+        my( $h1_msg, $h1_fold ) = @_ ;
+        my $expunge_message = q{} ;
+        $expunge_message = 'and expunged' if ( $expungeaftereach and $expunge1 ) ;
+        myprint( "Host1 msg $h1_fold/$h1_msg marked deleted $expunge_message $sync->{dry_message}\n"  ) ;
+        if ( ! $sync->{dry} ) {
+                $imap1->delete_message( $h1_msg ) ;
+                $h1_nb_msg_deleted += 1 ;
+                $imap1->expunge(  ) if ( $expungeaftereach and $expunge1 ) ;
         }
         return ;
 }
 
 
 sub eta {
-	my( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) = @_ ;
-	return( q{} ) if not $foldersizes ;
+        my( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) = @_ ;
+        return( q{} ) if not $foldersizes ;
 
-        my $time_remaining = time_remaining( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) ;
-        my $nb_msg_remaining = $h1_nb_msg_start - $h1_nb_processed ;
+        my $time_remaining = time_remaining( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) ;
+        my $nb_msg_remaining = $my_h1_nb_msg_start - $h1_nb_processed ;
         my $eta_date = localtime( time + $time_remaining ) ;
-        return( mysprintf( 'ETA: %s  %1.0f s  %s/%s msgs left', $eta_date, $time_remaining, $nb_msg_remaining, $h1_nb_msg_start ) ) ;
+        return( mysprintf( 'ETA: %s  %1.0f s  %s/%s msgs left', $eta_date, $time_remaining, $nb_msg_remaining, $my_h1_nb_msg_start ) ) ;
 }
 
 sub time_remaining {
 
-	my( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) = @_ ;
+        my( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) = @_ ;
 
-	my $time_remaining = ( $my_time_spent / $nb_transferred ) * ( $h1_nb_msg_start - $h1_nb_processed ) ;
-	return( $time_remaining ) ;
+        my $time_remaining = ( $my_time_spent / $nb_transferred ) * ( $my_h1_nb_msg_start - $h1_nb_processed ) ;
+        return( $time_remaining ) ;
 }
 
 
 sub tests_time_remaining {
+	note( 'Entering tests_time_remaining()' ) ;
 
-	ok( 1 == time_remaining( 1, 1,  2, 1 ), 'time_remaining: 1, 1, 2, 1 -> 1'  ) ;
-	ok( 1 == time_remaining( 9, 9, 10, 9 ), 'time_remaining: 9, 9, 10, 9 -> 1' ) ;
-	ok( 9 == time_remaining( 1, 1, 10, 1 ), 'time_remaining: 1, 1, 10, 1 -> 1' ) ;
-	return ;
+
+        ok( 1 == time_remaining( 1, 1,  2, 1 ), 'time_remaining: 1, 1, 2, 1 -> 1'  ) ;
+        ok( 1 == time_remaining( 9, 9, 10, 9 ), 'time_remaining: 9, 9, 10, 9 -> 1' ) ;
+        ok( 9 == time_remaining( 1, 1, 10, 1 ), 'time_remaining: 1, 1, 10, 1 -> 1' ) ;
+
+	note( 'Leaving  tests_time_remaining()' ) ;
+        return ;
 }
 
 
 sub cache_map {
-	my ( $cache_files_ref, $h1_msgs_ref, $h2_msgs_ref ) = @_;
-	my ( %map1_2, %map2_1, %done2 ) ;
+        my ( $cache_files_ref, $h1_msgs_ref, $h2_msgs_ref ) = @_;
+        my ( %map1_2, %map2_1, %done2 ) ;
 
-	my $h1_msgs_hash_ref = {  } ;
-	my $h2_msgs_hash_ref = {  } ;
+        my $h1_msgs_hash_ref = {  } ;
+        my $h2_msgs_hash_ref = {  } ;
 
-	@{ $h1_msgs_hash_ref }{ @{ $h1_msgs_ref } } = (  ) ;
-	@{ $h2_msgs_hash_ref }{ @{ $h2_msgs_ref } } = (  ) ;
+        @{ $h1_msgs_hash_ref }{ @{ $h1_msgs_ref } } = (  ) ;
+        @{ $h2_msgs_hash_ref }{ @{ $h2_msgs_ref } } = (  ) ;
 
-	foreach my $file ( sort @{ $cache_files_ref } ) {
-		$debugcache and myprint( "C12: $file\n"  ) ;
-		( $uid1, $uid2 ) = match_a_cache_file( $file ) ;
+        foreach my $file ( sort @{ $cache_files_ref } ) {
+                $debugcache and myprint( "C12: $file\n"  ) ;
+                ( $uid1, $uid2 ) = match_a_cache_file( $file ) ;
 
-		if (  exists( $h1_msgs_hash_ref->{ defined  $uid1  ? $uid1 : q{} } )
-		  and exists( $h2_msgs_hash_ref->{ defined  $uid2  ? $uid2 : q{} } ) ) {
-		  	# keep only the greatest uid2
-			# 130_2301 and
-			# 130_231  => keep only 130 -> 2301
+                if (  exists( $h1_msgs_hash_ref->{ defined  $uid1  ? $uid1 : q{} } )
+                  and exists( $h2_msgs_hash_ref->{ defined  $uid2  ? $uid2 : q{} } ) ) {
+                        # keep only the greatest uid2
+                        # 130_2301 and
+                        # 130_231  => keep only 130 -> 2301
 
-			# keep only the greatest uid1
-			# 1601_260 and
-			#  161_260 => keep only 1601 -> 260
-		  	my $max_uid2 = max( $uid2, $map1_2{ $uid1 } || $MINUS_ONE ) ;
-			if ( exists $done2{ $max_uid2 } ) {
-				if ( $done2{ $max_uid2 } < $uid1 )  {
-					$map1_2{ $uid1 } = $max_uid2 ;
-					delete $map1_2{ $done2{ $max_uid2 } } ;
-					$done2{ $max_uid2 } = $uid1 ;
-				}
-			}else{
-				$map1_2{ $uid1 } = $max_uid2 ;
-				$done2{ $max_uid2 } = $uid1 ;
-			}
-		};
+                        # keep only the greatest uid1
+                        # 1601_260 and
+                        #  161_260 => keep only 1601 -> 260
+                        my $max_uid2 = max( $uid2, $map1_2{ $uid1 } || $MINUS_ONE ) ;
+                        if ( exists $done2{ $max_uid2 } ) {
+                                if ( $done2{ $max_uid2 } < $uid1 )  {
+                                        $map1_2{ $uid1 } = $max_uid2 ;
+                                        delete $map1_2{ $done2{ $max_uid2 } } ;
+                                        $done2{ $max_uid2 } = $uid1 ;
+                                }
+                        }else{
+                                $map1_2{ $uid1 } = $max_uid2 ;
+                                $done2{ $max_uid2 } = $uid1 ;
+                        }
+                };
 
-	}
-	%map2_1 = reverse %map1_2 ;
-	return( \%map1_2, \%map2_1) ;
+        }
+        %map2_1 = reverse %map1_2 ;
+        return( \%map1_2, \%map2_1) ;
 }
 
 sub tests_cache_map {
-	#$debugcache = 1 ;
-	my @cache_files = qw (
-	100_200
-	101_201
-	120_220
-	142_242
-	143_243
-	177_277
-	177_278
-	177_279
-	155_255
-	180_280
-	181_280
-	182_280
-	130_231
-	130_2301
-	161_260
-	1601_260
-	) ;
+	note( 'Entering tests_cache_map()' ) ;
 
-	my $msgs_1 = [120, 142, 143, 144, 161, 1601,           177,      182, 130 ];
-	my $msgs_2 = [     242, 243,       260,      299, 377, 279, 255, 280, 231, 2301 ];
+        #$debugcache = 1 ;
+        my @cache_files = qw (
+        100_200
+        101_201
+        120_220
+        142_242
+        143_243
+        177_277
+        177_278
+        177_279
+        155_255
+        180_280
+        181_280
+        182_280
+        130_231
+        130_2301
+        161_260
+        1601_260
+        ) ;
 
-	my( $c12, $c21 ) ;
-	ok( ( $c12, $c21 ) = cache_map( \@cache_files, $msgs_1, $msgs_2 ), 'cache_map: 02' );
-	my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
-	my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
-	ok( 0 == compare_lists( [ 130, 142, 143,      177, 182, 1601      ], $a1 ), 'cache_map: 03' );
-	ok( 0 == compare_lists( [      242, 243, 260, 279, 280,      2301 ], $a2 ), 'cache_map: 04' );
-	ok( ! $c12->{161},        'cache_map: ! 161 ->  260' );
-	ok( 260  == $c12->{1601}, 'cache_map:  1601 ->  260' );
-	ok( 2301 == $c12->{130},  'cache_map:   130 -> 2301' );
-	#myprint( $c12->{1601}, "\n" ) ;
-	return ;
+        my $msgs_1 = [120, 142, 143, 144, 161, 1601,           177,      182, 130 ];
+        my $msgs_2 = [     242, 243,       260,      299, 377, 279, 255, 280, 231, 2301 ];
+
+        my( $c12, $c21 ) ;
+        ok( ( $c12, $c21 ) = cache_map( \@cache_files, $msgs_1, $msgs_2 ), 'cache_map: 02' );
+        my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
+        my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
+        ok( 0 == compare_lists( [ 130, 142, 143,      177, 182, 1601      ], $a1 ), 'cache_map: 03' );
+        ok( 0 == compare_lists( [      242, 243, 260, 279, 280,      2301 ], $a2 ), 'cache_map: 04' );
+        ok( ! $c12->{161},        'cache_map: ! 161 ->  260' );
+        ok( 260  == $c12->{1601}, 'cache_map:  1601 ->  260' );
+        ok( 2301 == $c12->{130},  'cache_map:   130 -> 2301' );
+        #myprint( $c12->{1601}, "\n" ) ;
+
+	note( 'Leaving  tests_cache_map()' ) ;
+        return ;
 
 }
 
 sub cache_dir_fix {
-	my $cache_dir = shift ;
+        my $cache_dir = shift ;
         $cache_dir =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'"\\])/\\$1/xg ;
         #myprint( "cache_dir_fix: $cache_dir\n"  ) ;
-	return( $cache_dir ) ;
+        return( $cache_dir ) ;
 }
 
 sub tests_cache_dir_fix {
-	ok( 'lalala' eq  cache_dir_fix('lalala'),  'cache_dir_fix: lalala -> lalala' );
-	ok( 'ii\\\\ii' eq  cache_dir_fix('ii\ii'), 'cache_dir_fix: ii\ii -> ii\\\\ii' );
-	ok( 'ii@ii' eq  cache_dir_fix('ii@ii'),  'cache_dir_fix: ii@ii -> ii@ii' );
-	ok( 'ii@ii\\:ii' eq  cache_dir_fix('ii@ii:ii'), 'cache_dir_fix: ii@ii:ii -> ii@ii\\:ii' );
-	ok( 'i\\\\i\\\\ii' eq  cache_dir_fix('i\i\ii'), 'cache_dir_fix: i\i\ii -> i\\\\i\\\\ii' );
-	ok( 'i\\\\ii' eq  cache_dir_fix('i\\ii'), 'cache_dir_fix: i\\ii -> i\\\\\\\\ii' );
-	ok( '\\\\ ' eq  cache_dir_fix('\\ '), 'cache_dir_fix: \\  -> \\\\\ ' );
-	ok( '\\\\ ' eq  cache_dir_fix('\ '), 'cache_dir_fix: \  -> \\\\\ ' );
-	ok( '\[bracket\]' eq  cache_dir_fix('[bracket]'), 'cache_dir_fix: [bracket] -> \[bracket\]' );
-	return ;
+	note( 'Entering tests_cache_dir_fix()' ) ;
+
+        ok( 'lalala' eq  cache_dir_fix('lalala'),  'cache_dir_fix: lalala -> lalala' );
+        ok( 'ii\\\\ii' eq  cache_dir_fix('ii\ii'), 'cache_dir_fix: ii\ii -> ii\\\\ii' );
+        ok( 'ii@ii' eq  cache_dir_fix('ii@ii'),  'cache_dir_fix: ii@ii -> ii@ii' );
+        ok( 'ii@ii\\:ii' eq  cache_dir_fix('ii@ii:ii'), 'cache_dir_fix: ii@ii:ii -> ii@ii\\:ii' );
+        ok( 'i\\\\i\\\\ii' eq  cache_dir_fix('i\i\ii'), 'cache_dir_fix: i\i\ii -> i\\\\i\\\\ii' );
+        ok( 'i\\\\ii' eq  cache_dir_fix('i\\ii'), 'cache_dir_fix: i\\ii -> i\\\\\\\\ii' );
+        ok( '\\\\ ' eq  cache_dir_fix('\\ '), 'cache_dir_fix: \\  -> \\\\\ ' );
+        ok( '\\\\ ' eq  cache_dir_fix('\ '), 'cache_dir_fix: \  -> \\\\\ ' );
+        ok( '\[bracket\]' eq  cache_dir_fix('[bracket]'), 'cache_dir_fix: [bracket] -> \[bracket\]' );
+
+	note( 'Leaving  tests_cache_dir_fix()' ) ;
+        return ;
 }
 
 sub cache_dir_fix_win {
-	my $cache_dir = shift ;
+        my $cache_dir = shift ;
         $cache_dir =~ s/(\[|\])/[$1]/xg ;
         #myprint( "cache_dir_fix_win: $cache_dir\n"  ) ;
-	return( $cache_dir ) ;
+        return( $cache_dir ) ;
 }
 
 sub tests_cache_dir_fix_win {
-	ok( 'lalala' eq  cache_dir_fix_win('lalala'),  'cache_dir_fix_win: lalala -> lalala' );
-	ok( '[[]bracket[]]' eq  cache_dir_fix_win('[bracket]'), 'cache_dir_fix_win: [bracket] -> [[]bracket[]]' );
-	return ;
+	note( 'Entering tests_cache_dir_fix_win()' ) ;
+
+        ok( 'lalala' eq  cache_dir_fix_win('lalala'),  'cache_dir_fix_win: lalala -> lalala' );
+        ok( '[[]bracket[]]' eq  cache_dir_fix_win('[bracket]'), 'cache_dir_fix_win: [bracket] -> [[]bracket[]]' );
+
+	note( 'Leaving  tests_cache_dir_fix_win()' ) ;
+        return ;
 }
 
 
 
 
 sub get_cache {
-	my ( $cache_dir, $h1_msgs_ref, $h2_msgs_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) = @_;
+        my ( $cache_dir, $h1_msgs_ref, $h2_msgs_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) = @_;
 
-	$debugcache and myprint( "Entering get_cache\n" ) ;
+        $debugcache and myprint( "Entering get_cache\n" ) ;
 
-	-d $cache_dir or return( undef ); # exit if cache directory doesn't exist
-	$debugcache and myprint( "cache_dir    : $cache_dir\n" ) ;
+        -d $cache_dir or return( undef ); # exit if cache directory doesn't exist
+        $debugcache and myprint( "cache_dir    : $cache_dir\n" ) ;
 
 
         if ( 'MSWin32' ne $OSNAME ) {
-        	$cache_dir = cache_dir_fix( $cache_dir ) ;
+                $cache_dir = cache_dir_fix( $cache_dir ) ;
         }else{
-        	$cache_dir = cache_dir_fix_win( $cache_dir ) ;
+                $cache_dir = cache_dir_fix_win( $cache_dir ) ;
         }
 
-	$debugcache and myprint( "cache_dir_fix: $cache_dir\n"  ) ;
+        $debugcache and myprint( "cache_dir_fix: $cache_dir\n"  ) ;
 
-	my @cache_files = bsd_glob( "$cache_dir/*" ) ;
-	#$debugcache and myprint( "cache_files: [@cache_files]\n"  ) ;
+        my @cache_files = bsd_glob( "$cache_dir/*" ) ;
+        #$debugcache and myprint( "cache_files: [@cache_files]\n"  ) ;
 
-	$debugcache and myprint( 'cache_files: ', scalar  @cache_files , " files found\n" ) ;
+        $debugcache and myprint( 'cache_files: ', scalar  @cache_files , " files found\n" ) ;
 
-	my( $cache_1_2_ref, $cache_2_1_ref )
-	  = cache_map( \@cache_files, $h1_msgs_ref, $h2_msgs_ref ) ;
+        my( $cache_1_2_ref, $cache_2_1_ref )
+          = cache_map( \@cache_files, $h1_msgs_ref, $h2_msgs_ref ) ;
 
-	clean_cache( \@cache_files, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
+        clean_cache( \@cache_files, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
 
-	$debugcache and myprint( "Exiting get_cache\n" ) ;
-	return( $cache_1_2_ref, $cache_2_1_ref ) ;
+        $debugcache and myprint( "Exiting get_cache\n" ) ;
+        return( $cache_1_2_ref, $cache_2_1_ref ) ;
 }
 
 
 sub tests_get_cache {
+	note( 'Entering tests_get_cache()' ) ;
 
-	ok( not( get_cache('/cache_no_exist') ), 'get_cache: /cache_no_exist' );
-	ok( ( not -d 'W/tmp/cache/F1/F2' or rmtree( 'W/tmp/cache/F1/F2' )), 'get_cache: rmtree W/tmp/cache/F1/F2' ) ;
-	ok( mkpath( 'W/tmp/cache/F1/F2' ), 'get_cache: mkpath W/tmp/cache/F1/F2' ) ;
+        ok( not( get_cache('/cache_no_exist') ), 'get_cache: /cache_no_exist' );
+        ok( ( not -d 'W/tmp/cache/F1/F2' or rmtree( 'W/tmp/cache/F1/F2' ) ), 'get_cache: rmtree W/tmp/cache/F1/F2' ) ;
+        ok( mkpath( 'W/tmp/cache/F1/F2' ), 'get_cache: mkpath W/tmp/cache/F1/F2' ) ;
 
-	my @test_files_cache = ( qw(
-	W/tmp/cache/F1/F2/100_200
-	W/tmp/cache/F1/F2/101_201
-	W/tmp/cache/F1/F2/120_220
-	W/tmp/cache/F1/F2/142_242
-	W/tmp/cache/F1/F2/143_243
-	W/tmp/cache/F1/F2/177_277
-	W/tmp/cache/F1/F2/177_377
-	W/tmp/cache/F1/F2/177_777
-	W/tmp/cache/F1/F2/155_255
-	) ) ;
-	ok( touch( @test_files_cache ), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
+        my @test_files_cache = ( qw(
+        W/tmp/cache/F1/F2/100_200
+        W/tmp/cache/F1/F2/101_201
+        W/tmp/cache/F1/F2/120_220
+        W/tmp/cache/F1/F2/142_242
+        W/tmp/cache/F1/F2/143_243
+        W/tmp/cache/F1/F2/177_277
+        W/tmp/cache/F1/F2/177_377
+        W/tmp/cache/F1/F2/177_777
+        W/tmp/cache/F1/F2/155_255
+        ) ) ;
+        ok( touch( @test_files_cache ), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
 
 
-	# on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
-	# on live:
-	my $msgs_1 = [120, 142, 143, 144,          177      ];
-	my $msgs_2 = [     242, 243,     299, 377, 777, 255 ];
+        # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
+        # on live:
+        my $msgs_1 = [120, 142, 143, 144,          177      ];
+        my $msgs_2 = [     242, 243,     299, 377, 777, 255 ];
 
         my $msgs_all_1 = { 120 => 0, 142 => 0, 143 => 0, 144 => 0, 177 => 0 } ;
         my $msgs_all_2 = { 242 => 0, 243 => 0, 299 => 0, 377 => 0, 777 => 0, 255 => 0 } ;
 
-	my( $c12, $c21 ) ;
-	ok( ( $c12, $c21 ) = get_cache( 'W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
-	my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
-	my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
-	ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' );
-	ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' );
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
-	ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200');
-	ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201');
+        my( $c12, $c21 ) ;
+        ok( ( $c12, $c21 ) = get_cache( 'W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
+        my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
+        my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
+        ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' );
+        ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' );
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
+        ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200');
+        ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201');
 
-	# test clean_cache executed
-	$maxage = 2 ;
-	ok( touch(@test_files_cache), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
-	ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
-	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
-	ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200');
-	ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201');
+        # test clean_cache executed
+        $maxage = 2 ;
+        ok( touch(@test_files_cache), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
+        ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
+        ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
+        ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200');
+        ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201');
 
 
-	# strange files
-	#$debugcache = 1 ;
-	$maxage = undef ;
-	ok( ( not -d 'W/tmp/cache/rr\uee' or rmtree( 'W/tmp/cache/rr\uee' )), 'get_cache: rmtree W/tmp/cache/rr\uee' ) ;
-	ok( mkpath( 'W/tmp/cache/rr\uee' ), 'get_cache: mkpath W/tmp/cache/rr\uee' ) ;
+        # strange files
+        #$debugcache = 1 ;
+        $maxage = undef ;
+        ok( ( not -d 'W/tmp/cache/rr\uee' or rmtree( 'W/tmp/cache/rr\uee' )), 'get_cache: rmtree W/tmp/cache/rr\uee' ) ;
+        ok( mkpath( 'W/tmp/cache/rr\uee' ), 'get_cache: mkpath W/tmp/cache/rr\uee' ) ;
 
-	@test_files_cache = ( qw(
-	W/tmp/cache/rr\uee/100_200
-	W/tmp/cache/rr\uee/101_201
-	W/tmp/cache/rr\uee/120_220
-	W/tmp/cache/rr\uee/142_242
-	W/tmp/cache/rr\uee/143_243
-	W/tmp/cache/rr\uee/177_277
-	W/tmp/cache/rr\uee/177_377
-	W/tmp/cache/rr\uee/177_777
-	W/tmp/cache/rr\uee/155_255
-	) ) ;
-	ok( touch(@test_files_cache), 'get_cache: touch strange W/tmp/cache/...' ) ;
+        @test_files_cache = ( qw(
+        W/tmp/cache/rr\uee/100_200
+        W/tmp/cache/rr\uee/101_201
+        W/tmp/cache/rr\uee/120_220
+        W/tmp/cache/rr\uee/142_242
+        W/tmp/cache/rr\uee/143_243
+        W/tmp/cache/rr\uee/177_277
+        W/tmp/cache/rr\uee/177_377
+        W/tmp/cache/rr\uee/177_777
+        W/tmp/cache/rr\uee/155_255
+        ) ) ;
+        ok( touch(@test_files_cache), 'get_cache: touch strange W/tmp/cache/...' ) ;
 
-	# on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
-	# on live:
-	$msgs_1 = [120, 142, 143, 144,          177      ] ;
-	$msgs_2 = [     242, 243,     299, 377, 777, 255 ] ;
+        # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
+        # on live:
+        $msgs_1 = [120, 142, 143, 144,          177      ] ;
+        $msgs_2 = [     242, 243,     299, 377, 777, 255 ] ;
 
         $msgs_all_1 = { 120 => q{}, 142 => q{}, 143 => q{}, 144 => q{}, 177 => q{} } ;
         $msgs_all_2 = { 242 => q{}, 243 => q{}, 299 => q{}, 377 => q{}, 777 => q{}, 255 => q{} } ;
 
-	ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/rr\uee', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2), 'get_cache: strange path 02' );
-	$a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
-	$a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
-	ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: strange path 03' );
-	ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: strange path 04' );
-	ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 142_242');
-	ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 143_243');
-	ok( ! -f 'W/tmp/cache/rr\uee/100_200', 'get_cache: strange path file removed 100_200');
-	ok( ! -f 'W/tmp/cache/rr\uee/101_201', 'get_cache: strange path file removed 101_201');
-	return ;
+        ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/rr\uee', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2), 'get_cache: strange path 02' );
+        $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ;
+        $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ;
+        ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: strange path 03' );
+        ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: strange path 04' );
+        ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 142_242');
+        ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 143_243');
+        ok( ! -f 'W/tmp/cache/rr\uee/100_200', 'get_cache: strange path file removed 100_200');
+        ok( ! -f 'W/tmp/cache/rr\uee/101_201', 'get_cache: strange path file removed 101_201');
+
+	note( 'Leaving  tests_get_cache()' ) ;
+        return ;
 }
 
 sub match_a_cache_file {
-	my $file = shift ;
-	my ( $cache_uid1, $cache_uid2 ) ;
+        my $file = shift ;
+        my ( $cache_uid1, $cache_uid2 ) ;
 
-	return( ( undef, undef ) ) if ( ! $file ) ;
-	if ( $file =~ m{(?:^|/)(\d+)_(\d+)$}x ) {
-		$cache_uid1 = $1 ;
-		$cache_uid2 = $2 ;
-	}
-	return( $cache_uid1, $cache_uid2 ) ;
+        return( ( undef, undef ) ) if ( ! $file ) ;
+        if ( $file =~ m{(?:^|/)(\d+)_(\d+)$}x ) {
+                $cache_uid1 = $1 ;
+                $cache_uid2 = $2 ;
+        }
+        return( $cache_uid1, $cache_uid2 ) ;
 }
 
 sub tests_match_a_cache_file {
-	my ( $tuid1, $tuid2 ) ;
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file(  ), 'match_a_cache_file: no arg' ) ;
-	ok( ! defined  $tuid1 , 'match_a_cache_file: no arg 1' ) ;
-	ok( ! defined  $tuid2 , 'match_a_cache_file: no arg 2' ) ;
+	note( 'Entering tests_match_a_cache_file()' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( q{} ), 'match_a_cache_file: empty arg' ) ;
-	ok( ! defined  $tuid1 , 'match_a_cache_file: empty arg 1' ) ;
-	ok( ! defined  $tuid2 , 'match_a_cache_file: empty arg 2' ) ;
+        my ( $tuid1, $tuid2 ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file(  ), 'match_a_cache_file: no arg' ) ;
+        ok( ! defined  $tuid1 , 'match_a_cache_file: no arg 1' ) ;
+        ok( ! defined  $tuid2 , 'match_a_cache_file: no arg 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '000_000' ), 'match_a_cache_file: 000_000' ) ;
-	ok( '000' eq $tuid1, 'match_a_cache_file: 000_000 1' ) ;
-	ok( '000' eq $tuid2, 'match_a_cache_file: 000_000 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( q{} ), 'match_a_cache_file: empty arg' ) ;
+        ok( ! defined  $tuid1 , 'match_a_cache_file: empty arg 1' ) ;
+        ok( ! defined  $tuid2 , 'match_a_cache_file: empty arg 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ;
-	ok( '123' eq $tuid1, 'match_a_cache_file: 123_456 1' ) ;
-	ok( '456' eq $tuid2, 'match_a_cache_file: 123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '000_000' ), 'match_a_cache_file: 000_000' ) ;
+        ok( '000' eq $tuid1, 'match_a_cache_file: 000_000 1' ) ;
+        ok( '000' eq $tuid2, 'match_a_cache_file: 000_000 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ;
-	ok( '123' eq $tuid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ;
-	ok( '456' eq $tuid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ;
+        ok( '123' eq $tuid1, 'match_a_cache_file: 123_456 1' ) ;
+        ok( '456' eq $tuid2, 'match_a_cache_file: 123_456 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ;
-	ok( ! $tuid1, 'match_a_cache_file: /lala123_456 1' ) ;
-	ok( ! $tuid2, 'match_a_cache_file: /lala123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ;
+        ok( '123' eq $tuid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ;
+        ok( '456' eq $tuid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ;
 
-	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( 'la123_456' ), 'match_a_cache_file: NO la123_456' ) ;
-	ok( ! $tuid1, 'match_a_cache_file: la123_456 1' ) ;
-	ok( ! $tuid2, 'match_a_cache_file: la123_456 2' ) ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ;
+        ok( ! $tuid1, 'match_a_cache_file: /lala123_456 1' ) ;
+        ok( ! $tuid2, 'match_a_cache_file: /lala123_456 2' ) ;
 
-	return ;
+        ok( ( $tuid1, $tuid2 ) = match_a_cache_file( 'la123_456' ), 'match_a_cache_file: NO la123_456' ) ;
+        ok( ! $tuid1, 'match_a_cache_file: la123_456 1' ) ;
+        ok( ! $tuid2, 'match_a_cache_file: la123_456 2' ) ;
+
+	note( 'Leaving  tests_match_a_cache_file()' ) ;
+        return ;
 }
 
 sub clean_cache {
-	my ( $cache_files_ref, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref )  = @_ ;
+        my ( $cache_files_ref, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref )  = @_ ;
 
-	$debugcache and myprint( "Entering clean_cache\n" ) ;
+        $debugcache and myprint( "Entering clean_cache\n" ) ;
 
-	$debugcache and myprint( map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %{ $cache_1_2_ref }  ) ;
-	foreach my $file ( @{ $cache_files_ref } ) {
-		$debugcache and myprint( "$file\n"  ) ;
-		my ( $cache_uid1, $cache_uid2 ) = match_a_cache_file( $file ) ;
-		$debugcache and myprint( "u1: $cache_uid1 u2: $cache_uid2 c12: ", $cache_1_2_ref->{ $cache_uid1 } || q{}, "\n") ;
-#		  or ( ! exists( $cache_1_2_ref->{ $cache_uid1 } ) )
-#		  or ( ! ( $cache_uid2 == $cache_1_2_ref->{ $cache_uid1 } ) )
-		if ( ( not defined  $cache_uid1  )
-		  or ( not defined  $cache_uid2  )
+        $debugcache and myprint( map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %{ $cache_1_2_ref }  ) ;
+        foreach my $file ( @{ $cache_files_ref } ) {
+                $debugcache and myprint( "$file\n"  ) ;
+                my ( $cache_uid1, $cache_uid2 ) = match_a_cache_file( $file ) ;
+                $debugcache and myprint( "u1: $cache_uid1 u2: $cache_uid2 c12: ", $cache_1_2_ref->{ $cache_uid1 } || q{}, "\n") ;
+#                 or ( ! exists( $cache_1_2_ref->{ $cache_uid1 } ) )
+#                 or ( ! ( $cache_uid2 == $cache_1_2_ref->{ $cache_uid1 } ) )
+                if ( ( not defined  $cache_uid1  )
+                  or ( not defined  $cache_uid2  )
                   or ( not exists  $h1_msgs_all_hash_ref->{ $cache_uid1 }  )
                   or ( not exists  $h2_msgs_all_hash_ref->{ $cache_uid2 }  )
                 ) {
-			$debugcache and myprint( "remove $file\n"  ) ;
-			unlink $file or myprint( "$!"  ) ;
-		}
-	}
+                        $debugcache and myprint( "remove $file\n"  ) ;
+                        unlink $file or myprint( "$OS_ERROR"  ) ;
+                }
+        }
 
-	$debugcache and myprint( "Exiting clean_cache\n" ) ;
-	return( 1 ) ;
+        $debugcache and myprint( "Exiting clean_cache\n" ) ;
+        return( 1 ) ;
 }
 
 sub tests_clean_cache {
+	note( 'Entering tests_clean_cache()' ) ;
 
-	ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache: rmtree W/tmp/cache/G1/G2' ) ;
-	ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache: mkpath W/tmp/cache/G1/G2' ) ;
+        ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache: rmtree W/tmp/cache/G1/G2' ) ;
+        ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache: mkpath W/tmp/cache/G1/G2' ) ;
 
-	my @test_files_cache = ( qw(
-	W/tmp/cache/G1/G2/100_200
-	W/tmp/cache/G1/G2/101_201
-	W/tmp/cache/G1/G2/120_220
-	W/tmp/cache/G1/G2/142_242
-	W/tmp/cache/G1/G2/143_243
-	W/tmp/cache/G1/G2/177_277
-	W/tmp/cache/G1/G2/177_377
-	W/tmp/cache/G1/G2/177_777
-	W/tmp/cache/G1/G2/155_255
-	) ) ;
-	ok( touch(@test_files_cache), 'clean_cache: touch W/tmp/cache/G1/G2/...' ) ;
+        my @test_files_cache = ( qw(
+        W/tmp/cache/G1/G2/100_200
+        W/tmp/cache/G1/G2/101_201
+        W/tmp/cache/G1/G2/120_220
+        W/tmp/cache/G1/G2/142_242
+        W/tmp/cache/G1/G2/143_243
+        W/tmp/cache/G1/G2/177_277
+        W/tmp/cache/G1/G2/177_377
+        W/tmp/cache/G1/G2/177_777
+        W/tmp/cache/G1/G2/155_255
+        ) ) ;
+        ok( touch(@test_files_cache), 'clean_cache: touch W/tmp/cache/G1/G2/...' ) ;
 
-	ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' );
-	ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' );
-	ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' );
+        ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' );
+        ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' );
+        ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' );
 
-	my $cache = {
-		142 => 242,
-		177 => 777,
-	} ;
+        my $cache = {
+                142 => 242,
+                177 => 777,
+        } ;
 
         my $all_1 = {
                 142 => q{},
@@ -5927,46 +7073,49 @@ sub tests_clean_cache {
                 242 => q{},
                 777 => q{},
         } ;
-	ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache: ' ) ;
+        ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache: ' ) ;
 
-	ok( ! -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' );
-	return ;
+        ok( ! -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' );
+
+	note( 'Leaving  tests_clean_cache()' ) ;
+        return ;
 }
 
 sub tests_clean_cache_2 {
+	note( 'Entering tests_clean_cache_2()' ) ;
 
-	ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache_2: rmtree W/tmp/cache/G1/G2' ) ;
-	ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache_2: mkpath W/tmp/cache/G1/G2' ) ;
+        ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache_2: rmtree W/tmp/cache/G1/G2' ) ;
+        ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache_2: mkpath W/tmp/cache/G1/G2' ) ;
 
-	my @test_files_cache = ( qw(
-	W/tmp/cache/G1/G2/100_200
-	W/tmp/cache/G1/G2/101_201
-	W/tmp/cache/G1/G2/120_220
-	W/tmp/cache/G1/G2/142_242
-	W/tmp/cache/G1/G2/143_243
-	W/tmp/cache/G1/G2/177_277
-	W/tmp/cache/G1/G2/177_377
-	W/tmp/cache/G1/G2/177_777
-	W/tmp/cache/G1/G2/155_255
-	) ) ;
-	ok( touch(@test_files_cache), 'clean_cache_2: touch W/tmp/cache/G1/G2/...' ) ;
+        my @test_files_cache = ( qw(
+        W/tmp/cache/G1/G2/100_200
+        W/tmp/cache/G1/G2/101_201
+        W/tmp/cache/G1/G2/120_220
+        W/tmp/cache/G1/G2/142_242
+        W/tmp/cache/G1/G2/143_243
+        W/tmp/cache/G1/G2/177_277
+        W/tmp/cache/G1/G2/177_377
+        W/tmp/cache/G1/G2/177_777
+        W/tmp/cache/G1/G2/155_255
+        ) ) ;
+        ok( touch(@test_files_cache), 'clean_cache_2: touch W/tmp/cache/G1/G2/...' ) ;
 
-	ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 before' );
-	ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 before' );
-	ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 before' );
-	ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 before' );
+        ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 before' );
+        ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 before' );
+        ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 before' );
+        ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 before' );
 
-	my $cache = {
-		142 => 242,
-		177 => 777,
-	} ;
+        my $cache = {
+                142 => 242,
+                177 => 777,
+        } ;
 
         my $all_1 = {
                 $NUMBER_100 => q{},
@@ -5982,105 +7131,131 @@ sub tests_clean_cache_2 {
 
 
 
-	ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache_2: ' ) ;
+        ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache_2: ' ) ;
 
-	ok(   -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 after' );
-	ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 after' );
-	ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 after' );
-	return ;
+        ok(   -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 after' );
+        ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 after' );
+        ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 after' );
+
+	note( 'Leaving  tests_clean_cache_2()' ) ;
+        return ;
 }
 
 
 
 sub tests_mkpath {
+	note( 'Entering tests_mkpath()' ) ;
 
-	ok( 1 == 1, 'tests_mkpath: 1 == 1' ) ;
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'mkpath: mkpath W/tmp/tests/' ) ;
+	
+        SKIP: {
+                skip( 'Tests only for Unix', 10   ) if ( 'MSWin32' eq $OSNAME ) ;
+                my $long_path_unix = '123456789/' x 30 ;
+                ok( ( -d "W/tmp/tests/long/$long_path_unix" or  mkpath( "W/tmp/tests/long/$long_path_unix" ) ), 'mkpath: mkpath 300 char' ) ;
+		ok( -d "W/tmp/tests/long/$long_path_unix", 'mkpath: mkpath > 300 char verified' ) ;
+                ok( ( -d "W/tmp/tests/long/$long_path_unix" and rmtree( 'W/tmp/tests/long/' ) ), 'mkpath: rmtree 300 char' ) ;
+		ok( ! -d "W/tmp/tests/long/$long_path_unix", 'mkpath: rmtree 300 char verified' ) ;
+		
+		ok( ( -d 'W/tmp/tests/trailing_dots...' or  mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ;
+		ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ;
+		ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ;
+		ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ;
 
-	SKIP: {
-		skip( 'Tests only for Unix', 2   ) if ( 'MSWin32' eq $OSNAME ) ;
-		my $long_path_unix = '123456789/' x 30 ;
-		ok( (-d "W/tmp/tests/long/$long_path_unix" or  mkpath( "W/tmp/tests/long/$long_path_unix" ) ), 'tests_mkpath: mkpath > 300 char' ) ;
-		ok( (-d "W/tmp/tests/long/$long_path_unix" and rmtree( 'W/tmp/tests/long/' ) ), 'tests_mkpath: rmtree > 300 char' ) ;
+		eval { ok( 1 / 0, 'mkpath: divide by 0' ) ; } or ok( 1, 'mkpath: can not divide by 0' ) ;
+		ok( 1, 'mkpath: still alive' ) ;
         } ;
 
-	SKIP: {
-		skip( 'Tests only for MSWin32', 6  ) if ( 'MSWin32' ne $OSNAME ) ;
-		my $long_path_2_prefix =  "$tmpdir\\imapsync_tests" || '\\\?\\E:\\TEMP\\imapsync_tests'  ;
-		myprint( "long_path_2_prefix: $long_path_2_prefix\n"  ) ;
+        SKIP: {
+                skip( 'Tests only for MSWin32', 13  ) if ( 'MSWin32' ne $OSNAME ) ;
+                my $long_path_2_prefix =  "$tmpdir\\imapsync_tests" || '\\\?\\E:\\TEMP\\imapsync_tests'  ;
+                myprint( "long_path_2_prefix: $long_path_2_prefix\n"  ) ;
 
-		my $long_path_2   = $long_path_2_prefix . '\\' . '123456789\\' x 10 . 'END' ;
-		my $long_path_300 = $long_path_2_prefix . '\\' . '123456789\\' x 30 . 'END' ;
+                my $long_path_100   = $long_path_2_prefix . '\\' . '123456789\\' x 10 . 'END' ;
+                my $long_path_300 = $long_path_2_prefix . '\\' . '123456789\\' x 30 . 'END' ;
 
-		myprint( "$long_path_2\n"  ) ;
+                #myprint( "$long_path_100\n"  ) ;
 
-		#ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'tests_mkpath: rmtree > 200 char' ) ;
-		#ok( ( -d $long_path_2_prefix or mkpath( "\\\\\?\\E:\\\\TEMP\\imapsync_tests" ) ), 'tests_mkpath: -d  small path 1' ) ;
+                ok( ( -d $long_path_2_prefix or mkpath( $long_path_2_prefix ) ), 'mkpath: -d mkpath small path' ) ;
+                ok( ( -d $long_path_2_prefix ), 'mkpath: -d mkpath small path done' ) ;
+                ok( ( -d $long_path_100        or mkpath( $long_path_100 ) ),        'mkpath: mkpath > 100 char' ) ;
+                ok( ( -d $long_path_100 ), 'mkpath: -d mkpath > 200 char done' ) ;
+                ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'mkpath: rmtree > 100 char' ) ;
+                ok( (! -d $long_path_2_prefix ), 'mkpath: ! -d rmtree done' ) ;
 
-		ok( ( -d $long_path_2_prefix or mkpath( $long_path_2_prefix ) ), 'tests_mkpath: -d mkpath small path' ) ;
-		ok( ( -d $long_path_2_prefix ), 'tests_mkpath: -d mkpath small path done' ) ;
-		ok( ( -d $long_path_2        or mkpath( $long_path_2 ) ),        'tests_mkpath: mkpath > 200 char' ) ;
-		ok( ( -d $long_path_2 ), 'tests_mkpath: -d mkpath > 200 char done' ) ;
-		ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'tests_mkpath: rmtree > 200 char' ) ;
-		ok( (! -d $long_path_2_prefix ), 'tests_mkpath: ! -d rmtree done' ) ;
+                # Without the eval the following mkpath 300 just kill the whole process without a whisper
+                #myprint( "$long_path_300\n"  ) ;
+                eval { ok( ( -d $long_path_300 or mkpath( $long_path_300 ) ),  'mkpath: create a path with 300 characters' ) ; } 
+			or ok( 1, 'mkpath: can not create a path with 300 characters' ) ;
+                ok( ( ( ! -d $long_path_300 ) or -d $long_path_300 and rmtree( $long_path_300 ) ), 'mkpath: rmtree the 300 character path' ) ;
+		ok( 1, 'mkpath: still alive' ) ;
 
-		myprint( "$long_path_300\n"  ) ;
-		# This one just kill the whole process without a whisper:
-		#ok( ( -d $long_path_300        or mkpath( $long_path_300 ) ),        'tests_mkpath: mkpath fails > 300 char' ) ;
-		#ok( ( -d $long_path_300 and rmtree( $long_path_300 ) ), 'tests_mkpath: rmtree \ > 300 char' ) ;
-	} ;
+		ok( ( -d 'W/tmp/tests/trailing_dots...' or  mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ;
+		ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ;
+		ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ;
+		ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ;
+		
+		
+        } ;
 
-	return 1 ;
+	note( 'Leaving  tests_mkpath()' ) ;
+	# Keep this because of the eval used by the caller (failed badly?)
+        return 1 ;
 }
 
 sub tests_touch {
+	note( 'Entering tests_touch()' ) ;
 
-	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'tests_touch: mkpath W/tmp/tests/' ) ;
-	ok( 1 == touch( 'W/tmp/tests/lala'), 'tests_touch: W/tmp/tests/lala') ;
-	ok( 1 == touch( 'W/tmp/tests/\y'), 'tests_touch: W/tmp/tests/\y') ;
-	ok( 0 == touch( '/no/no/no/aaa'), 'tests_touch: not /aaa') ;
-	ok( 1 == touch( 'W/tmp/tests/lili', 'W/tmp/tests/lolo'), 'tests_touch: 2 files') ;
-	ok( 0 == touch( 'W/tmp/tests/\y', '/no/no/aaa'), 'tests_touch: 2 files, 1 fails' ) ;
-	return ;
+        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'touch: mkpath W/tmp/tests/' ) ;
+        ok( 1 == touch( 'W/tmp/tests/lala'), 'touch: W/tmp/tests/lala') ;
+        ok( 1 == touch( 'W/tmp/tests/\y'), 'touch: W/tmp/tests/\y') ;
+        ok( 0 == touch( '/no/no/no/aaa'), 'touch: not /aaa') ;
+        ok( 1 == touch( 'W/tmp/tests/lili', 'W/tmp/tests/lolo'), 'touch: 2 files') ;
+        ok( 0 == touch( 'W/tmp/tests/\y', '/no/no/aaa'), 'touch: 2 files, 1 fails' ) ;
+
+	note( 'Leaving  tests_touch()' ) ;
+        return ;
 }
 
 
 sub touch {
-	my @files = @_ ;
-	my $failures = 0 ;
+        my @files = @_ ;
+        my $failures = 0 ;
 
-	foreach my $file ( @files ) {
-		my  $fh = IO::File->new ;
-		if ( $fh->open(">> $file" ) ) {
-			$fh->close ;
-		}else{
-                	myprint( "Could not open file $file in write/append mode\n"  ) ;
-                	$failures++ ;
+        foreach my $file ( @files ) {
+                my  $fh = IO::File->new ;
+                if ( $fh->open(">> $file" ) ) {
+                        $fh->close ;
+                }else{
+                        myprint( "Could not open file $file in write/append mode\n"  ) ;
+                        $failures++ ;
                 }
-	}
-	return( ! $failures );
+        }
+        return( ! $failures );
 }
 
 
 sub tests_tmpdir_has_colon_bug {
+	note( 'Entering tests_tmpdir_has_colon_bug()' ) ;
 
-	ok( 0 == tmpdir_has_colon_bug( q{} ),        'tmpdir_has_colon_bug: ' ) ;
-	ok( 0 == tmpdir_has_colon_bug( '/tmp' ),    'tmpdir_has_colon_bug: /tmp' ) ;
-	ok( 1 == tmpdir_has_colon_bug( 'C:' ),      'tmpdir_has_colon_bug: C:' ) ;
-	ok( 1 == tmpdir_has_colon_bug( 'C:\temp' ), 'tmpdir_has_colon_bug: C:\temp' ) ;
+        ok( 0 == tmpdir_has_colon_bug( q{} ),        'tmpdir_has_colon_bug: ' ) ;
+        ok( 0 == tmpdir_has_colon_bug( '/tmp' ),    'tmpdir_has_colon_bug: /tmp' ) ;
+        ok( 1 == tmpdir_has_colon_bug( 'C:' ),      'tmpdir_has_colon_bug: C:' ) ;
+        ok( 1 == tmpdir_has_colon_bug( 'C:\temp' ), 'tmpdir_has_colon_bug: C:\temp' ) ;
 
-        return( 0 ) ;
+	note( 'Leaving  tests_tmpdir_has_colon_bug()' ) ;
+        return ;
 }
 
 sub tmpdir_has_colon_bug {
-	my $path = shift ;
+        my $path = shift ;
 
-	my $path_filtered = filter_forbidden_characters( $path ) ;
-	if ( $path_filtered ne $path ) {
-        	( -d $path_filtered ) and myprint( "Path $path was previously mistakely changed to $path_filtered\n"  ) ;
-        	return( 1 ) ;
+        my $path_filtered = filter_forbidden_characters( $path ) ;
+        if ( $path_filtered ne $path ) {
+                ( -d $path_filtered ) and myprint( "Path $path was previously mistakely changed to $path_filtered\n"  ) ;
+                return( 1 ) ;
         }
         return( 0 ) ;
 }
@@ -6133,140 +7308,154 @@ sub tmpdir_fix_colon_bug {
 
 
 sub tests_cache_folder {
+	note( 'Entering tests_cache_folder()' ) ;
 
-	ok( '/path/fold1/fold2' eq cache_folder( q{}, '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( '/pa_th/fold1/fold2' eq cache_folder( q{}, '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( '/_p_a__th/fol_d1/fold2' eq cache_folder( q{}, '/>pp /path/fol_d1/fold2' ) ;
 
-	ok( 'D:/path/fold1/fold2' eq cache_folder( 'D:', '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( 'D:/pa_th/fold1/fold2' eq cache_folder( 'D:', '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
-	ok( 'D:/_p_a__th/fol_d1/fold2' eq cache_folder( 'D:', '/>pp /path/fol_d1/fold2' ) ;
-	ok( '//' eq cache_folder( q{}, q{}, q{}, q{}), 'cache_folder:  -> //' ) ;
-	ok( '//_______' eq cache_folder( q{}, q{}, q{}, '*|?:"<>'), 'cache_folder: *|?:"<> -> //_______' ) ;
-	return ;
+        ok( '/path/fold1/fold2' eq cache_folder( q{}, '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( '/pa_th/fold1/fold2' eq cache_folder( q{}, '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( '/_p_a__th/fol_d1/fold2' eq cache_folder( q{}, '/>pp /path/fol_d1/fold2' ) ;
+
+        ok( 'D:/path/fold1/fold2' eq cache_folder( 'D:', '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( 'D:/pa_th/fold1/fold2' eq cache_folder( 'D:', '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
+        ok( 'D:/_p_a__th/fol_d1/fold2' eq cache_folder( 'D:', '/>pp /path/fol_d1/fold2' ) ;
+        ok( '//' eq cache_folder( q{}, q{}, q{}, q{}), 'cache_folder:  -> //' ) ;
+        ok( '//_______' eq cache_folder( q{}, q{}, q{}, '*|?:"<>'), 'cache_folder: *|?:"<> -> //_______' ) ;
+
+	note( 'Leaving  tests_cache_folder()' ) ;
+        return ;
 }
 
 sub cache_folder {
-	my( $cache_base, $cache_dir, $h1_fold, $h2_fold ) = @_ ;
+        my( $cache_base, $cache_dir, $h1_fold, $h2_fold ) = @_ ;
 
-	my $sep_1 = $h1_sep || '/';
-	my $sep_2 = $h2_sep || '/';
+        my $sep_1 = $h1_sep || '/';
+        my $sep_2 = $h2_sep || '/';
 
-	#myprint( "$cache_dir h1_fold $h1_fold sep1 $sep_1 h2_fold $h2_fold sep2 $sep_2\n" ) ;
-	$h1_fold = convert_sep_to_slash( $h1_fold, $sep_1 ) ;
-	$h2_fold = convert_sep_to_slash( $h2_fold, $sep_2 ) ;
+        #myprint( "$cache_dir h1_fold $h1_fold sep1 $sep_1 h2_fold $h2_fold sep2 $sep_2\n" ) ;
+        $h1_fold = convert_sep_to_slash( $h1_fold, $sep_1 ) ;
+        $h2_fold = convert_sep_to_slash( $h2_fold, $sep_2 ) ;
 
         my $cache_folder = "$cache_base" . filter_forbidden_characters( "$cache_dir/$h1_fold/$h2_fold" ) ;
-	#myprint( "cache_folder [$cache_folder]\n"  ) ;
+        #myprint( "cache_folder [$cache_folder]\n"  ) ;
         return( $cache_folder ) ;
 }
 
 sub filter_forbidden_characters  {
-	my $string = shift ;
+        my $string = shift ;
+
+	if ( ! defined $string ) { return ; }
 
         if ( 'MSWin32' eq $OSNAME ) {
-        	# Move trailing whitespace to _ " a b /c d " -> " a b_/c d_"
-        	$string =~ s{\ (/|$)}{_$1}xg ;
+                # Move trailing whitespace to _ " a b /c d " -> " a b_/c d_"
+                $string =~ s{\ (/|$)}{_$1}xg ;
         }
         $string =~ s{[\Q*|?:"<>\E]}{_}xg ;
         #myprint( "[$string]\n"  ) ;
-	return( $string ) ;
+        return( $string ) ;
 }
 
 sub tests_filter_forbidden_characters  {
+	note( 'Entering tests_filter_forbidden_characters()' ) ;
 
-	ok( 'a_b' eq filter_forbidden_characters( 'a_b' ), 'filter_forbidden_characters: a_b -> a_b' ) ;
-	ok( 'a_b' eq filter_forbidden_characters( 'a*b' ), 'filter_forbidden_characters: a*b -> a_b' ) ;
-	ok( 'a_b' eq filter_forbidden_characters( 'a|b' ), 'filter_forbidden_characters: a|b -> a_b' ) ;
-	ok( 'a_b' eq filter_forbidden_characters( 'a?b' ), 'filter_forbidden_characters: a?b -> a_b' ) ;
-	ok( 'a_______b' eq filter_forbidden_characters( 'a*|?:"<>b' ), 'filter_forbidden_characters: a*|?:"<>b -> a_______b' ) ;
 
-	SKIP: {
-		skip( 'Not on MSWin32', 1 ) if ( 'MSWin32' eq $OSNAME ) ;
-		ok( ( 'a b ' eq filter_forbidden_characters( 'a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b "' ) ;
-	} ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a_b' ), 'filter_forbidden_characters: a_b -> a_b' ) ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a*b' ), 'filter_forbidden_characters: a*b -> a_b' ) ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a|b' ), 'filter_forbidden_characters: a|b -> a_b' ) ;
+        ok( 'a_b' eq filter_forbidden_characters( 'a?b' ), 'filter_forbidden_characters: a?b -> a_b' ) ;
+        ok( 'a_______b' eq filter_forbidden_characters( 'a*|?:"<>b' ), 'filter_forbidden_characters: a*|?:"<>b -> a_______b' ) ;
 
-	SKIP: {
-		skip( 'Only on MSWin32', 2 ) if ( 'MSWin32' ne $OSNAME ) ;
-		ok( ( ' a b_' eq filter_forbidden_characters( ' a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b_"' ) ;
-		ok( ( ' a b_/ c d_' eq filter_forbidden_characters( ' a b / c d ' ) ), 'filter_forbidden_characters: " a b / c d " -> "a b_/ c d_"' ) ;
+        SKIP: {
+                skip( 'Not on MSWin32', 1 ) if ( 'MSWin32' eq $OSNAME ) ;
+                ok( ( 'a b ' eq filter_forbidden_characters( 'a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b "' ) ;
         } ;
 
-	return ;
+        SKIP: {
+                skip( 'Only on MSWin32', 2 ) if ( 'MSWin32' ne $OSNAME ) ;
+                ok( ( ' a b_' eq filter_forbidden_characters( ' a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b_"' ) ;
+                ok( ( ' a b_/ c d_' eq filter_forbidden_characters( ' a b / c d ' ) ), 'filter_forbidden_characters: " a b / c d " -> "a b_/ c d_"' ) ;
+        } ;
+
+	note( 'Leaving  tests_filter_forbidden_characters()' ) ;
+        return ;
 }
 
 sub convert_sep_to_slash {
-	my ( $folder, $sep ) = @_ ;
+        my ( $folder, $sep ) = @_ ;
 
-	$folder =~ s{\Q$sep\E}{/}xg ;
-	return( $folder ) ;
+        $folder =~ s{\Q$sep\E}{/}xg ;
+        return( $folder ) ;
 }
 
 sub tests_convert_sep_to_slash {
+	note( 'Entering tests_convert_sep_to_slash()' ) ;
 
-	ok(q{} eq convert_sep_to_slash(q{}, '/'), 'convert_sep_to_slash: no folder');
-	ok('INBOX' eq convert_sep_to_slash('INBOX', '/'), 'convert_sep_to_slash: INBOX');
-	ok('INBOX/foo' eq convert_sep_to_slash('INBOX/foo', '/'), 'convert_sep_to_slash: INBOX/foo');
-	ok('INBOX/foo' eq convert_sep_to_slash('INBOX_foo', '_'), 'convert_sep_to_slash: INBOX_foo');
-	ok('INBOX/foo/zob' eq convert_sep_to_slash('INBOX_foo_zob', '_'), 'convert_sep_to_slash: INBOX_foo_zob');
-	ok('INBOX/foo' eq convert_sep_to_slash('INBOX.foo', '.'), 'convert_sep_to_slash: INBOX.foo');
-	ok('INBOX/foo/hi' eq convert_sep_to_slash('INBOX.foo.hi', '.'), 'convert_sep_to_slash: INBOX.foo.hi');
-	return ;
+
+        ok(q{} eq convert_sep_to_slash(q{}, '/'), 'convert_sep_to_slash: no folder');
+        ok('INBOX' eq convert_sep_to_slash('INBOX', '/'), 'convert_sep_to_slash: INBOX');
+        ok('INBOX/foo' eq convert_sep_to_slash('INBOX/foo', '/'), 'convert_sep_to_slash: INBOX/foo');
+        ok('INBOX/foo' eq convert_sep_to_slash('INBOX_foo', '_'), 'convert_sep_to_slash: INBOX_foo');
+        ok('INBOX/foo/zob' eq convert_sep_to_slash('INBOX_foo_zob', '_'), 'convert_sep_to_slash: INBOX_foo_zob');
+        ok('INBOX/foo' eq convert_sep_to_slash('INBOX.foo', '.'), 'convert_sep_to_slash: INBOX.foo');
+        ok('INBOX/foo/hi' eq convert_sep_to_slash('INBOX.foo.hi', '.'), 'convert_sep_to_slash: INBOX.foo.hi');
+
+	note( 'Leaving  tests_convert_sep_to_slash()' ) ;
+        return ;
 }
 
 
 sub tests_regexmess {
+	note( 'Entering tests_regexmess()' ) ;
 
-	ok( 'blabla' eq regexmess( 'blabla' ), 'regexmess, no regexmess, nothing to do' ) ;
+        ok( 'blabla' eq regexmess( 'blabla' ), 'regexmess, no regexmess, nothing to do' ) ;
 
-	@regexmess = ( 'lalala' ) ;
-	ok( not( defined regexmess( 'popopo' ) ), 'regexmess, bad regex lalala' ) ;
+        @regexmess = ( 'lalala' ) ;
+        ok( not( defined regexmess( 'popopo' ) ), 'regexmess, bad regex lalala' ) ;
 
-	@regexmess = ( 's/p/Z/g' ) ;
-	ok( 'ZoZoZo' eq regexmess( 'popopo' ), 'regexmess, s/p/Z/g' ) ;
+        @regexmess = ( 's/p/Z/g' ) ;
+        ok( 'ZoZoZo' eq regexmess( 'popopo' ), 'regexmess, s/p/Z/g' ) ;
 
-	@regexmess = ( 's{c}{C}gxms' ) ;
-	ok("H1: abC\nH2: Cde\n\nBody abC"
-		   eq regexmess( "H1: abc\nH2: cde\n\nBody abc"),
-	   'regexmess, c->C');
+        @regexmess = ( 's{c}{C}gxms' ) ;
+        ok("H1: abC\nH2: Cde\n\nBody abC"
+                   eq regexmess( "H1: abc\nH2: cde\n\nBody abc"),
+           'regexmess, c->C');
 
-	@regexmess = ( 's{\AFrom\ }{From:}gxms' ) ;
-	ok(          q{}
-	eq regexmess(q{}),
-	'From mbox 1 add colon blank');
+        @regexmess = ( 's{\AFrom\ }{From:}gxms' ) ;
+        ok(          q{}
+        eq regexmess(q{}),
+        'From mbox 1 add colon blank');
 
-	ok(          'From:'
-	eq regexmess('From '),
-	'From mbox 2 add colo');
+        ok(          'From:'
+        eq regexmess('From '),
+        'From mbox 2 add colo');
 
-	ok(          "\n" . 'From '
-	eq regexmess("\n" . 'From '),
-	'From mbox 3 add colo') ;
+        ok(          "\n" . 'From '
+        eq regexmess("\n" . 'From '),
+        'From mbox 3 add colo') ;
 
-	ok(          "From: zzz\n" . 'From '
-	eq regexmess("From  zzz\n" . 'From '),
-	'From mbox 4 add colo') ;
+        ok(          "From: zzz\n" . 'From '
+        eq regexmess("From  zzz\n" . 'From '),
+        'From mbox 4 add colo') ;
 
-	@regexmess = ( 's{\AFrom\ [^\n]*(\n)?}{}gxms' ) ;
-	ok(          q{}
-	eq regexmess(q{}),
-	'From mbox 1 remove, blank');
+        @regexmess = ( 's{\AFrom\ [^\n]*(\n)?}{}gxms' ) ;
+        ok(          q{}
+        eq regexmess(q{}),
+        'From mbox 1 remove, blank');
 
-	ok(          q{}
-	eq regexmess('From '),
-	'From mbox 2 remove');
+        ok(          q{}
+        eq regexmess('From '),
+        'From mbox 2 remove');
 
-	ok(          "\n" . 'From '
-	eq regexmess("\n" . 'From '),
-	'From mbox 3 remove');
+        ok(          "\n" . 'From '
+        eq regexmess("\n" . 'From '),
+        'From mbox 3 remove');
 
-	#myprint( "[", regexmess("From  zzz\n" . 'From '), "]" ) ;
-	ok(          q{}            . 'From '
-	eq regexmess("From  zzz\n" . 'From '),
-	'From mbox 4 remove');
+        #myprint( "[", regexmess("From  zzz\n" . 'From '), "]" ) ;
+        ok(          q{}            . 'From '
+        eq regexmess("From  zzz\n" . 'From '),
+        'From mbox 4 remove');
 
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6274,7 +7463,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 From  zzz
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6287,7 +7476,7 @@ EOM
 
 
 @regexmess = ( 's{\A((?:[^\n]+\n)+|)^Disposition-Notification-To:[^\n]*\n(\r?\n|.*\n\r?\n)}{$1$2}xms' ) ; # SUPER SUPER BEST!
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6295,7 +7484,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Disposition-Notification-To: Gilles LAMIRAL 
@@ -6304,10 +7493,10 @@ From:
 Hello,
 Bye.
 EOM
-	),
-	'regexmess: 1 Delete header Disposition-Notification-To:');
+        ),
+        'regexmess: 1 Delete header Disposition-Notification-To:');
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6315,7 +7504,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6325,9 +7514,9 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 2 Delete header Disposition-Notification-To:');
+        'regexmess: 2 Delete header Disposition-Notification-To:');
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6335,7 +7524,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Disposition-Notification-To: Gilles LAMIRAL 
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6345,9 +7534,9 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 3 Delete header Disposition-Notification-To:');
+        'regexmess: 3 Delete header Disposition-Notification-To:');
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6355,7 +7544,7 @@ From:
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Disposition-Notification-To: Gilles LAMIRAL 
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6365,10 +7554,10 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 4 Delete header Disposition-Notification-To:');
+        'regexmess: 4 Delete header Disposition-Notification-To:');
 
 
-	ok(
+        ok(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6376,7 +7565,7 @@ From:
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6385,7 +7574,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 5 Delete header Disposition-Notification-To:');
+        'regexmess: 5 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6397,7 +7586,7 @@ Hello,
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6407,7 +7596,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 6 Delete header Disposition-Notification-To:');
+        'regexmess: 6 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6419,7 +7608,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6430,7 +7619,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 7 Delete header Disposition-Notification-To:');
+        'regexmess: 7 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6441,7 +7630,7 @@ From:
 Hello,
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6450,7 +7639,7 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 8 Delete header Disposition-Notification-To:');
+        'regexmess: 8 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6462,7 +7651,7 @@ Hello,
 Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6472,7 +7661,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 9 Delete header Disposition-Notification-To:');
+        'regexmess: 9 Delete header Disposition-Notification-To:');
 
 
 
@@ -6487,7 +7676,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6499,7 +7688,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 10 Delete header Disposition-Notification-To:');
+        'regexmess: 10 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6512,7 +7701,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6524,7 +7713,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 11 Delete header Disposition-Notification-To:');
+        'regexmess: 11 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6539,7 +7728,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6553,7 +7742,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 12 Delete header Disposition-Notification-To:');
+        'regexmess: 12 Delete header Disposition-Notification-To:');
 
 
 @regexmess = ( 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' ) ; # BAD!
@@ -6573,7 +7762,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6587,7 +7776,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 13 Delete header Disposition-Notification-To:');
+        'regexmess: 13 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6603,7 +7792,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Disposition-Notification-To: Gilles LAMIRAL 
@@ -6618,7 +7807,7 @@ Disposition-Notification-To: Gilles LAMIRAL 
 Bye.
 EOM
 ),
-	'regexmess: 14 Delete header Disposition-Notification-To:');
+        'regexmess: 14 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6630,7 +7819,7 @@ Hello,
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Disposition-Notification-To: Gilles LAMIRAL 
@@ -6641,7 +7830,7 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 15 Delete header Disposition-Notification-To:');
+        'regexmess: 15 Delete header Disposition-Notification-To:');
 
 
 ok(
@@ -6654,7 +7843,7 @@ Hello,
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6665,7 +7854,7 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 16 Delete header Disposition-Notification-To:');
+        'regexmess: 16 Delete header Disposition-Notification-To:');
 
 ok(
 <<'EOM'
@@ -6677,7 +7866,7 @@ Hello,
 
 Bye.
 EOM
-	eq regexmess(
+        eq regexmess(
 <<'EOM'
 Disposition-Notification-To: Gilles LAMIRAL 
 Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -6688,76 +7877,78 @@ Hello,
 Bye.
 EOM
 ),
-	'regexmess: 17 Delete header Disposition-Notification-To:');
+        'regexmess: 17 Delete header Disposition-Notification-To:');
 
 
 
 # regex to play with Date: from the FAQ
 #@regexmess = 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}gxms'
 
-return ;
+	note( 'Leaving  tests_regexmess()' ) ;
+	return ;
 
 }
 
 sub regexmess {
-	my ( $string ) = @_ ;
-	foreach my $regexmess ( @regexmess ) {
-		$debug and myprint( "eval \$string =~ $regexmess\n"  ) ;
-		my $ret = eval "\$string =~ $regexmess ; 1" ;
+        my ( $string ) = @_ ;
+        foreach my $regexmess ( @regexmess ) {
+                $debug and myprint( "eval \$string =~ $regexmess\n"  ) ;
+                my $ret = eval "\$string =~ $regexmess ; 1" ;
                 #myprint( "eval [$ret]\n"  ) ;
-                if ( ( not $ret ) or $@ ) {
-			myprint( "Error: eval regexmess '$regexmess': $@"  ) ;
+                if ( ( not $ret ) or $EVAL_ERROR ) {
+                        myprint( "Error: eval regexmess '$regexmess': $EVAL_ERROR"  ) ;
                         return( undef ) ;
                 }
-	}
+        }
         $debug and myprint( "$string\n" ) ;
-	return( $string ) ;
+        return( $string ) ;
 }
 
 
 sub tests_skipmess {
+	note( 'Entering tests_skipmess()' ) ;
 
-	ok( not( defined skipmess( 'blabla' ) ), 'skipmess, no skipmess, no skip' ) ;
+        ok( not( defined skipmess( 'blabla' ) ), 'skipmess, no skipmess, no skip' ) ;
 
-	@skipmess = ('[') ;
-	ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex [' ) ;
+        @skipmess = ('[') ;
+        ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex [' ) ;
 
-	@skipmess = ('lalala') ;
-	ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex lalala' ) ;
+        @skipmess = ('lalala') ;
+        ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex lalala' ) ;
 
-	@skipmess = ('/popopo/') ;
-	ok( 1 == skipmess( 'popopo' ), 'skipmess, popopo match regex /popopo/' ) ;
+        @skipmess = ('/popopo/') ;
+        ok( 1 == skipmess( 'popopo' ), 'skipmess, popopo match regex /popopo/' ) ;
 
-	@skipmess = ('/popopo/') ;
-	ok( 0 == skipmess( 'rrrrrr' ), 'skipmess, rrrrrr does not match regex /popopo/' ) ;
+        @skipmess = ('/popopo/') ;
+        ok( 0 == skipmess( 'rrrrrr' ), 'skipmess, rrrrrr does not match regex /popopo/' ) ;
 
-	@skipmess = ('m{^$}') ;
-	ok( 1 == skipmess( q{} ),    'skipmess: empty string yes' ) ;
-	ok( 0 == skipmess( 'Hi!' ), 'skipmess: empty string no' ) ;
+        @skipmess = ('m{^$}') ;
+        ok( 1 == skipmess( q{} ),    'skipmess: empty string yes' ) ;
+        ok( 0 == skipmess( 'Hi!' ), 'skipmess: empty string no' ) ;
 
-	@skipmess = ('m{i}') ;
-	ok( 1 == skipmess( 'Hi!' ),  'skipmess: i string yes' ) ;
-	ok( 0 == skipmess( 'Bye!' ), 'skipmess: i string no' ) ;
+        @skipmess = ('m{i}') ;
+        ok( 1 == skipmess( 'Hi!' ),  'skipmess: i string yes' ) ;
+        ok( 0 == skipmess( 'Bye!' ), 'skipmess: i string no' ) ;
 
-	@skipmess = ('m{[\x80-\xff]}') ;
-	ok( 0 == skipmess( 'Hi!' ),  'skipmess: i 8bit no' ) ;
-	ok( 1 == skipmess( "\xff" ), 'skipmess: \xff 8bit yes' ) ;
+        @skipmess = ('m{[\x80-\xff]}') ;
+        ok( 0 == skipmess( 'Hi!' ),  'skipmess: i 8bit no' ) ;
+        ok( 1 == skipmess( "\xff" ), 'skipmess: \xff 8bit yes' ) ;
 
-	@skipmess = ('m{A}', 'm{B}') ;
-	ok( 0 == skipmess( 'Hi!' ),  'skipmess: A or B no' ) ;
-	ok( 0 == skipmess( 'lala' ), 'skipmess: A or B no' ) ;
-	ok( 0 == skipmess( "\xff" ), 'skipmess: A or B no' ) ;
-	ok( 1 == skipmess( 'AB' ),   'skipmess: A or B yes' ) ;
-	ok( 1 == skipmess( 'BA' ),   'skipmess: A or B yes' ) ;
-	ok( 1 == skipmess( 'AA' ),   'skipmess: A or B yes' ) ;
-	ok( 1 == skipmess( 'Ok Bye' ), 'skipmess: A or B yes' ) ;
+        @skipmess = ('m{A}', 'm{B}') ;
+        ok( 0 == skipmess( 'Hi!' ),  'skipmess: A or B no' ) ;
+        ok( 0 == skipmess( 'lala' ), 'skipmess: A or B no' ) ;
+        ok( 0 == skipmess( "\xff" ), 'skipmess: A or B no' ) ;
+        ok( 1 == skipmess( 'AB' ),   'skipmess: A or B yes' ) ;
+        ok( 1 == skipmess( 'BA' ),   'skipmess: A or B yes' ) ;
+        ok( 1 == skipmess( 'AA' ),   'skipmess: A or B yes' ) ;
+        ok( 1 == skipmess( 'Ok Bye' ), 'skipmess: A or B yes' ) ;
 
 
-	@skipmess = ( 'm#\A((?:[^\n]+\n)+|)^Content-Type: Message/Partial;[^\n]*\n(?:\n|.*\n\n)#ism' ) ; # SUPER BEST!
+        @skipmess = ( 'm#\A((?:[^\n]+\n)+|)^Content-Type: Message/Partial;[^\n]*\n(?:\n|.*\n\n)#ism' ) ; # SUPER BEST!
 
 
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Content-Type: Message/Partial; blabla
@@ -6769,7 +7960,7 @@ EOM
 ),
     'skipmess: 1 match Content-Type: Message/Partial' ) ;
 
-	ok( 0 == skipmess(
+        ok( 0 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6781,7 +7972,7 @@ EOM
     'skipmess: 2 not match Content-Type: Message/Partial' ) ;
 
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6793,7 +7984,7 @@ EOM
 ),
     'skipmess: 3 match Content-Type: Message/Partial' ) ;
 
-	ok( 0 == skipmess(
+        ok( 0 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6806,7 +7997,7 @@ EOM
     'skipmess: 4 not match Content-Type: Message/Partial' ) ;
 
 
-	ok( 0 == skipmess(
+        ok( 0 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 From:
@@ -6820,7 +8011,7 @@ EOM
     'skipmess: 5 not match Content-Type: Message/Partial' ) ;
 
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Content-Type: Message/Partial; blabla
@@ -6835,7 +8026,7 @@ EOM
 ),
     'skipmess: 6 match Content-Type: Message/Partial' ) ;
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Sat, 10 Jul 2010 05:34:45 -0700
 Content-Type: Message/Partial;
@@ -6847,14 +8038,14 @@ EOM
 ),
     'skipmess: 7 match Content-Type: Message/Partial' ) ;
 
-	ok( 1 == skipmess(
+        ok( 1 == skipmess(
 <<'EOM'
 Date: Wed, 2 Jul 2014 02:26:40 +0000
 MIME-Version: 1.0
 Content-Type: message/partial;
-	id="TAN_U_P<1404267997.00007489ed17>";
-	number=3;
-	total=3
+        id="TAN_U_P<1404267997.00007489ed17>";
+        number=3;
+        total=3
 
 6HQ6Hh3CdXj77qEGixerQ6zHx0OnQ/Cf5On4W0Y6vtU2crABZQtD46Hx1EOh8dDz4+OnTr1G
 
@@ -6898,7 +8089,7 @@ Content-Type: message/partial;
 
 test: aethaecohngiexao
 EOM
-. "lalala\n" x 3000000
+. "lalala\n" x 3_000_000
 ),
     'skipmess: 10 match Content-Type: Message/Partial' ) ;
 
@@ -6909,7 +8100,7 @@ From: gilles@lamiral.info (Gilles LAMIRAL)
 
 test: aethaecohngiexao
 EOM
-. "lalala\n" x 3000000
+. "lalala\n" x 3_000_000
 ),
     'skipmess: 11 match Content-Type: Message/Partial' ) ;
 
@@ -6925,69 +8116,75 @@ Content-Type: text/plain; charset=iso-8859-1\r
 Content-Transfer-Encoding: 7bit\r
 \r
 EOM
-. qq{!#"$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefg\r\n } x 32730
+. qq{!#"d%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefg\r\n } x 32_730
 ),
     'skipmess: 12 not match Content-Type: Message/Partial' ) ;
         # Complex regular subexpression recursion limit (32766) exceeded with more lines
         # exit;
-	return ;
+
+	note( 'Leaving  tests_skipmess()' ) ;
+        return ;
 }
 
 sub skipmess {
-	my ( $string ) = @_ ;
-	my $match ;
-	#myprint( "$string\n"  ) ;
-	foreach my $skipmess ( @skipmess ) {
-		$debug and myprint( "eval \$match = \$string =~ $skipmess\n"  ) ;
-		my $ret = eval "\$match = \$string =~ $skipmess ; 1"  ;
-		#myprint( "eval [$ret]\n"  ) ;
-		$debug and myprint( "match [$match]\n"  ) ;
-		if ( ( not $ret ) or $@ ) {
-			myprint( "Error: eval skipmess '$skipmess': $@"  ) ;
-			return( undef ) ;
-		}
-		return( $match ) if ( $match ) ;
-	}
-	return( $match ) ;
+        my ( $string ) = @_ ;
+        my $match ;
+        #myprint( "$string\n"  ) ;
+        foreach my $skipmess ( @skipmess ) {
+                $debug and myprint( "eval \$match = \$string =~ $skipmess\n"  ) ;
+                my $ret = eval "\$match = \$string =~ $skipmess ; 1"  ;
+                #myprint( "eval [$ret]\n"  ) ;
+                $debug and myprint( "match [$match]\n"  ) ;
+                if ( ( not $ret ) or $EVAL_ERROR ) {
+                        myprint( "Error: eval skipmess '$skipmess': $EVAL_ERROR"  ) ;
+                        return( undef ) ;
+                }
+                return( $match ) if ( $match ) ;
+        }
+        return( $match ) ;
 }
 
 
 
 
 sub tests_bytes_display_string {
+	note( 'Entering tests_bytes_display_string()' ) ;
+
 
         is(    'NA', bytes_display_string(       ), 'bytes_display_string: no args => NA' ) ;
         is(    'NA', bytes_display_string( undef ), 'bytes_display_string: undef   => NA' ) ;
         is(    'NA', bytes_display_string( 'blabla' ), 'bytes_display_string: blabla   => NA' ) ;
-        
-	ok(    '0.000 KiB' eq bytes_display_string(       0 ), 'bytes_display_string:       0' ) ;
-	ok(    '0.001 KiB' eq bytes_display_string(       1 ), 'bytes_display_string:       1' ) ;
-	ok(    '0.010 KiB' eq bytes_display_string(      10 ), 'bytes_display_string:      10' ) ;
-	ok(    '1.000 MiB' eq bytes_display_string( 1048575 ), 'bytes_display_string: 1048575' ) ;
-	ok(    '1.000 MiB' eq bytes_display_string( 1048576 ), 'bytes_display_string: 1048576' ) ;
 
-	ok(    '1.000 GiB' eq bytes_display_string( 1073741823 ), 'bytes_display_string: 1073741823 ' ) ;
-	ok(    '1.000 GiB' eq bytes_display_string( 1073741824 ), 'bytes_display_string: 1073741824 ' ) ;
+        ok(    '0.000 KiB' eq bytes_display_string(       0 ), 'bytes_display_string:       0' ) ;
+        ok(    '0.001 KiB' eq bytes_display_string(       1 ), 'bytes_display_string:       1' ) ;
+        ok(    '0.010 KiB' eq bytes_display_string(      10 ), 'bytes_display_string:      10' ) ;
+        ok(    '1.000 MiB' eq bytes_display_string( 1_048_575 ), 'bytes_display_string: 1_048_575' ) ;
+        ok(    '1.000 MiB' eq bytes_display_string( 1_048_576 ), 'bytes_display_string: 1_048_576' ) ;
 
-	ok(    '1.000 TiB' eq bytes_display_string( 1099511627775 ), 'bytes_display_string: 1099511627775' ) ;
-	ok(    '1.000 TiB' eq bytes_display_string( 1099511627776 ), 'bytes_display_string: 1099511627776' ) ;
+        ok(    '1.000 GiB' eq bytes_display_string( 1_073_741_823 ), 'bytes_display_string: 1_073_741_823 ' ) ;
+        ok(    '1.000 GiB' eq bytes_display_string( 1_073_741_824 ), 'bytes_display_string: 1_073_741_824 ' ) ;
 
-	ok(    '1.000 PiB' eq bytes_display_string( 1125899906842623 ), 'bytes_display_string: 1125899906842623' ) ;
-	ok(    '1.000 PiB' eq bytes_display_string( 1125899906842624 ), 'bytes_display_string: 1125899906842624' ) ;
+        ok(    '1.000 TiB' eq bytes_display_string( 1_099_511_627_775 ), 'bytes_display_string: 1_099_511_627_775' ) ;
+        ok(    '1.000 TiB' eq bytes_display_string( 1_099_511_627_776 ), 'bytes_display_string: 1_099_511_627_776' ) ;
 
-	ok( '1024.000 PiB' eq bytes_display_string( 1152921504606846975 ), 'bytes_display_string: 1152921504606846975' ) ;
-	ok( '1024.000 PiB' eq bytes_display_string( 1152921504606846976 ), 'bytes_display_string: 1152921504606846976' ) ;
+        ok(    '1.000 PiB' eq bytes_display_string( 1_125_899_906_842_623 ), 'bytes_display_string: 1_125_899_906_842_623' ) ;
+        ok(    '1.000 PiB' eq bytes_display_string( 1_125_899_906_842_624 ), 'bytes_display_string: 1_125_899_906_842_624' ) ;
 
-	ok( '1048576.000 PiB' eq bytes_display_string( 1180591620717411303424 ), 'bytes_display_string: 1180591620717411303424' ) ;
+        ok( '1024.000 PiB' eq bytes_display_string( 1_152_921_504_606_846_975 ), 'bytes_display_string: 1_152_921_504_606_846_975' ) ;
+        ok( '1024.000 PiB' eq bytes_display_string( 1_152_921_504_606_846_976 ), 'bytes_display_string: 1_152_921_504_606_846_976' ) ;
 
-        #myprint(  bytes_display_string( 1180591620717411303424 ), "\n"  ) ;
-	return ;
+        ok( '1048576.000 PiB' eq bytes_display_string( 1_180_591_620_717_411_303_424 ), 'bytes_display_string: 1_180_591_620_717_411_303_424' ) ;
+
+        #myprint(  bytes_display_string( 1_180_591_620_717_411_303_424 ), "\n"  ) ;
+	note( 'Leaving  tests_bytes_display_string()' ) ;
+
+        return ;
 }
 
 sub bytes_display_string {
-	my ( $bytes ) = @_ ;
+        my ( $bytes ) = @_ ;
 
-	my $readable_value = q{} ;
+        my $readable_value = q{} ;
 
         if ( ! defined( $bytes ) ) {
                 return( 'NA' ) ;
@@ -6997,71 +8194,69 @@ sub bytes_display_string {
                 return( 'NA' ) ;
         }
 
-        
 
-	SWITCH: {
-        	if ( abs( $bytes ) < ( 1000 * $KIBI ) ) {
-        		$readable_value = mysprintf( '%.3f KiB', $bytes / $KIBI) ;
-                	last SWITCH ;
-        	}
-        	if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI ) ) {
-        		$readable_value = mysprintf( '%.3f MiB', $bytes / ($KIBI * $KIBI) ) ;
-        	        last SWITCH ;
-        	}
-        	if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI) ) {
-			$readable_value = mysprintf( '%.3f GiB', $bytes / ($KIBI * $KIBI * $KIBI) ) ;
-        	        last SWITCH ;
-        	}
-        	if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI * $KIBI) ) {
-			$readable_value = mysprintf( '%.3f TiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI) ) ;
-        	        last SWITCH ;
-        	} else {
-			$readable_value = mysprintf( '%.3f PiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI * $KIBI) ) ;
-        	}
-		# if you have exabytes (EiB) of email to transfer, you have too much email!
-	}
+
+        SWITCH: {
+                if ( abs( $bytes ) < ( 1000 * $KIBI ) ) {
+                        $readable_value = mysprintf( '%.3f KiB', $bytes / $KIBI) ;
+                        last SWITCH ;
+                }
+                if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI ) ) {
+                        $readable_value = mysprintf( '%.3f MiB', $bytes / ($KIBI * $KIBI) ) ;
+                        last SWITCH ;
+                }
+                if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI) ) {
+                        $readable_value = mysprintf( '%.3f GiB', $bytes / ($KIBI * $KIBI * $KIBI) ) ;
+                        last SWITCH ;
+                }
+                if ( abs( $bytes ) < ( 1000 * $KIBI * $KIBI * $KIBI * $KIBI) ) {
+                        $readable_value = mysprintf( '%.3f TiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI) ) ;
+                        last SWITCH ;
+                } else {
+                        $readable_value = mysprintf( '%.3f PiB', $bytes / ($KIBI * $KIBI * $KIBI * $KIBI * $KIBI) ) ;
+                }
+                # if you have exabytes (EiB) of email to transfer, you have too much email!
+        }
         #myprint( "$bytes = $readable_value\n"  ) ;
         return( $readable_value ) ;
 }
 
 sub stats {
-        my $sync_loc = shift ;
+        my $mysync = shift ;
 
-        if ( ! $sync_loc->{stats} ) {
+        if ( ! $mysync->{stats} ) {
                 return ;
         }
-        
-	$timeend = time ;
-	my $timediff = $timeend - $sync_loc->{timestart} ;
 
-	my $timeend_str   = localtime $timeend ;
+        my $timeend = time ;
+        my $timediff = $timeend - $mysync->{timestart} ;
 
-	my $memory_consumption = 0 ;
+        my $timeend_str   = localtime $timeend ;
+
+        my $memory_consumption = 0 ;
         $memory_consumption = memory_consumption(  ) || 0 ;
-	my $memory_ratio = ($max_msg_size_in_bytes) ?
-		mysprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : 'NA' ;
+        my $memory_ratio = ($max_msg_size_in_bytes) ?
+                mysprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : 'NA' ;
 
-	my $host1_reconnect_count = $imap1->Reconnect_counter() || 0 ;
-	my $host2_reconnect_count = $imap2->Reconnect_counter() || 0 ;
 
-	myprint(  "++++ Statistics\n"  ) ;
-	myprint(  "Transfer started on               : $timestart_str\n"  ) ;
-	myprint(  "Transfer ended on                 : $timeend_str\n"  ) ;
-	myprintf( "Transfer time                     : %.1f sec\n", $timediff ) ;
-	myprint(  "Folders synced                    : $h1_folders_wanted_ct/$h1_folders_wanted_nb synced\n"  ) ;
-	myprint(  "Messages transferred              : $nb_msg_transferred "  ) ;
-	myprint(  "(could be $nb_msg_skipped_dry_mode without dry mode)" ) if ( $dry ) ;
-	myprint(  "\n" ) ;
-	myprint(  "Messages skipped                  : $nb_msg_skipped\n"  ) ;
-	myprint(  "Messages found duplicate on host1 : $h1_nb_msg_duplicate\n"  ) ;
-	myprint(  "Messages found duplicate on host2 : $h2_nb_msg_duplicate\n"  ) ;
-	myprint(  "Messages void (noheader) on host1 : $h1_nb_msg_noheader\n"  ) ;
-	myprint(  "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n"  ) ;
-	myprint(  "Messages deleted on host1         : $h1_nb_msg_deleted\n"  ) ;
-	myprint(  "Messages deleted on host2         : $h2_nb_msg_deleted\n"  ) ;
+        myprint(  "++++ Statistics\n"  ) ;
+        myprint(  "Transfer started on               : $timestart_str\n"  ) ;
+        myprint(  "Transfer ended on                 : $timeend_str\n"  ) ;
+        myprintf( "Transfer time                     : %.1f sec\n", $timediff ) ;
+        myprint(  "Folders synced                    : $h1_folders_wanted_ct/$h1_folders_wanted_nb synced\n"  ) ;
+        myprint(  "Messages transferred              : $mysync->{nb_msg_transferred} "  ) ;
+        myprint(  "(could be $nb_msg_skipped_dry_mode without dry mode)" ) if ( $mysync->{dry} ) ;
+        myprint(  "\n" ) ;
+        myprint(  "Messages skipped                  : $nb_msg_skipped\n"  ) ;
+        myprint(  "Messages found duplicate on host1 : $h1_nb_msg_duplicate\n"  ) ;
+        myprint(  "Messages found duplicate on host2 : $h2_nb_msg_duplicate\n"  ) ;
+        myprint(  "Messages void (noheader) on host1 : $h1_nb_msg_noheader\n"  ) ;
+        myprint(  "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n"  ) ;
+        myprint(  "Messages deleted on host1         : $h1_nb_msg_deleted\n"  ) ;
+        myprint(  "Messages deleted on host2         : $h2_nb_msg_deleted\n"  ) ;
         myprintf( "Total bytes transferred           : %s (%s)\n",
-                $total_bytes_transferred,
-                bytes_display_string( $total_bytes_transferred ) ) ;
+                $mysync->{total_bytes_transferred},
+                bytes_display_string( $mysync->{total_bytes_transferred} ) ) ;
         myprintf( "Total bytes duplicate host1       : %s (%s)\n",
                 $h1_total_bytes_duplicate,
                 bytes_display_string( $h1_total_bytes_duplicate) ) ;
@@ -7074,62 +8269,62 @@ sub stats {
         myprintf( "Total bytes error                 : %s (%s)\n",
                 $total_bytes_error,
                 bytes_display_string( $total_bytes_error ) ) ;
-	$timediff ||= 1 ; # No division per 0
-	myprintf("Message rate                      : %.1f messages/s\n", $nb_msg_transferred / $timediff ) ;
-	myprintf("Average bandwidth rate            : %.1f KiB/s\n", $total_bytes_transferred / $KIBI / $timediff ) ;
-	#myprint(  "Reconnections to host1            : $host1_reconnect_count\n"  ) ;
-	#myprint(  "Reconnections to host2            : $host2_reconnect_count\n"  ) ;
-	myprintf("Memory consumption                : %.1f MiB\n", $memory_consumption / $KIBI / $KIBI ) ;
+        $timediff ||= 1 ; # No division per 0
+        myprintf("Message rate                      : %.1f messages/s\n", $mysync->{nb_msg_transferred} / $timediff ) ;
+        myprintf("Average bandwidth rate            : %.1f KiB/s\n", $mysync->{total_bytes_transferred} / $KIBI / $timediff ) ;
+        myprint( "Reconnections to host1            : $mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT}\n"  ) ;
+        myprint( "Reconnections to host2            : $mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT}\n"  ) ;
+        myprintf("Memory consumption                : %.1f MiB\n", $memory_consumption / $KIBI / $KIBI ) ;
         myprintf("Biggest message                   : %s bytes (%s)\n",
                 $max_msg_size_in_bytes,
                 bytes_display_string( $max_msg_size_in_bytes) ) ;
-	myprint(  "Memory/biggest message ratio      : $memory_ratio\n"  ) ;
+        myprint(  "Memory/biggest message ratio      : $memory_ratio\n"  ) ;
         if ( $foldersizesatend and $foldersizes ) {
-        
+
 
         my $nb_msg_start_diff = diff_or_NA( $h2_nb_msg_start, $h1_nb_msg_start ) ;
         my $bytes_start_diff  = diff_or_NA( $h2_bytes_start,  $h1_bytes_start  ) ;
-        
-	myprintf("Start difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_start_diff,
+
+        myprintf("Start difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_start_diff,
                                                         $bytes_start_diff,
                                                         bytes_display_string( $bytes_start_diff ) ) ;
 
         my $nb_msg_end_diff = diff_or_NA( $h2_nb_msg_end, $h1_nb_msg_end ) ;
         my $bytes_end_diff  = diff_or_NA( $h2_bytes_end,  $h1_bytes_end  ) ;
-        
-	myprintf("Final difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_end_diff,
+
+        myprintf("Final difference host2 - host1    : %s messages, %s bytes (%s)\n", $nb_msg_end_diff,
                                                         $bytes_end_diff,
                                                         bytes_display_string( $bytes_end_diff ) ) ;
         }
-	myprint(  "Detected $sync->{nb_errors} errors\n\n"  ) ;
+        myprint(  "Detected $mysync->{nb_errors} errors\n\n"  ) ;
 
-	myprint(  $warn_release, "\n"  ) ;
-	myprint(  thank_author(  )  ) ;
-	return ;
+        myprint(  $warn_release, "\n"  ) ;
+        myprint(  homepage(  ), "\n"  ) ;
+        return ;
 }
 
 sub diff_or_NA {
         my( $n1, $n2 ) = @ARG ;
-        
+
         if ( not defined $n1 or not defined $n2 ) {
                 return 'NA' ;
         }
-        
-        if ( not match_number( $n1 ) 
+
+        if ( not match_number( $n1 )
           or not match_number( $n2 ) ) {
                  return 'NA' ;
         }
-        
+
         return( $n1 - $n2 ) ;
 }
 
 sub match_number {
         my $n = shift @ARG ;
-        
+
         if ( not defined $n ) {
                 return 0 ;
         }
-        if ( $n =~  /[0-9]+\.?[0-9]?/ ) {
+        if ( $n =~  /[0-9]+\.?[0-9]?/x ) {
                 return 1 ;
         }
         else {
@@ -7139,6 +8334,8 @@ sub match_number {
 
 
 sub tests_match_number {
+	note( 'Entering tests_match_number()' ) ;
+
 
         is( 0, match_number(   ),        'match_number: no parameters => 0' ) ;
         is( 0, match_number( undef ),    'match_number:         undef => 0' ) ;
@@ -7147,12 +8344,16 @@ sub tests_match_number {
         is( 1, match_number( 1 ),        'match_number:             1 => 1' ) ;
         is( 1, match_number( 1.0 ),      'match_number:           1.0 => 1' ) ;
         is( 1, match_number( 0.0 ),      'match_number:           0.0 => 1' ) ;
+
+	note( 'Leaving  tests_match_number()' ) ;
         return ;
 }
 
 
 
 sub tests_diff_or_NA {
+	note( 'Entering tests_diff_or_NA()' ) ;
+
 
         is( 'NA', diff_or_NA(  ),             'diff_or_NA: no parameters => NA' ) ;
         is( 'NA', diff_or_NA( undef ),        'diff_or_NA: undef         => NA' ) ;
@@ -7167,127 +8368,120 @@ sub tests_diff_or_NA {
         is( 0, diff_or_NA( 1.0, 1 ),          'diff_or_NA: 1.0    1      =>  0' ) ;
         is( 1, diff_or_NA( 1.0, 0 ),          'diff_or_NA: 1.0    0      =>  1' ) ;
         is( -1, diff_or_NA( 0, 1.0 ),         'diff_or_NA: 0      1.0    => -1' ) ;
+
+	note( 'Leaving  tests_diff_or_NA()' ) ;
         return ;
 }
 
-sub thank_author {
-	return( "Homepage: http://imapsync.lamiral.info/\n" ) ;
+sub homepage {
+        return( 'Homepage: http://imapsync.lamiral.info/' ) ;
 }
 
 
 sub load_modules {
-
-	if ( $ssl1 or $ssl2 or $tls1 or $tls2) {
-        	# not yet a "use" statement
-        	require IO::Socket::SSL ;
-		if ( $sync->{inet4} ) {
-		        IO::Socket::SSL->import( 'inet4' ) ;
-		}
-		if ( $sync->{inet6} ) {
-		        IO::Socket::SSL->import( 'inet6' ) ;
-		}
+        if ( $sync->{ssl1}
+	  or $sync->{ssl2}
+	  or $sync->{tls1}
+	  or $sync->{tls2}) {
+                if ( $sync->{inet4} ) {
+                        IO::Socket::SSL->import( 'inet4' ) ;
+                }
+                if ( $sync->{inet6} ) {
+                        IO::Socket::SSL->import( 'inet6' ) ;
+                }
         }
-
-       if ( ( ( not( $password1 or $passfile1 ) )
-	   or (not ( $password2 or $passfile2 ) )
-            )
-	and ( not $help ) ) {
-        	# now a "use" statement
-        	#require Term::ReadKey ;
-        }
-
-	return ;
+        return ;
 }
 
 
 
 sub parse_header_msg {
-	my ( $imap, $m_uid, $s_heads, $s_fir, $side, $s_hash ) = @_ ;
+        my ( $imap, $m_uid, $s_heads, $s_fir, $side, $s_hash ) = @_ ;
 
-	my $head = $s_heads->{$m_uid} ;
-	my $headnum =  scalar keys  %{ $head }   ;
-	$debug and myprint( "$side uid $m_uid head nb pass one: ", $headnum, "\n"  ) ;
+        my $head = $s_heads->{$m_uid} ;
+        my $headnum =  scalar keys  %{ $head }   ;
+        $debug and myprint( "$side uid $m_uid head nb pass one: ", $headnum, "\n"  ) ;
 
-	if ( ( ! $headnum ) and ( $wholeheaderifneeded ) ){
-		myprint( "$side uid $m_uid no header by parse_headers so taking whole header with BODY.PEEK[HEADER]\n"  ) ;
-		$imap->fetch($m_uid, 'BODY.PEEK[HEADER]' ) ;
-		my $whole_header = $imap->_transaction_literals ;
+        if ( ( ! $headnum ) and ( $wholeheaderifneeded ) ){
+                myprint( "$side uid $m_uid no header by parse_headers so taking whole header with BODY.PEEK[HEADER]\n"  ) ;
+                $imap->fetch($m_uid, 'BODY.PEEK[HEADER]' ) ;
+                my $whole_header = $imap->_transaction_literals ;
 
                 #myprint( $whole_header ) ;
                 $head = decompose_header( $whole_header ) ;
 
                 $headnum =  scalar  keys  %{ $head }   ;
-	        $debug and myprint( "$side uid $m_uid head nb pass two: ", $headnum, "\n" ) ;
-	}
+                $debug and myprint( "$side uid $m_uid head nb pass two: ", $headnum, "\n" ) ;
+        }
 
         #myprint( Data::Dumper->Dump( [ $head, \%useheader ] )  ) ;
 
-	my $headstr ;
+        my $headstr ;
 
         $headstr = header_construct( $head, $side, $m_uid ) ;
 
-	if ( ( ! $headstr) and ( $addheader ) and ( $side eq 'Host1' ) ) {
-        	my $header = add_header( $m_uid ) ;
-		myprint( "Host1 uid $m_uid no header found so adding our own [$header]\n" ) ;
-		$headstr .= uc  $header  ;
-		$s_fir->{$m_uid}->{NO_HEADER} = 1;
-	}
+        if ( ( ! $headstr) and ( $addheader ) and ( $side eq 'Host1' ) ) {
+                my $header = add_header( $m_uid ) ;
+                myprint( "Host1 uid $m_uid no header found so adding our own [$header]\n" ) ;
+                $headstr .= uc  $header  ;
+                $s_fir->{$m_uid}->{NO_HEADER} = 1;
+        }
 
-	return if ( ! $headstr ) ;
+        return if ( ! $headstr ) ;
 
-	my $size  = $s_fir->{$m_uid}->{'RFC822.SIZE'} ;
-	my $flags = $s_fir->{$m_uid}->{'FLAGS'} ;
-	my $idate = $s_fir->{$m_uid}->{'INTERNALDATE'} ;
-	$size = length $headstr  unless ( $size ) ;
-	my $m_md5 = md5_base64( $headstr ) ;
-	$debug and myprint( "$side uid $m_uid sig $m_md5 size $size idate $idate\n"  ) ;
-	my $key ;
+        my $size  = $s_fir->{$m_uid}->{'RFC822.SIZE'} ;
+        my $flags = $s_fir->{$m_uid}->{'FLAGS'} ;
+        my $idate = $s_fir->{$m_uid}->{'INTERNALDATE'} ;
+        $size = length $headstr  unless ( $size ) ;
+        my $m_md5 = md5_base64( $headstr ) ;
+        $debug and myprint( "$side uid $m_uid sig $m_md5 size $size idate $idate\n"  ) ;
+        my $key ;
         if ($skipsize) {
                 $key = "$m_md5";
         }
-	else {
+        else {
                 $key = "$m_md5:$size";
         }
-	# 0 return code is used to identify duplicate message hash
-	return 0 if exists $s_hash->{"$key"};
-	$s_hash->{"$key"}{'5'} = $m_md5;
-	$s_hash->{"$key"}{'s'} = $size;
-	$s_hash->{"$key"}{'D'} = $idate;
-	$s_hash->{"$key"}{'F'} = $flags;
-	$s_hash->{"$key"}{'m'} = $m_uid;
+        # 0 return code is used to identify duplicate message hash
+        return 0 if exists $s_hash->{"$key"};
+        $s_hash->{"$key"}{'5'} = $m_md5;
+        $s_hash->{"$key"}{'s'} = $size;
+        $s_hash->{"$key"}{'D'} = $idate;
+        $s_hash->{"$key"}{'F'} = $flags;
+        $s_hash->{"$key"}{'m'} = $m_uid;
 
-	return( 1 ) ;
+        return( 1 ) ;
 }
 
 sub header_construct {
 
-	my( $head, $side, $m_uid ) = @_ ;
+        my( $head, $side, $m_uid ) = @_ ;
 
         my $headstr ;
-	foreach my $h ( sort keys  %{ $head }  ) {
+        foreach my $h ( sort keys  %{ $head }  ) {
                 next if ( not ( exists $useheader{ uc  $h  } )
                       and ( not exists  $useheader{ 'ALL' } )
                 ) ;
-		foreach my $val ( sort @{$head->{$h}} ) {
+                foreach my $val ( sort @{$head->{$h}} ) {
 
                         my $H = header_line_normalize( $h, $val ) ;
 
-			# show stuff in debug mode
-			$debug and myprint( "$side uid $m_uid header [$H]", "\n"  ) ;
+                        # show stuff in debug mode
+                        $debug and myprint( "$side uid $m_uid header [$H]", "\n"  ) ;
 
-			if ($skipheader and $H =~ m/$skipheader/xi) {
-				$debug and myprint( "$side uid $m_uid skipping header [$H]\n"  ) ;
-				next ;
-			}
-			$headstr .= "$H" ;
-		}
-	}
-	return( $headstr ) ;
+                        if ($skipheader and $H =~ m/$skipheader/xi) {
+                                $debug and myprint( "$side uid $m_uid skipping header [$H]\n"  ) ;
+                                next ;
+                        }
+                        $headstr .= "$H" ;
+                }
+        }
+        return( $headstr ) ;
 }
 
 
 sub header_line_normalize {
-	my( $header_key,  $header_val ) = @_ ;
+        my( $header_key,  $header_val ) = @_ ;
 
         # no 8-bit data in headers !
         $header_val =~ s/[\x80-\xff]/X/xog;
@@ -7312,20 +8506,23 @@ sub header_line_normalize {
 
         my $header_line = uc "$header_key: $header_val" ;
 
-	return( $header_line ) ;
+        return( $header_line ) ;
 }
 
 sub tests_header_line_normalize {
+	note( 'Entering tests_header_line_normalize()' ) ;
 
-	ok( ': ' eq header_line_normalize( q{}, q{} ), 'header_line_normalize: empty args' ) ;
-	ok( 'HHH: VVV' eq header_line_normalize( 'hhh', 'vvv' ), 'header_line_normalize: hhh vvv ' ) ;
-	ok( 'HHH: VVV' eq header_line_normalize( 'hhh', '  vvv' ), 'header_line_normalize: remove first blancs' ) ;
-	ok( 'HHH: AA BB CCC D' eq header_line_normalize( 'hhh', 'aa  bb   ccc d' ), 'header_line_normalize: remove succesive blanks' ) ;
-	ok( 'HHH: AA BB CCC' eq header_line_normalize( 'hhh', 'aa  bb   ccc   ' ), 'header_line_normalize: remove last blanks' ) ;
-	ok( 'HHH: VVV XX YY' eq header_line_normalize( 'hhh', "vvv\t\txx\tyy" ), 'header_line_normalize: tabs' ) ;
-	ok( 'HHH: XABX' eq header_line_normalize( 'hhh', "\x80AB\xff" ), 'header_line_normalize: 8bit' ) ;
 
-	return ;
+        ok( ': ' eq header_line_normalize( q{}, q{} ), 'header_line_normalize: empty args' ) ;
+        ok( 'HHH: VVV' eq header_line_normalize( 'hhh', 'vvv' ), 'header_line_normalize: hhh vvv ' ) ;
+        ok( 'HHH: VVV' eq header_line_normalize( 'hhh', '  vvv' ), 'header_line_normalize: remove first blancs' ) ;
+        ok( 'HHH: AA BB CCC D' eq header_line_normalize( 'hhh', 'aa  bb   ccc d' ), 'header_line_normalize: remove succesive blanks' ) ;
+        ok( 'HHH: AA BB CCC' eq header_line_normalize( 'hhh', 'aa  bb   ccc   ' ), 'header_line_normalize: remove last blanks' ) ;
+        ok( 'HHH: VVV XX YY' eq header_line_normalize( 'hhh', "vvv\t\txx\tyy" ), 'header_line_normalize: tabs' ) ;
+        ok( 'HHH: XABX' eq header_line_normalize( 'hhh', "\x80AB\xff" ), 'header_line_normalize: 8bit' ) ;
+
+	note( 'Leaving  tests_header_line_normalize()' ) ;
+        return ;
 }
 
 
@@ -7334,9 +8531,14 @@ sub firstline {
 
         my( $file ) = @_ ;
         my $line  = q{} ;
-        my $FILE ;
-        open $FILE, '<', $file or do {
-                myprint( "Error opening file $file : $!\n" ) ;
+
+	if ( ! -e $file ) {
+                myprint( "Cannot open file $file since it does not exist\n" ) ;
+                return ;
+	}
+
+        open my $FILE, '<', $file or do {
+                myprint( "Error opening file $file : $OS_ERROR\n" ) ;
                 return ;
         } ;
         $line = <$FILE> || q{} ;
@@ -7346,34 +8548,113 @@ sub firstline {
 }
 
 sub tests_firstline {
-        is( 1 , string_to_file( "blabla\n", 'tmp/firstline.txt' ), 'tests_firstline: put blabla in tmp/firstline.txt' ) ;
-        is( 'blabla' , firstline( 'tmp/firstline.txt' ), 'tests_firstline: get blabla from tmp/firstline.txt' ) ;
-        is( undef , firstline( 'tmp/noexist.txt' ), 'tests_firstline: get blabla from tmp/noexist.txt' ) ;
-        is( 1 , string_to_file( q{}, 'tmp/firstline2.txt' ), 'tests_firstline: put empty string in tmp/firstline2.txt' ) ;
-        is( q{} , firstline( 'tmp/firstline2.txt' ), 'tests_firstline: get empty string from tmp/firstline2.txt' ) ;
-        is( 1 , string_to_file( "\n", 'tmp/firstline3.txt' ), 'tests_firstline: put CR in tmp/firstline3.txt' ) ;
-        is( q{} , firstline( 'tmp/firstline3.txt' ), 'tests_firstline: get empty string from tmp/firstline3.txt' ) ;
+	note( 'Entering tests_firstline()' ) ;
 
+        is( undef , firstline( 'W/tmp/tests/noexist.txt' ), 'tests_firstline: not getting blabla from W/tmp/tests/noexist.txt' ) ;
+        is( "blabla\n" , string_to_file( "blabla\n", 'W/tmp/tests/firstline.txt' ), 'tests_firstline: put blabla in W/tmp/tests/firstline.txt' ) ;
+        is( 'blabla' , firstline( 'W/tmp/tests/firstline.txt' ), 'tests_firstline: get blabla from W/tmp/tests/firstline.txt' ) ;
+        is( q{} , string_to_file( q{}, 'W/tmp/tests/firstline2.txt' ), 'tests_firstline: put empty string in W/tmp/tests/firstline2.txt' ) ;
+        is( q{} , firstline( 'W/tmp/tests/firstline2.txt' ), 'tests_firstline: get empty string from W/tmp/tests/firstline2.txt' ) ;
+        is( "\n" , string_to_file( "\n", 'W/tmp/tests/firstline3.txt' ), 'tests_firstline: put CR in W/tmp/tests/firstline3.txt' ) ;
+        is( q{} , firstline( 'W/tmp/tests/firstline3.txt' ), 'tests_firstline: get empty string from W/tmp/tests/firstline3.txt' ) ;
+
+	note( 'Leaving  tests_firstline()' ) ;
         return ;
 }
 
 
-sub file_to_string {
-	my( $file ) = @_ ;
-	my @string ;
-	open my $FILE, '<', $file or die_clean( "Error with file $file : $! " ) ;
-	@string = <$FILE> ;
-	close $FILE ;
-	return( join q{}, @string ) ;
+
+# Should be unit tested and then be used by file_to_string, refactoring file_to_string
+sub file_to_array {
+
+        my( $file ) = shift ;
+        my @string ;
+
+        open my $FILE, '<', $file or do {
+		myprint( "Error reading file $file : $OS_ERROR" ) ;
+		return ;
+	} ;
+        @string = <$FILE> ;
+        close $FILE ;
+        return( @string ) ;
 }
 
 
+sub tests_file_to_string {
+	note( 'Entering tests_file_to_string()' ) ;
+
+	is( undef, file_to_string(  ), 'file_to_string: no args => undef' ) ;
+	is( undef, file_to_string( '/noexist' ), 'file_to_string: /noexist => undef' ) ;
+	is( undef, file_to_string( '/' ), 'file_to_string: reading a directory => undef' ) ;
+	ok( file_to_string( $PROGRAM_NAME ), 'file_to_string: reading myself' ) ;
+
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'file_to_string: mkpath W/tmp/tests/' ) ;
+
+	is( 'lilili', string_to_file( 'lilili', 'W/tmp/tests/canbewritten' ), 'file_to_string: string_to_file filling W/tmp/tests/canbewritten with lilili' ) ;
+	is( 'lilili', file_to_string( 'W/tmp/tests/canbewritten' ), 'file_to_string: reading W/tmp/tests/canbewritten is lilili' ) ;
+
+	is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'file_to_string: string_to_file filling W/tmp/tests/empty with empty string' ) ;
+	is( q{}, file_to_string( 'W/tmp/tests/empty' ), 'file_to_string: reading W/tmp/tests/empty is empty' ) ;
+
+	note( 'Leaving  tests_file_to_string()' ) ;
+	return ;
+}
+
+sub file_to_string {
+        my  $file  = shift ;
+	if ( ! $file ) { return ; }
+	if ( ! -e $file ) { return ; }
+	if ( ! -f $file ) { return ; }
+	if ( ! -r $file ) { return ; }
+        my @string ;
+        if ( open my $FILE, '<', $file ) {
+		@string = <$FILE> ;
+		close $FILE ;
+		return( join q{}, @string ) ;
+	}else{
+		myprint( "Error reading file $file : $OS_ERROR\n" ) ;
+		return ;
+	}
+}
+
+
+sub tests_string_to_file {
+	note( 'Entering tests_string_to_file()' ) ;
+
+	is( undef, string_to_file(  ),         'string_to_file: no args => undef' ) ;
+	is( undef, string_to_file( 'lalala' ), 'string_to_file: one arg => undef' ) ;
+	is( undef, string_to_file( 'lalala', '.' ), 'string_to_file: writing a directory => undef' ) ;
+	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'string_to_file: mkpath W/tmp/tests/' ) ;
+	is( 'lalala', string_to_file( 'lalala', 'W/tmp/tests/canbewritten' ), 'string_to_file: W/tmp/tests/canbewritten with lalala' ) ;
+	is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'string_to_file: W/tmp/tests/empty with empty string' ) ;
+
+	SKIP: {
+                Readonly my $NB_UNX_tests_string_to_file => 1 ;
+                skip( 'Not on Unix', $NB_UNX_tests_string_to_file ) if ('MSWin32' eq $OSNAME) ;
+		is( undef, string_to_file( 'lalala', '/cantouch' ), 'string_to_file: /cantouch denied => undef' ) ;
+	}
+
+	note( 'Leaving  tests_string_to_file()' ) ;
+	return ;
+}
+
 sub string_to_file {
-	my( $string, $file ) = @_ ;
-	sysopen( FILE, $file, O_WRONLY|O_TRUNC|O_CREAT, 0600) or die_clean( "$! $file" ) ;
-	print FILE $string ;
-	close FILE ;
-	return 1 ;
+        my( $string, $file ) = @_ ;
+	if( ! defined $string ) { return ; }
+	if( ! defined $file )   { return ; }
+
+	if ( ! -e $file && ! -w dirname( $file ) ) {
+		myprint( "string_to_file: directory of $file is not writable\n" ) ;
+		return ;
+	}
+
+        if ( ! sysopen( FILE, $file, O_WRONLY|O_TRUNC|O_CREAT, 0600) ) {
+		myprint( "string_to_file: failure writing to $file with error: $OS_ERROR\n" ) ;
+		return ;
+	}
+        print FILE $string ;
+        close FILE ;
+        return $string ;
 }
 
 q^
@@ -7383,18 +8664,18 @@ Based on David Carter discussion, to do:
 * Now always "return( $string, $error )". Descriptions below.
 OK * Still    capture STDOUT via "1> $output_tmpfile" to finish in $string and "return( $string, $error )"
 OK * Now also capture STDERR via "2> $error_tmpfile"  to finish in $error  and "return( $string, $error )"
-OK * in case of CHILD_ERROR, return( undef, $error ) 
+OK * in case of CHILD_ERROR, return( undef, $error )
   and print $error, with folder/UID/maybeSubject context,
   on console and at the end with the final error listing. Count this as a sync error.
 * in case of good command, take final $string as is, unless void. In case $error with value then print it.
 * in case of good command and final $string empty, consider it like CHILD_ERROR =>
   return( undef, $error ) and print $error, with folder/UID/maybeSubject context,
-  on console and at the end with the final error listing. Count this as a sync error. 
+  on console and at the end with the final error listing. Count this as a sync error.
 ^ if 0 ; # End of multiline comment.
 
 sub pipemess {
-	my ( $string, @commands ) = @_ ;
-	my $error = q{} ;
+        my ( $string, @commands ) = @_ ;
+        my $error = q{} ;
         foreach my $command ( @commands ) {
                 my $input_tmpfile  = "$tmpdir/imapsync_tmp_file.$PROCESS_ID.inp.txt" ;
                 my $output_tmpfile = "$tmpdir/imapsync_tmp_file.$PROCESS_ID.out.txt" ;
@@ -7404,22 +8685,22 @@ sub pipemess {
                 my $is_command_ko = $CHILD_ERROR ;
                 my $error_cmd = file_to_string( $error_tmpfile ) ;
                 chomp( $error_cmd ) ;
-		$string = file_to_string( $output_tmpfile ) ;
+                $string = file_to_string( $output_tmpfile ) ;
                 my $string_len = length( $string ) ;
                 unlink $input_tmpfile, $output_tmpfile, $error_tmpfile ;
 
-		if ( $is_command_ko or ( ! $string_len ) ) {
-			my $cmd_exit_value = $CHILD_ERROR >> 8 ;
-			my $cmd_end_signal = $CHILD_ERROR & 127 ;
+                if ( $is_command_ko or ( ! $string_len ) ) {
+                        my $cmd_exit_value = $CHILD_ERROR >> 8 ;
+                        my $cmd_end_signal = $CHILD_ERROR & 127 ;
                         my $signal_log = ( $cmd_end_signal ) ? " signal $cmd_end_signal and" : q{} ;
                         my $error_log = qq{Failure: --pipemess command "$command" ended with$signal_log "$string_len" characters exit value "$cmd_exit_value" and STDERR "$error_cmd"\n} ;
-			myprint( $error_log ) ;
-			if ( wantarray ) {
+                        myprint( $error_log ) ;
+                        if ( wantarray ) {
                                 return @{ [ undef, $error_log ] }
                         }else{
                                 return ;
                         }
-		}
+                }
                 if ( $error_cmd ) {
                         $error .= qq{STDERR of --pipemess "$command": $error_cmd\n} ;
                         myprint(  qq{STDERR of --pipemess "$command": $error_cmd\n} ) ;
@@ -7436,39 +8717,41 @@ sub pipemess {
 
 
 sub tests_pipemess {
+	note( 'Entering tests_pipemess()' ) ;
 
-	SKIP: {
+
+        SKIP: {
                 Readonly my $NB_WIN_tests_pipemess => 3 ;
-		skip( 'Not on MSWin32', $NB_WIN_tests_pipemess ) if ('MSWin32' ne $OSNAME) ;
-		# Windows
-		# "type" command does not accept redirection of STDIN with <
-		# "sort" does
-		ok( "nochange\n" eq pipemess( 'nochange', 'sort' ), 'pipemess: nearly no change by sort' ) ;
-		ok( "nochange2\n" eq pipemess( 'nochange2', qw( sort sort ) ), 'pipemess: nearly no change by sort,sort' ) ;
-		# command not found
-		#diag( 'Warning and failure about cacaprout are on purpose' ) ;
-		ok( ! defined( pipemess( q{}, 'cacaprout' ) ), 'pipemess: command not found' ) ;
+                skip( 'Not on MSWin32', $NB_WIN_tests_pipemess ) if ('MSWin32' ne $OSNAME) ;
+                # Windows
+                # "type" command does not accept redirection of STDIN with <
+                # "sort" does
+                ok( "nochange\n" eq pipemess( 'nochange', 'sort' ), 'pipemess: nearly no change by sort' ) ;
+                ok( "nochange2\n" eq pipemess( 'nochange2', qw( sort sort ) ), 'pipemess: nearly no change by sort,sort' ) ;
+                # command not found
+                #diag( 'Warning and failure about cacaprout are on purpose' ) ;
+                ok( ! defined( pipemess( q{}, 'cacaprout' ) ), 'pipemess: command not found' ) ;
 
-	} ;
+        } ;
 
         my ( $stringT, $errorT ) ;
 
-	SKIP: {
+        SKIP: {
                 Readonly my $NB_UNX_tests_pipemess => 25 ;
-		skip( 'Not on Unix', $NB_UNX_tests_pipemess ) if ('MSWin32' eq $OSNAME) ;
-		# Unix
-		ok( 'nochange' eq pipemess( 'nochange', 'cat' ), 'pipemess: no change by cat' ) ;
+                skip( 'Not on Unix', $NB_UNX_tests_pipemess ) if ('MSWin32' eq $OSNAME) ;
+                # Unix
+                ok( 'nochange' eq pipemess( 'nochange', 'cat' ), 'pipemess: no change by cat' ) ;
 
-		ok( 'nochange2' eq pipemess( 'nochange2', 'cat', 'cat' ), 'pipemess: no change by cat,cat' ) ;
+                ok( 'nochange2' eq pipemess( 'nochange2', 'cat', 'cat' ), 'pipemess: no change by cat,cat' ) ;
 
-		ok( "     1\tnumberize\n" eq pipemess( "numberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
-		ok( "     1\tnumberize\n     2\tnumberize\n" eq pipemess( "numberize\nnumberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
+                ok( "     1\tnumberize\n" eq pipemess( "numberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
+                ok( "     1\tnumberize\n     2\tnumberize\n" eq pipemess( "numberize\nnumberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
 
-		ok( "A\nB\nC\n" eq pipemess( "A\nC\nB\n", 'sort' ), 'pipemess: sort' ) ;
+                ok( "A\nB\nC\n" eq pipemess( "A\nC\nB\n", 'sort' ), 'pipemess: sort' ) ;
 
-		# command not found
-		#diag( 'Warning and failure about cacaprout are on purpose' ) ;
-		is( undef, pipemess( q{}, 'cacaprout' ), 'pipemess: command not found' ) ;
+                # command not found
+                #diag( 'Warning and failure about cacaprout are on purpose' ) ;
+                is( undef, pipemess( q{}, 'cacaprout' ), 'pipemess: command not found' ) ;
 
                 # success with true but no output at all
                 is( undef, pipemess( q{blabla}, 'true' ), 'pipemess: true but no output' ) ;
@@ -7476,376 +8759,714 @@ sub tests_pipemess {
                 # failure with false and no output at all
                 is( undef, pipemess( q{blabla}, 'false' ), 'pipemess: false and no output' ) ;
 
-		# Failure since pipemess is not a real pipe, so first cat wait for standard input
-		is( q{blabla}, pipemess( q{blabla}, '( cat|cat ) ' ), 'pipemess: ok by ( cat|cat )' ) ;
+                # Failure since pipemess is not a real pipe, so first cat wait for standard input
+                is( q{blabla}, pipemess( q{blabla}, '( cat|cat ) ' ), 'pipemess: ok by ( cat|cat )' ) ;
 
 
                 ( $stringT, $errorT ) = pipemess( 'nochange', 'cat' ) ;
                 is( $stringT, 'nochange', 'pipemess: list context, no change by cat, string' ) ;
                 is( $errorT, q{}, 'pipemess: list context, no change by cat, no error' ) ;
-                
+
                 ( $stringT, $errorT ) = pipemess( 'dontcare', 'true' ) ;
                 is( $stringT, undef, 'pipemess: list context, true but no output, string' ) ;
-                like( $errorT, qr{Failure: --pipemess command "true" ended with "0" characters exit value "0" and STDERR ""},  'pipemess: list context, true but no output, error' ) ;
+                like( $errorT, qr{\QFailure: --pipemess command "true" ended with "0" characters exit value "0" and STDERR ""\E}xm,  'pipemess: list context, true but no output, error' ) ;
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', 'false' ) ;
                 is( $stringT, undef, 'pipemess: list context, false and no output, string' ) ;
-                like( $errorT, qr{Failure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""},  'pipemess: list context, false and no output, error' ) ;
+                like( $errorT, qr{\QFailure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""\E}xm,
+		'pipemess: list context, false and no output, error' ) ;
 
-                ( $stringT, $errorT ) = pipemess( 'dontcare', 'echo -n blablabla' ) ;
+                ( $stringT, $errorT ) = pipemess( 'dontcare', '/bin/echo -n blablabla' ) ;
                 is( $stringT, q{blablabla}, 'pipemess: list context, "echo -n blablabla", string' ) ;
                 is( $errorT, q{},  'pipemess: list context, "echo blablabla", error' ) ;
 
-                
+
                 ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo -n blablabla 3>&1 1>&2 2>&3 )' ) ;
                 is( $stringT, undef, 'pipemess: list context, "no output STDERR blablabla", string' ) ;
-                like( $errorT,  qr{blablabla"$},  'pipemess: list context, "no output STDERR blablabla", error' ) ;
+                like( $errorT,  qr{blablabla"}xm,  'pipemess: list context, "no output STDERR blablabla", error' ) ;
 
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo -n blablabla 3>&1 1>&2 2>&3 )', 'false' ) ;
                 is( $stringT, undef, 'pipemess: list context, "no output STDERR blablabla then false", string' ) ;
-                like( $errorT,  qr{blablabla"$},  'pipemess: list context, "no output STDERR blablabla then false", error' ) ;
+                like( $errorT,  qr{blablabla"}xm,  'pipemess: list context, "no output STDERR blablabla then false", error' ) ;
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', 'false', '( echo -n blablabla 3>&1 1>&2 2>&3 )' ) ;
                 is( $stringT, undef, 'pipemess: list context, "false then STDERR blablabla", string' ) ;
-                like( $errorT,  qr{Failure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""},  'pipemess: list context, "false then STDERR blablabla", error' ) ;
+                like( $errorT,  qr{\QFailure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""\E}xm,
+		'pipemess: list context, "false then STDERR blablabla", error' ) ;
 
                 ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo rrrrr ; echo -n error_blablabla 3>&1 1>&2 2>&3 )' ) ;
-                like( $stringT, qr{rrrrr}, 'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", string' ) ;
-                like( $errorT,  qr{STDERR.*error_blablabla},  'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", error' ) ;
+                like( $stringT, qr{rrrrr}xm, 'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", string' ) ;
+                like( $errorT,  qr{STDERR.*error_blablabla}xm,  'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", error' ) ;
 
-	}
+        }
 
         ( $stringT, $errorT ) = pipemess( 'dontcare', 'cacaprout' ) ;
         is( $stringT, undef, 'pipemess: list context, cacaprout not found, string' ) ;
-        like( $errorT, qr{Failure: --pipemess command "cacaprout" ended with "0" characters exit value.*}, 'pipemess: list context, cacaprout not found, error' ) ;
+        like( $errorT, qr{\QFailure: --pipemess command "cacaprout" ended with "0" characters exit value\E}xm,
+	'pipemess: list context, cacaprout not found, error' ) ;
 
-	return ;
+	note( 'Leaving  tests_pipemess()' ) ;
+        return ;
 }
 
+
+
 sub tests_is_a_release_number {
-	ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_1), 'is_a_release_number 1.351') ;
-	ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_2), 'is_a_release_number 42.4242') ;
-	ok(is_a_release_number(imapsync_version()), 'is_a_release_number imapsync_version()') ;
-	ok(! is_a_release_number('blabla' ), '! is_a_release_number blabla') ;
-	return ;
+	note( 'Entering tests_is_a_release_number()' ) ;
+
+        ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_1), 'is_a_release_number 1.351') ;
+        ok(is_a_release_number($RELEASE_NUMBER_EXAMPLE_2), 'is_a_release_number 42.4242') ;
+        ok(is_a_release_number( imapsync_version( $sync ) ), 'is_a_release_number imapsync_version(  )') ;
+        ok(! is_a_release_number('blabla' ), '! is_a_release_number blabla') ;
+
+	note( 'Leaving  tests_is_a_release_number()' ) ;
+        return ;
 }
 
 sub is_a_release_number {
-	my $number = shift;
-
-	return( $number =~ m{^\d+\.\d+$}xo ) ;
-}
-
-sub check_last_release {
-
-	my $public_release = not_long_imapsync_version_public(  ) ;
-	$debug and myprint( "check_last_release: [$public_release]\n"  ) ;
-	return('unknown') if ($public_release eq 'unknown') ;
-	return('timeout') if ($public_release eq 'timeout') ;
-	return('unknown') if (! is_a_release_number( $public_release ) ) ;
-
-	my $imapsync_here  = imapsync_version();
-
-	if ($public_release > $imapsync_here) {
-		return("New imapsync release $public_release available");
-	}else{
-		return( 'This imapsync is up to date') ;
-	}
-}
-
-sub imapsync_version  {
-	my $rcs_imapsync = '$Id: imapsync,v 1.727 2016/08/19 10:30:36 gilles Exp gilles $ ' ;
-        my $imapsync_version ;
-
-	if ( $rcs_imapsync =~ m{,v\s+(\d+\.\d+)}xo ) {
-		$imapsync_version = $1
-        } else {
-                $imapsync_version = 'UNKNOWN' ;
-        }
-	return( $imapsync_version ) ;
-}
-
-sub tests_imapsync_basename {
-	ok( imapsync_basename() =~ m/imapsync/, 'imapsync_basename: match imapsync');
-	ok( 'blabla'   ne imapsync_basename(), 'imapsync_basename: do not equal blabla');
-	return ;
-}
-
-sub imapsync_basename {
-
-	return basename($0);
+        my $number = shift;
 
+        return( $number =~ m{^\d+\.\d+$}xo ) ;
 }
 
 sub imapsync_version_public {
 
-	my $local_version = imapsync_version();
-	my $imapsync_basename = imapsync_basename();
-	my $agent_info = "$OSNAME system, perl "
-		. mysprintf( '%vd', $PERL_VERSION)
-		. ", Mail::IMAPClient $Mail::IMAPClient::VERSION"
-		. " $imapsync_basename";
-	my $sock = IO::Socket::INET->new(
-		PeerAddr => 'imapsync.lamiral.info',
-		PeerPort => 80,
-		Proto    => 'tcp',
+        my $local_version = imapsync_version( $sync ) ;
+        my $imapsync_basename = imapsync_basename(  ) ;
+        my $agent_info = "$OSNAME system, perl "
+                . mysprintf( '%vd', $PERL_VERSION)
+                . ", Mail::IMAPClient $Mail::IMAPClient::VERSION"
+                . " $imapsync_basename" ;
+        my $sock = IO::Socket::INET->new(
+                PeerAddr => 'imapsync.lamiral.info',
+                PeerPort => 80,
+                Proto    => 'tcp',
                 ) ;
-	return( 'unknown' ) if not $sock ;
-	print $sock
-		"GET /prj/imapsync/VERSION HTTP/1.0\n",
-		"User-Agent: imapsync/$local_version ($agent_info)\n",
-		"Host: ks.lamiral.info\n\n";
-	my @line = <$sock>;
-	close $sock ;
-	my $last_release = $line[$LAST];
-	chomp $last_release ;
-	return($last_release) ;
+        return( 'unknown' ) if not $sock ;
+        print $sock
+                "GET /prj/imapsync/VERSION HTTP/1.0\r\n",
+                "User-Agent: imapsync/$local_version ($agent_info)\r\n",
+                "Host: ks.lamiral.info\r\n\r\n" ;
+        my @line = <$sock> ;
+        close $sock ;
+        my $last_release = $line[$LAST] ;
+        chomp $last_release ;
+        return( $last_release ) ;
 }
 
-sub not_long_imapsync_version_public {
-	#myprint( "Entering not_long_imapsync_version_public\n" ) ;
+sub not_long_imapsync_version_public  {
+        #myprint( "Entering not_long_imapsync_version_public\n" ) ;
 
-	my $val;
+	my $fake = shift ;
+	if ( $fake ) { return $fake }
 
-	# Doesn't work with gethostbyname (see perlipc)
-	#local $SIG{ALRM} = sub { die "alarm\n" };
+        my $val ;
 
-	if ('MSWin32' eq $OSNAME) {
-		local $SIG{ALRM} = sub { die "alarm\n" };
-	}else{
+        # Doesn't work with gethostbyname (see perlipc)
+        #local $SIG{ALRM} = sub { die "alarm\n" } ;
 
-        	POSIX::sigaction(SIGALRM,
+        if ('MSWin32' eq $OSNAME) {
+                local $SIG{ALRM} = sub { die "alarm\n" } ;
+        }else{
+
+                POSIX::sigaction(SIGALRM,
                          POSIX::SigAction->new(sub { croak 'alarm' } ) )
-        		or myprint( "Error setting SIGALRM handler: $!\n"  ) ;
-	}
+                        or myprint( "Error setting SIGALRM handler: $OS_ERROR\n"  ) ;
+        }
 
-	my $ret = eval {
-		alarm 3 ;
-		{
-			$val = imapsync_version_public(  ) ;
+        my $ret = eval {
+                alarm 3 ;
+                {
+                        $val = imapsync_version_public(  ) ;
                         #sleep 4 ;
-			#myprint( "End of imapsync_version_public\n"  ) ;
-		}
-		alarm 0 ;
+                        #myprint( "End of imapsync_version_public\n"  ) ;
+                }
+                alarm 0 ;
                 1 ;
-	} ;
+        } ;
         #myprint( "eval [$ret]\n"  ) ;
-	if ( ( not $ret ) or $@ ) {
-		#myprint( "$@" ) ;
-		if ($@ =~ /alarm/) {
-		# timed out
-			return('timeout');
-		}else{
-			alarm 0 ;
-			return('unknown'); # propagate unexpected errors
-		}
-	}else {
-	# Good!
-		return($val);
-	}
+        if ( ( not $ret ) or $EVAL_ERROR ) {
+                #myprint( "$EVAL_ERROR" ) ;
+                if ($EVAL_ERROR =~ /alarm/) {
+                # timed out
+                        return('timeout') ;
+                }else{
+                        alarm 0 ;
+                        return( 'unknown' ) ; # propagate unexpected errors
+                }
+        }else {
+        # Good!
+                return( $val ) ;
+        }
 }
 
+sub tests_not_long_imapsync_version_public {
+	note( 'Entering tests_not_long_imapsync_version_public()' ) ;
+
+
+	is( 1, is_a_release_number( not_long_imapsync_version_public(  ) ),
+		'not_long_imapsync_version_public: public release is a number' ) ;
+
+	note( 'Leaving  tests_not_long_imapsync_version_public()' ) ;
+	return ;
+}
+
+sub check_last_release {
+	my $fake = shift ;
+        my $public_release = not_long_imapsync_version_public( $fake ) ;
+        $debug and myprint( "check_last_release: [$public_release]\n"  ) ;
+        return( 'Imapsync public release is unknown' ) if ( $public_release eq 'unknown' ) ;
+        return( 'Imapsync public release is unknown (timeout)' ) if ( $public_release eq 'timeout' ) ;
+        return( "Imapsync public release is unknown ($public_release)" ) if ( ! is_a_release_number( $public_release ) ) ;
+
+        my $imapsync_here  = imapsync_version( $sync ) ;
+
+        if ( $public_release > $imapsync_here ) {
+                return(
+			"New imapsync release $public_release available to replace this $imapsync_here\n"
+			. "Get it at https://imapsync.lamiral.info/dist/") ;
+        }else{
+                return( 'This imapsync is up to date. ' . "( local $imapsync_here >= official $public_release )") ;
+        }
+
+	return('really unknown') ; # Should never arrive here
+}
+
+sub tests_check_last_release {
+	note( 'Entering tests_check_last_release()' ) ;
+
+	diag( check_last_release( 1.1 ) ) ;
+	like( check_last_release( 1.1 ), qr/\Qup to date\E/mxs, 'check_last_release: up to date' ) ;
+	like( check_last_release( 1.1 ), qr/1\.1/mxs, 'check_last_release: up to date, include number' ) ;
+	diag( check_last_release( 999.999 ) ) ;
+	like( check_last_release( 999.999 ), qr/available/mxs, 'check_last_release: update available' ) ;
+	like( check_last_release( 999.999 ), qr/999\.999/mxs, 'check_last_release: update available, include number' ) ;
+	diag( check_last_release(  ) ) ;
+	is( 'Imapsync public release is unknown', check_last_release( 'unknown' ), 'check_last_release: unknown' ) ;
+	is( 'Imapsync public release is unknown (timeout)', check_last_release( 'timeout' ), 'check_last_release: timeout' ) ;
+	is( 'Imapsync public release is unknown (lalala)', check_last_release( 'lalala' ), 'check_last_release: lalala' ) ;
+
+	note( 'Leaving  tests_check_last_release()' ) ;
+	return ;
+}
+
+sub imapsync_version  {
+        my $mysync = shift ;
+        my $rcs = $mysync->{rcs} ;
+        my $imapsync_version ;
+
+        $imapsync_version = version_from_rcs( $rcs ) ;
+        
+        return( $imapsync_version ) ;
+}
+
+
+sub tests_version_from_rcs {
+	note( 'Entering tests_version_from_rcs()' ) ;
+
+	is( undef, version_from_rcs(  ), 'version_from_rcs: no args => UNKNOWN' ) ;
+	is( 1.831, version_from_rcs( q{imapsync,v 1.831 2017/08/27} ), 'version_from_rcs: imapsync,v 1.831 2017/08/27 => 1.831' ) ;
+	is( 'UNKNOWN', version_from_rcs( 1.831 ), 'version_from_rcs:  1.831  => UNKNOWN' ) ;
+
+	note( 'Leaving  tests_version_from_rcs()' ) ;
+	return ;
+}
+
+
+sub version_from_rcs {
+
+        my $rcs = shift ;
+        if ( ! $rcs ) { return ; }
+        
+        my $version = 'UNKNOWN' ;
+
+        if ( $rcs =~ m{,v\s+(\d+\.\d+)}mxso ) {
+                $version = $1
+        }
+        
+        return( $version ) ;
+}
+
+
+sub tests_imapsync_basename {
+	note( 'Entering tests_imapsync_basename()' ) ;
+
+        ok( imapsync_basename() =~ m/imapsync/, 'imapsync_basename: match imapsync');
+        ok( 'blabla'   ne imapsync_basename(), 'imapsync_basename: do not equal blabla');
+
+	note( 'Leaving  tests_imapsync_basename()' ) ;
+        return ;
+}
+
+sub imapsync_basename  {
+
+        return basename( $PROGRAM_NAME ) ;
+
+}
+
+
 sub localhost_info {
 
-	my($infos) = join q{},
-	    "Here is a [$OSNAME] system (",
-	    join(q{ },
-	         uname(),
-	         ),
+        my( $infos ) = join q{},
+            "Here is " . hostname() . ", a " . memory_available(  ) . " [$OSNAME] system (",
+            join(q{ },
+                 uname(),
+                 ),
                  ")\n",
-	         'with Perl ',
-	         mysprintf( '%vd', $PERL_VERSION),
-	         " Mail::IMAPClient $Mail::IMAPClient::VERSION",
+                 'with Perl ',
+                 mysprintf( '%vd ', $PERL_VERSION),
+                 "and Mail::IMAPClient $Mail::IMAPClient::VERSION",
              ;
-	return($infos) ;
+        return( $infos ) ;
 }
 
+sub tests_cpu_number {
+	note( 'Entering tests_cpu_number()' ) ;
+
+	ok( 1 <= cpu_number(  ), "cpu_number: 1 or more" ) ;
+
+	note( 'Leaving  tests_cpu_number()' ) ;
+	return ;
+}
+
+sub cpu_number {
+	my @cpuinfo ;
+
+	# Well, here 1 is better than 0 or undef
+	my $cpu_number = 1 ; # Default value, erased if better found
+
+	if ( $ENV{"NUMBER_OF_PROCESSORS"} ) {
+		# might be under a Windows system
+		$cpu_number = $ENV{"NUMBER_OF_PROCESSORS"} ;
+		$debug and myprint( "Number of processors found by envvar NUMBER_OF_PROCESSORS: $cpu_number\n" ) ;
+		return $cpu_number ;
+	}
+
+	if ( 'darwin' eq $OSNAME ) {
+		$cpu_number = `sysctl -n hw.ncpu` ;
+		chomp( $cpu_number ) ;
+		return $cpu_number ;
+	}
+
+	if ( ! -e '/proc/cpuinfo' ) {
+		$debug and myprint( "Number of processors not found so use: $cpu_number\n" ) ;
+		return $cpu_number ;
+	}
+
+	@cpuinfo = file_to_array( '/proc/cpuinfo' ) ;
+	if ( @cpuinfo ) {
+		$cpu_number = grep { /^processor/mxs } @cpuinfo ;
+	}
+	$debug and myprint( "Number of processors found via /proc/cpuinfo: $cpu_number\n" ) ;
+	return $cpu_number ;
+}
+
+
+
+sub tests_loadavg {
+	note( 'Entering tests_loadavg()' ) ;
+
+
+	SKIP: {
+		skip( 'Tests for darwin', 2 ) if ('darwin' ne $OSNAME) ;
+		is( undef, loadavg( '/noexist' ), 'loadavg: /noexist => undef' ) ;
+		is_deeply( [ '0.11', '0.22', '0.33' ],
+		[ loadavg( 'W/t/loadavg.out' ) ],
+		'loadavg W/t/loadavg.out => 0.11 0.22 0.33' ) ;
+	} ;
+
+	SKIP: {
+		skip( 'Tests for linux', 3 ) if ('linux' ne $OSNAME) ;
+		is( undef, loadavg( '/noexist' ), 'loadavg: /noexist => undef' ) ;
+		ok( loadavg( ), 'loadavg: no args' ) ;
+
+		is_deeply( [ '0.39', '0.30', '0.37', '1/602' ],
+		[ loadavg( '0.39 0.30 0.37 1/602 6073' ) ],
+		'loadavg 0.39 0.30 0.37 1/602 6073 => [0.39, 0.30, 0.37, 1/602]' ) ;
+	} ;
+
+	SKIP: {
+		skip( 'Tests for Windows', 1 ) if ('MSWin32' ne $OSNAME) ;
+		is_deeply( [ 0 ],
+		[ loadavg( ) ],
+		'loadavg on MSWin32 => 0' ) ;
+
+	} ;
+
+	note( 'Leaving  tests_loadavg()' ) ;
+	return ;
+}
+
+
+sub loadavg {
+	if ( 'linux' eq $OSNAME ) {
+		return ( loadavg_linux( @ARG ) ) ;
+	}
+	if ( 'darwin' eq $OSNAME ) {
+		return ( loadavg_darwin( @ARG ) ) ;
+	}
+	if ( 'MSWin32' eq $OSNAME ) {
+		return ( loadavg_windows( @ARG ) ) ;
+	}
+	return( 'unknown' ) ;
+
+}
+
+sub loadavg_linux {
+	my $line = shift ;
+
+	if ( ! $line ) {
+                $line = firstline( '/proc/loadavg'  ) or return ;
+	}
+
+	my ( $avg_1_min, $avg_5_min, $avg_15_min, $current_runs ) = split /\s/mxs, $line ;
+	if ( all_defined( $avg_1_min, $avg_5_min, $avg_15_min ) ) {
+		$debug and print "System load: $avg_1_min $avg_5_min $avg_15_min $current_runs\n" ;
+		return ( $avg_1_min, $avg_5_min, $avg_15_min, $current_runs ) ;
+	}
+	return ;
+}
+
+
+sub loadavg_darwin {
+	my $file = shift ;
+	# Example of output of command "sysctl vm.loadavg":
+	# vm.loadavg: { 0.15 0.08 0.08 }
+	my $loadavg ;
+
+	if ( ! defined $file ) {
+		eval {
+			$loadavg = `/usr/sbin/sysctl vm.loadavg` ;
+			#myprint( "LOADAVG DARWIN: $loadavg\n" ) ;
+		} ;
+		if ( $EVAL_ERROR ) { myprint( "[$EVAL_ERROR]\n" ) ; return ; }
+	}else{
+		$loadavg = firstline( $file ) or return ;
+	}
+
+	my ( $avg_1_min, $avg_5_min, $avg_15_min )
+	= $loadavg =~ /vm\.loadavg\s*[:=]\s*\{?\s*(\d+\.?\d*)\s+(\d+\.?\d*)\s+(\d+\.?\d*)/mxs ;
+	$debug and print "System load: $avg_1_min $avg_5_min $avg_15_min\n" ;
+	return ( $avg_1_min, $avg_5_min, $avg_15_min ) ;
+}
+
+sub loadavg_windows {
+	my $file = shift ;
+	# Example of output of command "wmic cpu get loadpercentage":
+	# LoadPercentage
+        # 12
+	my $loadavg ;
+
+	if ( ! defined $file ) {
+		eval {
+			#$loadavg = `CMD wmic cpu get loadpercentage` ;
+			$loadavg = "LoadPercentage\n0\n" ;
+			#myprint( "LOADAVG WIN: $loadavg\n" ) ;
+		} ;
+		if ( $EVAL_ERROR ) { myprint( "[$EVAL_ERROR]\n" ) ; return ; }
+	}else{
+		$loadavg = file_to_string( $file ) or return ;
+		#myprint( "$loadavg" ) ;
+	}
+	$loadavg =~ /LoadPercentage\n(\d+)/xms ;
+	my $num = $1 ;
+	$num /= 100 ;
+
+	$debug and myprint( "System load: $num\n" ) ;
+	return ( $num ) ;
+}
+
+
+
+
+
+
+sub tests_load_and_delay {
+	note( 'Entering tests_load_and_delay()' ) ;
+
+	is( undef, load_and_delay(  ), 'load_and_delay: no args => undef ' ) ;
+	is( undef, load_and_delay( 1 ), 'load_and_delay: not 4 args => undef ' ) ;
+	is( undef, load_and_delay( 0, 1, 1, 1 ), 'load_and_delay: division per 0 => undef ' ) ;
+	is(  0, load_and_delay( 1, 1, 1, 1 ), 'load_and_delay: one core, loads are all 1 => ok ' ) ;
+	is(  0, load_and_delay( 2, 2, 2, 2 ), 'load_and_delay: two core, loads are all 2 => ok ' ) ;
+	is(  0, load_and_delay( 2, 2, 4, 5 ), 'load_and_delay: two core, load1m     is 2 => ok ' ) ;
+
+	is(  0, load_and_delay( 1, 0, 0, 0 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=0 => 0 ' ) ;
+	is(  0, load_and_delay( 1, 0, 0, 2 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=2 => 0 ' ) ;
+	is(  0, load_and_delay( 1, 0, 2, 0 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=0 => 0 ' ) ;
+	is(  0, load_and_delay( 1, 0, 2, 2 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=2 => 0 ' ) ;
+	is(  1, load_and_delay( 1, 2, 0, 0 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
+	is(  1, load_and_delay( 1, 2, 0, 2 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
+	is(  5, load_and_delay( 1, 2, 2, 0 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
+	is( 15, load_and_delay( 1, 2, 2, 2 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;
+
+	is(  0, load_and_delay( 4, 0, 2, 2 ), 'load_and_delay: four core, load1m=0 load5m=2 load15m=2 => 0 ' ) ;
+	is(  1, load_and_delay( 4, 8, 0, 0 ), 'load_and_delay: four core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
+	is(  1, load_and_delay( 4, 8, 0, 2 ), 'load_and_delay: four core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
+	is(  5, load_and_delay( 4, 8, 8, 0 ), 'load_and_delay: four core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
+	is( 15, load_and_delay( 4, 8, 8, 8 ), 'load_and_delay: four core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;
+	is( 15, load_and_delay( 4, 8, 8, 8, 'lalala' ), 'load_and_delay: five arguments is ok' ) ;
+
+	note( 'Leaving  tests_load_and_delay()' ) ;
+	return ;
+}
+
+sub load_and_delay {
+	# Basically return 0 if load is not heavy, ie <= 1 per processor
+
+	if ( 4 > scalar @ARG ) { return ; }
+
+	my ( $cpu_num, $avg_1_min, $avg_5_min, $avg_15_min ) = @ARG ;
+
+	if ( 0 == $cpu_num ) { return ; }
+
+	# Let divide by number of cores
+	( $avg_1_min, $avg_5_min, $avg_15_min ) = map { $_ / $cpu_num } ( $avg_1_min, $avg_5_min, $avg_15_min ) ;
+	# One of avg ok => ok, for now it is a OR
+	if ( $avg_1_min <= 1 ) { return 0 ; }
+	if ( $avg_5_min <= 1 ) { return 1 ; } # Retry in 1 minute
+	if ( $avg_15_min <= 1 ) { return 5 ; } # Retry in 5 minutes
+	return 15 ; # Retry in 15 minutes
+}
+
+sub memory_available {
+	# / ( 1000 ** 3 )
+	return(
+		sprintf( "%.1f GiB", Sys::MemInfo::get("totalmem") / ( 1024 ** 3 ) )
+	) ;
+}
 sub memory_consumption {
-	# memory consumed by imapsync until now in bytes
-	return( ( memory_consumption_of_pids(  ) )[0] );
+        # memory consumed by imapsync until now in bytes
+        return( ( memory_consumption_of_pids(  ) )[0] );
 }
 
 sub tests_memory_consumption {
+	note( 'Entering tests_memory_consumption()' ) ;
 
-	like( memory_consumption(  ),  qr{\d+},'memory_consumption no args') ;
-	like( memory_consumption( 1 ), qr{\d+},'memory_consumption 1') ;
-	like( memory_consumption( $PROCESS_ID ), qr{\d+},"memory_consumption_of_pids $PROCESS_ID") ;
+        like( memory_consumption(  ),  qr{\d+}xms,'memory_consumption no args') ;
+        like( memory_consumption( 1 ), qr{\d+}xms,'memory_consumption 1') ;
+        like( memory_consumption( $PROCESS_ID ), qr{\d+}xms,"memory_consumption_of_pids $PROCESS_ID") ;
 
-	like( memory_consumption_ratio(), qr{\d+},   'memory_consumption_ratio' ) ;
-	like( memory_consumption_ratio(1), qr{\d+},  'memory_consumption_ratio 1' ) ;
-	like( memory_consumption_ratio(10), qr{\d+}, 'memory_consumption_ratio 10' ) ;
+        like( memory_consumption_ratio(), qr{\d+}xms,   'memory_consumption_ratio' ) ;
+        like( memory_consumption_ratio(1), qr{\d+}xms,  'memory_consumption_ratio 1' ) ;
+        like( memory_consumption_ratio(10), qr{\d+}xms, 'memory_consumption_ratio 10' ) ;
 
-	like( memory_consumption(), qr{\d+}, "memory_consumption\n" ) ;
-	return ;
+        like( memory_consumption(), qr{\d+}xms, "memory_consumption\n" ) ;
+
+	note( 'Leaving  tests_memory_consumption()' ) ;
+        return ;
 }
 
 
 
 sub memory_consumption_of_pids {
 
-	my @pid = @_;
-	@pid = (@pid) ? @pid : ($PROCESS_ID) ;
+        my @pid = @_;
+        @pid = (@pid) ? @pid : ($PROCESS_ID) ;
 
-	#myprint( "PIDs: @pid\n" ) ;
-	my @val;
-	if ('MSWin32' eq $OSNAME) {
-		@val = memory_consumption_of_pids_win32(@pid);
-	}else{
-		# Unix
-		my @ps = qx{ ps -o vsz -p @pid } ;
+        #myprint( "PIDs: @pid\n" ) ;
+        my @val;
+        if ('MSWin32' eq $OSNAME) {
+                @val = memory_consumption_of_pids_win32(@pid);
+        }else{
+                # Unix
+                my @ps = qx{ ps -o vsz -p @pid } ;
                 #myprint( @ps ) ;
                 #my @ps = backtick( "ps -o vsz -p @pid" ) ;
-		shift @ps; # First line is column name "VSZ"
-		chomp @ps;
-		# convert to octets
-                
-		@val = map { $_ * $KIBI } @ps;
-	}
-	return( @val ) ;
+                shift @ps; # First line is column name "VSZ"
+                chomp @ps;
+                # convert to octets
+
+                @val = map { $_ * $KIBI } @ps;
+        }
+        return( @val ) ;
 }
 
 sub memory_consumption_of_pids_win32 {
-	# Windows
-	my @PID = @_;
-	my %PID;
-	# hash of pids as key values
-	map { $PID{$_}++ } @PID;
+        # Windows
+        my @PID = @_;
+        my %PID;
+        # hash of pids as key values
+        map { $PID{$_}++ } @PID;
 
-	# Does not work but should reading the tasklist documentation
-	#@ps = qx{ tasklist /FI "PID eq @PID" };
+        # Does not work but should reading the tasklist documentation
+        #@ps = qx{ tasklist /FI "PID eq @PID" };
 
-	my @ps = qx{ tasklist /NH /FO CSV } ;
+        my @ps = qx{ tasklist /NH /FO CSV } ;
         #my @ps = backtick( 'tasklist /NH /FO CSV' ) ;
-	#myprint( "-" x $STD_CHAR_PER_LINE, "\n", @ps, "-" x $STD_CHAR_PER_LINE, "\n" ) ;
-	my @val;
-	foreach my $line (@ps) {
-		my($name, $pid, $mem) = (split ',', $line )[0,1,4];
-		next if (! $pid);
-		#myprint( "[$name][$pid][$mem]" ) ;
-		if ($PID{remove_qq($pid)}) {
-			#myprint( "MATCH !\n" ) ;
-			chomp $mem ;
-			$mem = remove_qq($mem);
-			$mem = remove_Ko($mem);
-			$mem = remove_not_num($mem);
-			#myprint( "[$mem]\n" ) ;
-			push @val, $mem * $KIBI;
-		}
-	}
-	return(@val);
+        #myprint( "-" x $STD_CHAR_PER_LINE, "\n", @ps, "-" x $STD_CHAR_PER_LINE, "\n" ) ;
+        my @val;
+        foreach my $line (@ps) {
+                my($name, $pid, $mem) = (split ',', $line )[0,1,4];
+                next if (! $pid);
+                #myprint( "[$name][$pid][$mem]" ) ;
+                if ($PID{remove_qq($pid)}) {
+                        #myprint( "MATCH !\n" ) ;
+                        chomp $mem ;
+                        $mem = remove_qq($mem);
+                        $mem = remove_Ko($mem);
+                        $mem = remove_not_num($mem);
+                        #myprint( "[$mem]\n" ) ;
+                        push @val, $mem * $KIBI;
+                }
+        }
+        return(@val);
 }
 
 sub backtick {
-	my $command = shift ;
-	my ( $writer, $reader, $err ) ;
+        my $command = shift ;
+
+	if ( ! $command ) { return ; }
+
+        my ( $writer, $reader, $err ) ;
         my @output ;
-        open3( $writer, $reader, $err, $command ) ;
-        @output = <$reader>;  #Output here
+        my $pid ;
+	eval {
+		$pid = open3( $writer, $reader, $err, $command ) ;
+	} ;
+
+	if ( ! $pid  ) { return ; }
+	waitpid( $pid, 0 ) ;
+        @output = <$reader>;  # Output here
+	#
         #my @errors = <$err>;    #Errors here, instead of the console
+	if ( not @output ) { return ; }
         $debugdev and myprint( @output  ) ;
-        return( @output ) ;
+	if ( $output[0] =~ /\Qopen3: exec of $command failed\E/mxs ) { return ; }
+	if ( wantarray ) {
+		return( @output ) ;
+	} else {
+		return( join( q{}, @output) ) ;
+	}
 }
 
 sub tests_backtick {
+	note( 'Entering tests_backtick()' ) ;
+
+	is( undef, backtick( ), 'backtick: no args' ) ;
+	is( undef, backtick( q{} ), 'backtick: empty command' ) ;
 
         SKIP: {
-		skip( 'Tests for MSWin32', 3 ) if ('MSWin32' ne $OSNAME) ;
-		my @output ;
-		@output = backtick( 'echo Hello World!' ) ;
-		# Add \r on Windows.
-		ok( "Hello World!\r\n" eq $output[0], 'backtick: echo Hello World!' ) ;
-		$debug and myprint( "[@output]"  ) ;
-		@output = backtick( 'echo Hello & echo World!' ) ;
-		ok( "Hello \r\n" eq $output[0], 'backtick: echo Hello & echo World!' ) ;
-		ok( "World!\r\n" eq $output[1], 'backtick: echo Hello & echo World!' ) ;
-		$debug and myprint( "[@output][$output[0]][$output[1]]"  ) ;
+                skip( 'test for MSWin32', 5 ) if ('MSWin32' ne $OSNAME) ;
+                my @output ;
+                @output = backtick( 'echo Hello World!' ) ;
+                # Add \r on Windows.
+                ok( "Hello World!\r\n" eq $output[0], 'backtick: echo Hello World!' ) ;
+                $debug and myprint( "[@output]"  ) ;
+                @output = backtick( 'echo Hello & echo World!' ) ;
+                ok( "Hello \r\n" eq $output[0], 'backtick: echo Hello & echo World! line 1' ) ;
+                ok( "World!\r\n" eq $output[1], 'backtick: echo Hello & echo World! line 2' ) ;
+                $debug and myprint( "[@output][$output[0]][$output[1]]"  ) ;
+		# Scalar context
+		ok( "Hello World!\r\n" eq backtick( 'echo Hello World!' ),
+		'backtick: echo Hello World! scalar' ) ;
+		ok( "Hello \r\nWorld!\r\n" eq backtick( 'echo Hello & echo World!' ),
+		'backtick: echo Hello & echo World! scalar 2 lines' ) ;
         } ;
-	SKIP: {
-		skip( 'Tests for Unix', 3 ) if ('MSWin32' eq $OSNAME) ;
-		my @output ;
-		@output = backtick( 'echo Hello World!' ) ;
-		ok( "Hello World!\n" eq $output[0], 'backtick: echo Hello World!' ) ;
-		$debug and myprint( "[@output]"  ) ;
-		@output = backtick( "echo Hello\necho World!" ) ;
-		ok( "Hello\n" eq $output[0], 'backtick: echo Hello; echo World!' ) ;
-		ok( "World!\n" eq $output[1], 'backtick: echo Hello; echo World!' ) ;
-		$debug and myprint( "[@output]"  ) ;
-	}
+        SKIP: {
+                skip( 'test for Unix', 7 ) if ('MSWin32' eq $OSNAME) ;
+		is( undef, backtick( 'aaaarrrg' ), 'backtick: aaaarrrg command not found' ) ;
+		# Array context
+                my @output ;
+                @output = backtick( 'echo Hello World!' ) ;
+                ok( "Hello World!\n" eq $output[0], 'backtick: echo Hello World!' ) ;
+                $debug and myprint( "[@output]"  ) ;
+                @output = backtick( "echo Hello\necho World!" ) ;
+                ok( "Hello\n" eq $output[0], 'backtick: echo Hello; echo World! line 1' ) ;
+                ok( "World!\n" eq $output[1], 'backtick: echo Hello; echo World! line 2' ) ;
+                $debug and myprint( "[@output]"  ) ;
+		# Scalar context
+		ok( "Hello World!\n" eq backtick( 'echo Hello World!' ),
+		'backtick: echo Hello World! scalar' ) ;
+		ok( "Hello\nWorld!\n" eq backtick( "echo Hello\necho World!" ),
+		'backtick: echo Hello; echo World! scalar 2 lines' ) ;
+		# Return error positive value, that's ok
+		is( undef, backtick( 'false' ), 'backtick: false returns no output' ) ;
+        }
+
+	note( 'Leaving  tests_backtick()' ) ;
         return ;
 }
 
 sub remove_not_num {
 
-	my $string = shift;
-	$string =~ tr/0-9//cd;
-	#myprint( "tr [$string]\n" ) ;
-	return($string);
+        my $string = shift ;
+        $string =~ tr/0-9//cd ;
+        #myprint( "tr [$string]\n" ) ;
+        return( $string ) ;
 }
 
 sub tests_remove_not_num {
+	note( 'Entering tests_remove_not_num()' ) ;
 
-	ok('123' eq remove_not_num(123), 'remove_not_num( 123 )' ) ;
-	ok('123' eq remove_not_num('123'), q{remove_not_num( '123' )} ) ;
-	ok('123' eq remove_not_num('12 3'), q{remove_not_num( '12 3' )} ) ;
-	ok('123' eq remove_not_num('a 12 3 Ko'), q{remove_not_num( 'a 12 3 Ko' )} ) ;
-	return ;
+        ok( '123' eq remove_not_num( 123 ), 'remove_not_num( 123 )' ) ;
+        ok( '123' eq remove_not_num( '123' ), q{remove_not_num( '123' )} ) ;
+        ok( '123' eq remove_not_num( '12 3' ), q{remove_not_num( '12 3' )} ) ;
+        ok( '123' eq remove_not_num( 'a 12 3 Ko' ), q{remove_not_num( 'a 12 3 Ko' )} ) ;
+
+	note( 'Leaving  tests_remove_not_num()' ) ;
+        return ;
 }
 
 sub remove_Ko {
-	my $string = shift;
-	if ($string =~ /^(.*)\sKo$/xo) {
-		return($1);
-	}else{
-		return($string);
-	}
+        my $string = shift;
+        if ($string =~ /^(.*)\sKo$/xo) {
+                return($1);
+        }else{
+                return($string);
+        }
 }
 
 sub remove_qq {
-	my $string = shift;
-	if ($string =~ /^"(.*)"$/xo) {
-		return($1);
-	}else{
-		return($string);
-	}
+        my $string = shift;
+        if ($string =~ /^"(.*)"$/xo) {
+                return($1);
+        }else{
+                return($string);
+        }
 }
 
 sub memory_consumption_ratio {
 
-	my ($base) = @_;
-	$base ||= 1;
-	my $consu = memory_consumption();
-	return($consu / $base);
+        my ($base) = @_;
+        $base ||= 1;
+        my $consu = memory_consumption();
+        return($consu / $base);
 }
 
 
 sub date_from_rcs {
-	my $d = shift ;
+        my $d = shift ;
 
-	my %num2mon = qw( 01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec ) ;
+        my %num2mon = qw( 01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec ) ;
         if ($d =~ m{(\d{4})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                 # Handles the following format
                 # 2015/07/10 11:05:59 -- Generated by RCS Date tag.
-		#myprint( "$d\n"  ) ;
+                #myprint( "$d\n"  ) ;
                 #myprint( "header: [$1][$2][$3][$4][$5][$6]\n"  ) ;
                 my ($year, $month, $day, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6) ;
                 $month = $num2mon{$month} ;
                 $d = "$day-$month-$year $hour:$min:$sec +0000" ;
-		#myprint( "$d\n"  ) ;
-	}
-	return( $d ) ;
+                #myprint( "$d\n"  ) ;
+        }
+        return( $d ) ;
 }
 
 sub tests_date_from_rcs {
-	ok('19-Sep-2015 16:11:07 +0000'
-	eq date_from_rcs('Date: 2015/09/19 16:11:07 '), 'date_from_rcs from RCS date' ) ;
-	return ;
+	note( 'Entering tests_date_from_rcs()' ) ;
+
+        ok('19-Sep-2015 16:11:07 +0000'
+        eq date_from_rcs('Date: 2015/09/19 16:11:07 '), 'date_from_rcs from RCS date' ) ;
+
+	note( 'Leaving  tests_date_from_rcs()' ) ;
+        return ;
 }
 
 sub good_date {
         # two incoming formats:
         # header    Tue, 24 Aug 2010 16:00:00 +0200
-	# internal       24-Aug-2010 16:00:00 +0200
+        # internal       24-Aug-2010 16:00:00 +0200
 
         # outgoing format: internal date format
         #   24-Aug-2010 16:00:00 +0200
@@ -7853,18 +9474,18 @@ sub good_date {
     my $d = shift ;
     return(q{}) if not defined $d;
 
-	SWITCH: {
-    	if ( $d =~ m{(\d?)(\d-...-\d{4})(\s\d{2}:\d{2}:\d{2})(\s(?:\+|-)\d{4})?}xo ) {
-		#myprint( "internal: [$1][$2][$3][$4]\n"  ) ;
-		my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4) ;
-		$day_1 = '0' if ($day_1 eq q{}) ;
-		$zone  = ' +0000'  if not defined $zone ;
-		$d = $day_1 . $date_rest . $hour . $zone ;
+        SWITCH: {
+        if ( $d =~ m{(\d?)(\d-...-\d{4})(\s\d{2}:\d{2}:\d{2})(\s(?:\+|-)\d{4})?}xo ) {
+                #myprint( "internal: [$1][$2][$3][$4]\n"  ) ;
+                my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4) ;
+                $day_1 = '0' if ($day_1 eq q{}) ;
+                $zone  = ' +0000'  if not defined $zone ;
+                $d = $day_1 . $date_rest . $hour . $zone ;
                 last SWITCH ;
         }
 
-	if ($d =~ m{(?:\w{3,},\s)?(\d{1,2}),?\s+(\w{3,})\s+(\d{2,4})\s+(\d{1,2})(?::|\.)(\d{1,2})(?:(?::|\.)(\d{1,2}))?\s*((?:\+|-)\d{4})?}xo ) {
-        	# Handles any combination of following formats
+        if ($d =~ m{(?:\w{3,},\s)?(\d{1,2}),?\s+(\w{3,})\s+(\d{2,4})\s+(\d{1,2})(?::|\.)(\d{1,2})(?:(?::|\.)(\d{1,2}))?\s*((?:\+|-)\d{4})?}xo ) {
+                # Handles any combination of following formats
                 # Tue, 24 Aug 2010 16:00:00 +0200 -- Standard
                 # 24 Aug 2010 16:00:00 +0200 -- Missing Day of Week
                 # Tue, 24 Aug 97 16:00:00 +0200 -- Two digit year
@@ -7886,11 +9507,11 @@ sub good_date {
                 $sec  = mysprintf( '%02d', $sec ) ;
                 $zone = '+0000' if not defined  $zone  ;
                 $d    = "$day-$month-$year $hour:$min:$sec $zone" ;
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
 
-	if ($d =~ m{(?:.{3})\s(...)\s+(\d{1,2})\s(\d{1,2}):(\d{1,2}):(\d{1,2})\s(?:\w{3})?\s?(\d{4})}xo ) {
-        	# Handles any combination of following formats
+        if ($d =~ m{(?:.{3})\s(...)\s+(\d{1,2})\s(\d{1,2}):(\d{1,2}):(\d{1,2})\s(?:\w{3})?\s?(\d{4})}xo ) {
+                # Handles any combination of following formats
                 # Sun Aug 20 11:55:09 2006
                 # Wed Jan 24 11:58:38 MST 2007
                 # Wed Jan  2 08:40:57 2008
@@ -7902,21 +9523,21 @@ sub good_date {
                 $min  = mysprintf( '%02d', $min  ) ;
                 $sec  = mysprintf( '%02d', $sec  ) ;
                 $d    = "$day-$month-$year $hour:$min:$sec +0000" ;
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
         my %num2mon = qw( 01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec ) ;
 
         if ($d =~ m{(\d{4})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                 # Handles the following format
                 # 2015/07/10 11:05:59 -- Generated by RCS Date tag.
-		#myprint( "$d\n"  ) ;
+                #myprint( "$d\n"  ) ;
                 #myprint( "header: [$1][$2][$3][$4][$5][$6]\n"  ) ;
                 my ($year, $month, $day, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6) ;
                 $month = $num2mon{$month} ;
                 $d = "$day-$month-$year $hour:$min:$sec +0000" ;
-		#myprint( "$d\n"  ) ;
-		last SWITCH ;
-	}
+                #myprint( "$d\n"  ) ;
+                last SWITCH ;
+        }
 
         if ($d =~ m{(\d{2})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                 # Handles the following format
@@ -7927,11 +9548,11 @@ sub good_date {
                 $year = '20' . $year;
                 $month = $num2mon{$month};
                 $d = "$day-$month-$year $hour:$min:$sec +0000";
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
 
-	if ($d =~ m{\w{6,},\s(\w{3})\w+\s+(\d{1,2}),\s(\d{4})\s(\d{2}):(\d{2})\s(AM|PM)}xo ) {
-        	# Handles the following format
+        if ($d =~ m{\w{6,},\s(\w{3})\w+\s+(\d{1,2}),\s(\d{4})\s(\d{2}):(\d{2})\s(AM|PM)}xo ) {
+                # Handles the following format
                 # Saturday, December 14, 2002 05:00 PM - KBtoys.com order confirmations
 
                 my ($month, $day, $year, $hour, $min, $apm) = ($1,$2,$3,$4,$5,$6);
@@ -7940,10 +9561,10 @@ sub good_date {
                 $day = mysprintf( '%02d', $day ) ;
                 $d = "$day-$month-$year $hour:$min:00 +0000" ;
                 last SWITCH ;
-	}
+        }
 
-	if ($d =~ m{(\w{3})\s(\d{1,2})\s(\d{4})\s(\d{2}):(\d{2}):(\d{2})\s((?:\+|-)\d{4})}xo ) {
-        	# Handles the following format
+        if ($d =~ m{(\w{3})\s(\d{1,2})\s(\d{4})\s(\d{2}):(\d{2}):(\d{2})\s((?:\+|-)\d{4})}xo ) {
+                # Handles the following format
                 # Saturday, December 14, 2002 05:00 PM - jr.com order confirmations
 
                 my ($month, $day, $year, $hour, $min, $sec, $zone) = ($1,$2,$3,$4,$5,$6,$7);
@@ -7951,20 +9572,20 @@ sub good_date {
                 $day = mysprintf( '%02d', $day ) ;
                 $d = "$day-$month-$year $hour:$min:$sec $zone";
                 last SWITCH ;
-	}
+        }
 
-	if ($d =~ m{(\d{1,2})-(\w{3})-(\d{4})}xo ) {
-        	# Handles the following format
+        if ($d =~ m{(\d{1,2})-(\w{3})-(\d{4})}xo ) {
+                # Handles the following format
                 # 21-Jun-2001 - register.com domain transfer email circa 2001
 
                 my ($day, $month, $year) = ($1,$2,$3);
                 $day = mysprintf( '%02d', $day);
                 $d = "$day-$month-$year 11:11:11 +0000";
-		last SWITCH ;
-	}
+                last SWITCH ;
+        }
 
-    	# unknown or unmatch => return same string
-    	return($d);
+        # unknown or unmatch => return same string
+        return($d);
     }
 
     $d = qq("$d") ;
@@ -7973,15 +9594,16 @@ sub good_date {
 
 
 sub tests_good_date {
+	note( 'Entering tests_good_date()' ) ;
 
-	ok(q{} eq good_date(), 'good_date no arg');
-	ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24-Aug-2010 16:00:00 +0200'), 'good_date internal 2digit zone');
-	ok('"24-Aug-2010 16:00:00 +0000"' eq good_date('24-Aug-2010 16:00:00'), 'good_date internal 2digit no zone');
-	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date( '1-Sep-2010 16:00:00 +0200'), 'good_date internal SP 1digit');
-	ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('Tue, 24 Aug 2010 16:00:00 +0200'), 'good_date header 2digit zone');
-	ok('"01-Sep-2010 16:00:00 +0000"' eq good_date('Wed, 1 Sep 2010 16:00:00'), 'good_date header SP 1digit zone');
-	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200'), 'good_date header SP 1digit zone');
-	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200 (CEST)'), 'good_date header SP 1digit zone');
+        ok(q{} eq good_date(), 'good_date no arg');
+        ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24-Aug-2010 16:00:00 +0200'), 'good_date internal 2digit zone');
+        ok('"24-Aug-2010 16:00:00 +0000"' eq good_date('24-Aug-2010 16:00:00'), 'good_date internal 2digit no zone');
+        ok('"01-Sep-2010 16:00:00 +0200"' eq good_date( '1-Sep-2010 16:00:00 +0200'), 'good_date internal SP 1digit');
+        ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('Tue, 24 Aug 2010 16:00:00 +0200'), 'good_date header 2digit zone');
+        ok('"01-Sep-2010 16:00:00 +0000"' eq good_date('Wed, 1 Sep 2010 16:00:00'), 'good_date header SP 1digit zone');
+        ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200'), 'good_date header SP 1digit zone');
+        ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200 (CEST)'), 'good_date header SP 1digit zone');
         ok('"06-Feb-2009 22:18:08 +0000"' eq good_date('02/06/09 22:18:08'), 'good_date header TemPageR');
         ok('"02-Jan-2008 08:40:57 +0000"' eq good_date('Wed Jan  2 08:40:57 2008'), 'good_date header dice.com support 1digit day');
         ok('"20-Aug-2006 11:55:09 +0000"' eq good_date('Sun Aug 20 11:55:09 2006'), 'good_date header dice.com support 2digit day');
@@ -8002,104 +9624,220 @@ sub tests_good_date {
         ok('"16-Dec-2004 02:01:49 -0500"' eq good_date('Dec 16 2004 02:01:49 -0500'), 'good_date jr.com orders');
         ok('"21-Jun-2001 11:11:11 +0000"' eq good_date('21-Jun-2001'), 'good_date register.com domain transfer');
         ok('"18-Nov-2012 18:34:38 +0100"' eq good_date('Sun, 18 Nov 2012 18:34:38 +0100'), 'good_date pop2imap bug (Westeuropäische Normalzeit)');
-	ok('"19-Sep-2015 16:11:07 +0000"' eq good_date('Date: 2015/09/19 16:11:07 '), 'good_date from RCS date' ) ;
-	return ;
+        ok('"19-Sep-2015 16:11:07 +0000"' eq good_date('Date: 2015/09/19 16:11:07 '), 'good_date from RCS date' ) ;
+
+	note( 'Leaving  tests_good_date()' ) ;
+        return ;
 }
 
 
 sub tests_list_keys_in_2_not_in_1 {
+	note( 'Entering tests_list_keys_in_2_not_in_1()' ) ;
 
-	my @list;
-	ok( ! list_keys_in_2_not_in_1( {}, {}), 'list_keys_in_2_not_in_1: {} {}');
-	ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {}, {} ) ] ), 'list_keys_in_2_not_in_1: {} {}');
-	ok( 0 == compare_lists( ['a','b'], [ list_keys_in_2_not_in_1( {}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {} {a, b}');
-	ok( 0 == compare_lists( ['b'],     [ list_keys_in_2_not_in_1( {'a' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a} {a, b}');
-	ok( 0 == compare_lists( [],        [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b} {a, b}');
-	ok( 0 == compare_lists( [],        [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}');
-	ok( 0 == compare_lists( ['b'],     [ list_keys_in_2_not_in_1( {'a' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}');
 
-	return ;
+        my @list;
+        ok( ! list_keys_in_2_not_in_1( {}, {}), 'list_keys_in_2_not_in_1: {} {}');
+        ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {}, {} ) ] ), 'list_keys_in_2_not_in_1: {} {}');
+        ok( 0 == compare_lists( ['a','b'], [ list_keys_in_2_not_in_1( {}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {} {a, b}');
+        ok( 0 == compare_lists( ['b'],     [ list_keys_in_2_not_in_1( {'a' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a} {a, b}');
+        ok( 0 == compare_lists( [],        [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b} {a, b}');
+        ok( 0 == compare_lists( [],        [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}');
+        ok( 0 == compare_lists( ['b'],     [ list_keys_in_2_not_in_1( {'a' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}');
+
+	note( 'Leaving  tests_list_keys_in_2_not_in_1()' ) ;
+        return ;
 }
 
 sub list_keys_in_2_not_in_1 {
 
-	my $folders1_ref = shift;
-	my $folders2_ref = shift;
-	my @list;
+        my $folders1_ref = shift;
+        my $folders2_ref = shift;
+        my @list;
 
-	foreach my $folder ( sort keys %{ $folders2_ref } ) {
-		next if exists $folders1_ref->{$folder};
-		push @list, $folder;
-	}
-	return(@list);
+        foreach my $folder ( sort keys %{ $folders2_ref } ) {
+                next if exists $folders1_ref->{$folder};
+                push @list, $folder;
+        }
+        return(@list);
 }
 
 
 sub list_folders_in_2_not_in_1 {
 
-	my (@h2_folders_not_in_h1, %h2_folders_not_in_h1) ;
-	@h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h1_folders_all, \%h2_folders_all) ;
-	map { $h2_folders_not_in_h1{$_} = 1} @h2_folders_not_in_h1 ;
-	@h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h2_folders_from_1_all, \%h2_folders_not_in_h1) ;
+        my (@h2_folders_not_in_h1, %h2_folders_not_in_h1) ;
+        @h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h1_folders_all, \%h2_folders_all) ;
+        map { $h2_folders_not_in_h1{$_} = 1} @h2_folders_not_in_h1 ;
+        @h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h2_folders_from_1_all, \%h2_folders_not_in_h1) ;
 
-	return( reverse @h2_folders_not_in_h1 );
+        return( reverse @h2_folders_not_in_h1 );
 }
 
-sub delete_folders_in_2_not_in_1 {
 
-	foreach my $folder (@h2_folders_not_in_1) {
-		if ( defined  $delete2foldersonly  and eval "\$folder !~ $delete2foldersonly" ) {
-			myprint( "Not deleting $folder because of --delete2foldersonly $delete2foldersonly\n"  ) ;
-			next ;
-		}
-		if ( defined  $delete2foldersbutnot  and eval "\$folder =~ $delete2foldersbutnot" ) {
-			myprint( "Not deleting $folder because of --delete2foldersbutnot $delete2foldersbutnot\n"  ) ;
-			next ;
-		}
-		my $res = $dry ; # always success in dry mode!
-		$imap2->unsubscribe( $folder ) if ( ! $dry ) ;
-		$res = $imap2->delete( $folder ) if ( ! $dry ) ;
-		if ( $res ) {
-			myprint( "Deleted $folder", "$dry_message", "\n"  ) ;
-		}else{
-			myprint( "Deleting $folder failed", "\n"  ) ;
-		}
+sub tests_match {
+	note( 'Entering tests_match()' ) ;
+
+	# undef serie
+	is( undef, match(  ), 'match: no args => undef' ) ;
+	is( undef, match( 'lalala' ), 'match: one args => undef' ) ;
+
+	# This one gives 0 under a binary made by pp
+	# but 1 under "normal" Perl interpreter. So a PAR bug?
+	#is( 1, match( q{}, q{} ),                'match: q{}      =~ q{}      => 1' ) ;
+	
+	is( 1, match( 'lalala', 'lalala' ),      'match: lalala   =~ lalala => 1' ) ;
+	is( 1, match( 'lalala', '^lalala' ),     'match: lalala   =~ ^lalala  => 1' ) ;
+	is( 1, match( 'lalala',  'lalala$' ),    'match: lalala   =~ lalala$  => 1' ) ;
+	is( 1, match( 'lalala', '^lalala$' ),    'match: lalala   =~ ^lalala$ => 1' ) ;
+	is( 1, match( '_lalala_', 'lalala' ),    'match: _lalala_ =~ lalala   => 1' ) ;
+	is( 1, match( 'lalala', '.*' ),          'match: lalala   =~ .*       => 1' ) ;
+	is( 1, match( 'lalala', '.' ),           'match: lalala   =~ .        => 1' ) ;
+	is( 1, match( '/lalala/', '/lalala/' ),  'match: /lalala/ =~ /lalala/ => 1' ) ;
+
+
+	is( 0, match( 'lalala', 'ooo' ),         'match: lalala   =~ ooo      => 0' ) ;
+	is( 0, match( 'lalala', 'lal_ala' ),     'match: lalala   =~ lal_ala  => 0' ) ;
+	is( 0, match( 'lalala', '\.' ),          'match: lalala   =~ \.       => 0' ) ;
+	is( 0, match( 'lalalaX', '^lalala$' ),   'match: lalalaX  =~ ^lalala$ => 0' ) ;
+	is( 0, match( 'lalala', '/lalala/' ),    'match: lalala   =~ /lalala/ => 1' ) ;
+
+	is( 1, match( 'LALALA', '(?i:lalala)' ),           'match: LALALA   =~ (?i:lalala) => 1' ) ;
+
+	is( undef, match( 'LALALA', '(?{`ls /`})' ),       'match: LALALA   =~ (?{`ls /`})       => undef' ) ;
+	is( undef, match( 'LALALA', '(?{print "CACA"})' ), 'match: LALALA   =~ (?{print "CACA"})  => undef' ) ;
+	is( undef, match( 'CACA', '(??{print "CACA"})' ),  'match: CACA     =~ (??{print "CACA"}) => undef' ) ;
+
+	note( 'Leaving  tests_match()' ) ;
+
+	return ;
+}
+
+sub match {
+	my( $var, $regex ) = @ARG ;
+
+	# undef cases
+	if ( ( ! defined $var ) or ( ! defined $regex ) ) { return ; }
+
+	# normal cases
+	if ( eval { $var =~ $regex } ) {
+		return 1 ;
+	}elsif ( $EVAL_ERROR ) {
+		print "Fatal regex $regex\n" ;
+		return ;
+	} else {
+		return 0 ;
 	}
 	return ;
 }
 
+
+sub tests_notmatch {
+	note( 'Entering tests_notmatch()' ) ;
+
+	# undef serie
+	is( undef, notmatch(  ), 'notmatch: no args => undef' ) ;
+	is( undef, notmatch( 'lalala' ), 'notmatch: one args => undef' ) ;
+
+	is( 1, notmatch( 'lalala', '/lalala/' ),   'notmatch: lalala   !~ /lalala/ => 1' ) ;
+	is( 0, notmatch( '/lalala/', '/lalala/' ), 'notmatch: /lalala/ !~ /lalala/ => 0' ) ;
+	is( 1, notmatch( 'lalala', '/ooo/' ),      'notmatch: lalala   !~ /ooo/    => 1' ) ;
+
+	# This one gives 1 under a binary made by pp
+	# but 0 under "normal" Perl interpreter. So a PAR bug, same in tests_match .
+	#is( 0, notmatch( q{}, q{} ),             'notmatch: q{}      !~ q{}      => 0' ) ;
+
+	is( 0, notmatch( 'lalala', 'lalala' ),   'notmatch: lalala   !~ lalala   => 0' ) ;	
+	is( 0, notmatch( 'lalala', '^lalala' ),  'notmatch: lalala   !~ ^lalala  => 0' ) ;
+	is( 0, notmatch( 'lalala',  'lalala$' ), 'notmatch: lalala   !~ lalala$  => 0' ) ;
+	is( 0, notmatch( 'lalala', '^lalala$' ), 'notmatch: lalala   !~ ^lalala$ => 0' ) ;
+	is( 0, notmatch( '_lalala_', 'lalala' ), 'notmatch: _lalala_ !~ lalala   => 0' ) ;
+	is( 0, notmatch( 'lalala', '.*' ),       'notmatch: lalala   !~ .*       => 0' ) ;
+	is( 0, notmatch( 'lalala', '.' ),        'notmatch: lalala   !~ .        => 0' ) ;
+
+
+	is( 1, notmatch( 'lalala', 'ooo' ), 'notmatch: does not match regex => 1' ) ;
+	is( 1, notmatch( 'lalala', 'lal_ala' ), 'notmatch: does not match regex => 1' ) ;
+	is( 1, notmatch( 'lalala', '\.' ), 'notmatch: matches regex => 0' ) ;
+	is( 1, notmatch( 'lalalaX', '^lalala$' ), 'notmatch: does not match regex => 1' ) ;
+
+	note( 'Leaving  tests_notmatch()' ) ;
+
+	return ;
+}
+
+sub notmatch {
+	my( $var, $regex ) = @ARG ;
+
+	# undef cases
+	if ( ( ! defined $var ) or ( ! defined $regex ) ) { return ; }
+
+	# normal cases
+	if ( eval { $var !~ $regex } ) {
+		return 1 ;
+	}elsif ( $EVAL_ERROR ) {
+		print "Fatal regex $regex\n" ;
+		return ;
+	}else{
+		return 0 ;
+	}
+	return ;
+}
+
+
+sub delete_folders_in_2_not_in_1 {
+
+        foreach my $folder (@h2_folders_not_in_1) {
+                if ( defined  $delete2foldersonly  and eval "\$folder !~ $delete2foldersonly" ) {
+                        myprint( "Not deleting $folder because of --delete2foldersonly $delete2foldersonly\n"  ) ;
+                        next ;
+                }
+                if ( defined  $delete2foldersbutnot  and eval "\$folder =~ $delete2foldersbutnot" ) {
+                        myprint( "Not deleting $folder because of --delete2foldersbutnot $delete2foldersbutnot\n"  ) ;
+                        next ;
+                }
+                my $res = $sync->{dry} ; # always success in dry mode!
+                $imap2->unsubscribe( $folder ) if ( ! $sync->{dry} ) ;
+                $res = $imap2->delete( $folder ) if ( ! $sync->{dry} ) ;
+                if ( $res ) {
+                        myprint( "Deleted $folder", "$sync->{dry_message}", "\n"  ) ;
+                }else{
+                        myprint( "Deleting $folder failed", "\n"  ) ;
+                }
+        }
+        return ;
+}
+
 sub delete_folder {
-        my ( $sync, $imap, $folder, $Side ) = @_ ;
-        if ( ! $sync )   { return ; }
+        my ( $mysync, $imap, $folder, $Side ) = @_ ;
+        if ( ! $mysync )   { return ; }
         if ( ! $imap )   { return ; }
         if ( ! $folder ) { return ; }
         $Side ||= 'HostX' ;
-        
-        my $res = $sync->{dry} ; # always success in dry mode!
-        if ( ! $sync->{dry} ) {
+
+        my $res = $mysync->{dry} ; # always success in dry mode!
+        if ( ! $mysync->{dry} ) {
                 $imap->unsubscribe( $folder ) ;
                 $res = $imap->delete( $folder ) ;
         }
         if ( $res ) {
-        	myprint( "$Side deleted $folder", $sync->{dry_message}, "\n"  ) ;
+                myprint( "$Side deleted $folder", $mysync->{dry_message}, "\n"  ) ;
                 return 1 ;
         }else{
-        	myprint( "$Side deleting $folder failed", "\n"  ) ;
+                myprint( "$Side deleting $folder failed", "\n"  ) ;
                 return ;
         }
 }
 
 sub delete1emptyfolders {
-        my $sync = shift ;
-        if ( ! $sync ) { return ; } # abort if no parameter
-        if ( ! $sync->{delete1emptyfolders} ) { return ; } # abort if --delete1emptyfolders off
-        my $imap = $sync->{imap1} ;
+        my $mysync = shift ;
+        if ( ! $mysync ) { return ; } # abort if no parameter
+        if ( ! $mysync->{delete1emptyfolders} ) { return ; } # abort if --delete1emptyfolders off
+        my $imap = $mysync->{imap1} ;
         if ( ! $imap ) { return ; } # abort if no imap
         if ( $imap->IsUnconnected(  ) ) { return ; } # abort if diesconnected
-        
+
         my %folders_kept ;
         myprint( qq{Host1 deleting empty folders\n} ) ;
-        foreach my $folder ( reverse sort @{ $sync->{h1_folders_wanted} } ) {
+        foreach my $folder ( reverse sort @{ $mysync->{h1_folders_wanted} } ) {
                 my $parenthood = $imap->is_parent( $folder ) ;
                 if ( defined $parenthood and $parenthood ) {
                         myprint( "Host1 folder $folder has subfolders\n" ) ;
@@ -8123,42 +9861,42 @@ sub delete1emptyfolders {
                 if ( uc $folder eq 'INBOX' ) {
                         myprint( "Host1 Not deleting $folder\n" ) ;
                         $folders_kept{ $folder }++ ;
-                        next ; 
+                        next ;
                 }
                 myprint( "Host1 deleting empty folder $folder\n" ) ;
                 # can not delete a SELECTed or EXAMINEd folder so closing it
                 # could changed be SELECT INBOX
-                $imap->close(  ) ; # close after examine does not expunge; anyway expunging an empty folder... 
-                if ( delete_folder( $sync, $imap, $folder, 'Host1' ) ) {
+                $imap->close(  ) ; # close after examine does not expunge; anyway expunging an empty folder...
+                if ( delete_folder( $mysync, $imap, $folder, 'Host1' ) ) {
                         next ; # Deleted, good!
                 }else{
                         $folders_kept{ $folder }++ ;
                         next ; # Not deleted, bad!
                 }
         }
-        remove_deleted_folders_from_wanted_list( $sync, %folders_kept ) ;
+        remove_deleted_folders_from_wanted_list( $mysync, %folders_kept ) ;
         myprint( qq{Host1 ended deleting empty folders\n} ) ;
         return ;
 }
 
 sub remove_deleted_folders_from_wanted_list {
-        my ( $sync, %folders_kept ) = @ARG ;
-        
-        my @h1_folders_wanted_init = @{ $sync->{h1_folders_wanted} } ;
+        my ( $mysync, %folders_kept ) = @ARG ;
+
+        my @h1_folders_wanted_init = @{ $mysync->{h1_folders_wanted} } ;
         my @h1_folders_wanted_last ;
         foreach my $folder ( @h1_folders_wanted_init ) {
                 if ( $folders_kept{ $folder } ) {
                         push @h1_folders_wanted_last, $folder ;
                 }
         }
-        @{ $sync->{h1_folders_wanted} } = @h1_folders_wanted_last ;
+        @{ $mysync->{h1_folders_wanted} } = @h1_folders_wanted_last ;
         return ;
 }
 
 sub examine_folder_and_count {
         my ( $imap, $folder, $Side ) = @_ ;
         $Side ||= 'HostX' ;
-        
+
         if ( ! examine_folder( $imap, $folder, $Side ) ) {
                 return ;
         }
@@ -8168,6 +9906,8 @@ sub examine_folder_and_count {
 
 
 sub tests_delete1emptyfolders {
+	note( 'Entering tests_delete1emptyfolders()' ) ;
+
 
         is( undef, delete1emptyfolders(  ), q{delete1emptyfolders: undef} ) ;
         my $syncT ;
@@ -8175,7 +9915,7 @@ sub tests_delete1emptyfolders {
         my $imapT ;
         $syncT->{imap1} = $imapT ;
         is( undef, delete1emptyfolders( $syncT ), q{delete1emptyfolders: undef imap} ) ;
-        
+
         require Test::MockObject ;
         $imapT = Test::MockObject->new(  ) ;
         $syncT->{imap1} = $imapT ;
@@ -8186,7 +9926,7 @@ sub tests_delete1emptyfolders {
         # Now connected tests
         $imapT->set_false( 'IsUnconnected' ) ;
         $imapT->mock( 'LastError', sub { q{LastError mocked} } ) ;
-        
+
         $syncT->{delete1emptyfolders} = 0 ;
         tests_delete1emptyfolders_unit(
                 $syncT,
@@ -8207,7 +9947,7 @@ sub tests_delete1emptyfolders {
 
         # No parents but examine false for all => skip all
         $imapT->set_false( 'is_parent', 'examine' ) ;
-        
+
         tests_delete1emptyfolders_unit(
                 $syncT,
                 [ qw{ INBOX DELME1 DELME2 } ],
@@ -8267,26 +10007,28 @@ sub tests_delete1emptyfolders {
                 q{tests_delete1emptyfolders: 0 EXISTS 0 by messages() delete folders, keep INBOX}
         ) ;
 
-
-
-
+	note( 'Leaving  tests_delete1emptyfolders()' ) ;
         return ;
 }
 
 sub tests_delete1emptyfolders_unit {
+	note( 'Entering tests_delete1emptyfolders_unit()' ) ;
+
         my $syncT  = shift ;
         my $folders1wanted_init_ref = shift ;
         my $folders1wanted_after_ref = shift ;
         my $comment = shift || q{delete1emptyfolders:} ;
-        
+
         my @folders1wanted_init  = @{ $folders1wanted_init_ref } ;
         my @folders1wanted_after = @{ $folders1wanted_after_ref } ;
 
         @{ $syncT->{h1_folders_wanted} } = @folders1wanted_init ;
-        
+
         is_deeply( $syncT->{h1_folders_wanted}, \@folders1wanted_init, qq{$comment, init check} ) ;
         delete1emptyfolders( $syncT ) ;
         is_deeply( $syncT->{h1_folders_wanted}, \@folders1wanted_after, qq{$comment, after check} ) ;
+
+	note( 'Leaving  tests_delete1emptyfolders_unit()' ) ;
         return ;
 }
 
@@ -8300,6 +10042,8 @@ sub extract_header {
 }
 
 sub tests_extract_header {
+	note( 'Entering tests_extract_header()' ) ;
+
 
 
 my $h = <<'EOM';
@@ -8321,7 +10065,8 @@ EOM
 
 
 
-	return ;
+	note( 'Leaving  tests_extract_header()' ) ;
+        return ;
 }
 
 sub decompose_header{
@@ -8361,6 +10106,8 @@ sub decompose_header{
 
 
 sub tests_decompose_header{
+	note( 'Entering tests_decompose_header()' ) ;
+
 
         my $header_dec ;
 
@@ -8373,7 +10120,7 @@ KEY_2: VAL_2
 KEY_3: VAL_3
 KEY_1: VAL_1_other
 KEY_4: VAL_4
-	VAL_4_+
+        VAL_4_+
 KEY_5 BLANC:  VAL_5
 
 KEY_6_BAD_BODY: VAL_6
@@ -8462,12 +10209,32 @@ EOH
         ok( 'VAL_2 VAL_2_+ VAL_2_++'
         eq $header_dec->{ 'KEY_2' }[0], 'decompose_header: Bad header VAL_2 VAL_2_+ VAL_2_++' ) ;
 
-	return ;
+	note( 'Leaving  tests_decompose_header()' ) ;
+        return ;
+}
+
+sub tests_epoch {
+	note( 'Entering tests_epoch()' ) ;
+
+        ok( '1282658400' eq epoch( '24-Aug-2010 16:00:00 +0200' ), 'epoch 24-Aug-2010 16:00:00 +0200 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 14:00:00 +0000' ), 'epoch 24-Aug-2010 14:00:00 +0000 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 12:00:00 -0200' ), 'epoch 24-Aug-2010 12:00:00 -0200 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 16:01:00 +0201' ), 'epoch 24-Aug-2010 16:01:00 +0201 -> 1282658400' ) ;
+        ok( '1282658400' eq epoch( '24-Aug-2010 14:01:00 +0001' ), 'epoch 24-Aug-2010 14:01:00 +0001 -> 1282658400' ) ;
+
+        ok( '1280671200' eq epoch( '1-Aug-2010 16:00:00 +0200' ), 'epoch 1-Aug-2010 16:00:00 +0200 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 14:00:00 +0000' ), 'epoch 1-Aug-2010 14:00:00 +0000 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 12:00:00 -0200' ), 'epoch 1-Aug-2010 12:00:00 -0200 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 16:01:00 +0201' ), 'epoch 1-Aug-2010 16:01:00 +0201 -> 1280671200' ) ;
+        ok( '1280671200' eq epoch( '1-Aug-2010 14:01:00 +0001' ), 'epoch 1-Aug-2010 14:01:00 +0001 -> 1280671200' ) ;
+
+	note( 'Leaving  tests_epoch()' ) ;
+        return ;
 }
 
 sub epoch {
         # incoming format:
-	# internal date 24-Aug-2010 16:00:00 +0200
+        # internal date 24-Aug-2010 16:00:00 +0200
 
         # outgoing format: epoch
 
@@ -8495,210 +10262,256 @@ sub epoch {
         return( $time ) ;
 }
 
-sub tests_epoch {
-        ok( '1282658400' eq epoch( '24-Aug-2010 16:00:00 +0200' ), 'epoch 24-Aug-2010 16:00:00 +0200 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 14:00:00 +0000' ), 'epoch 24-Aug-2010 14:00:00 +0000 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 12:00:00 -0200' ), 'epoch 24-Aug-2010 12:00:00 -0200 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 16:01:00 +0201' ), 'epoch 24-Aug-2010 16:01:00 +0201 -> 1282658400' ) ;
-        ok( '1282658400' eq epoch( '24-Aug-2010 14:01:00 +0001' ), 'epoch 24-Aug-2010 14:01:00 +0001 -> 1282658400' ) ;
+sub tests_add_header {
+	note( 'Entering tests_add_header()' ) ;
 
-        ok( '1280671200' eq epoch( '1-Aug-2010 16:00:00 +0200' ), 'epoch 1-Aug-2010 16:00:00 +0200 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 14:00:00 +0000' ), 'epoch 1-Aug-2010 14:00:00 +0000 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 12:00:00 -0200' ), 'epoch 1-Aug-2010 12:00:00 -0200 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 16:01:00 +0201' ), 'epoch 1-Aug-2010 16:01:00 +0201 -> 1280671200' ) ;
-        ok( '1280671200' eq epoch( '1-Aug-2010 14:01:00 +0001' ), 'epoch 1-Aug-2010 14:01:00 +0001 -> 1280671200' ) ;
-	return ;
+        ok( 'Message-Id: ' eq add_header(), 'add_header no arg' ) ;
+        ok( 'Message-Id: <123456789@imapsync>' eq add_header( '123456789' ), 'add_header 123456789' ) ;
+
+	note( 'Leaving  tests_add_header()' ) ;
+        return ;
 }
 
 sub add_header {
-	my $header_uid = shift || 'mistake' ;
-	my $header_Message_Id = 'Message-Id: <' . $header_uid . '@imapsync>' ;
+        my $header_uid = shift || 'mistake' ;
+        my $header_Message_Id = 'Message-Id: <' . $header_uid . '@imapsync>' ;
         return( $header_Message_Id ) ;
 }
 
-sub tests_add_header {
-	ok( 'Message-Id: ' eq add_header(), 'add_header no arg' ) ;
-	ok( 'Message-Id: <123456789@imapsync>' eq add_header(123456789), 'add_header 123456789' ) ;
 
-	return ;
+
+
+sub tests_max_line_length {
+	note( 'Entering tests_max_line_length()' ) ;
+
+        ok( 0 == max_line_length( q{} ), 'max_line_length: 0 == null string' ) ;
+        ok( 1 == max_line_length( "\n" ), 'max_line_length: 1 == \n' ) ;
+        ok( 1 == max_line_length( "\n\n" ), 'max_line_length: 1 == \n\n' ) ;
+        ok( 1 == max_line_length( "\n" x 500 ), 'max_line_length: 1 == 500 \n' ) ;
+        ok( 1 == max_line_length( 'a' ), 'max_line_length: 1 == a' ) ;
+        ok( 2 == max_line_length( "a\na" ), 'max_line_length: 2 == a\na' ) ;
+        ok( 2 == max_line_length( "a\na\n" ), 'max_line_length: 2 == a\na\n' ) ;
+        ok( 3 == max_line_length( "a\nab\n" ), 'max_line_length: 3 == a\nab\n' ) ;
+        ok( 3 == max_line_length( "a\nab\n" x 10_000 ), 'max_line_length: 3 == 10_000 a\nab\n' ) ;
+        ok( 3 == max_line_length( "a\nab\nabc" ), 'max_line_length: 3 == a\nab\nabc' ) ;
+
+        ok( 4 == max_line_length( "a\nab\nabc\n" ), 'max_line_length: 4 == a\nab\nabc\n' ) ;
+        ok( 5 == max_line_length( "a\nabcd\nabc\n" ), 'max_line_length: 5 == a\nabcd\nabc\n' ) ;
+        ok( 5 == max_line_length( "a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd" ), 'max_line_length: 5 == a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd' ) ;
+
+	note( 'Leaving  tests_max_line_length()' ) ;
+        return ;
 }
 
-sub tests_Banner{
-
-	my $imap = Mail::IMAPClient->new(  ) ;
-        ok( 'lalala' eq $imap->Banner('lalala'), 'Banner set lalala' ) ;
-        ok( 'lalala' eq $imap->Banner(), 'Banner returns lalala' ) ;
-	return ;
-}
-
-
-
-
 sub max_line_length {
-	my $string = shift ;
+        my $string = shift ;
         my $max = 0 ;
 
         while ( $string =~ m/([^\n]*\n?)/msxg ) {
-        	$max = max( $max, length $1 ) ;
+                $max = max( $max, length $1 ) ;
         }
-	return( $max ) ;
+        return( $max ) ;
 }
 
-sub tests_max_line_length {
-	ok( 0 == max_line_length( q{} ), 'max_line_length: 0 == null string' ) ;
-	ok( 1 == max_line_length( "\n" ), 'max_line_length: 1 == \n' ) ;
-	ok( 1 == max_line_length( "\n\n" ), 'max_line_length: 1 == \n\n' ) ;
-	ok( 1 == max_line_length( "\n" x 500 ), 'max_line_length: 1 == 500 \n' ) ;
-	ok( 1 == max_line_length( 'a' ), 'max_line_length: 1 == a' ) ;
-	ok( 2 == max_line_length( "a\na" ), 'max_line_length: 2 == a\na' ) ;
-	ok( 2 == max_line_length( "a\na\n" ), 'max_line_length: 2 == a\na\n' ) ;
-	ok( 3 == max_line_length( "a\nab\n" ), 'max_line_length: 3 == a\nab\n' ) ;
-	ok( 3 == max_line_length( "a\nab\n" x 10000 ), 'max_line_length: 3 == 10000 a\nab\n' ) ;
-	ok( 3 == max_line_length( "a\nab\nabc" ), 'max_line_length: 3 == a\nab\nabc' ) ;
 
-	ok( 4 == max_line_length( "a\nab\nabc\n" ), 'max_line_length: 4 == a\nab\nabc\n' ) ;
-	ok( 5 == max_line_length( "a\nabcd\nabc\n" ), 'max_line_length: 5 == a\nabcd\nabc\n' ) ;
-	ok( 5 == max_line_length( "a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd" ), 'max_line_length: 5 == a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd' ) ;
+sub tests_setlogfile {
+	note( 'Entering tests_setlogfile()' ) ;
+
+	my $mysync = {} ;
+        $mysync->{logdir}  = 'vallogdir' ;
+        $mysync->{logfile} = 'vallogfile.txt' ;
+        is( 'vallogdir/vallogfile.txt', setlogfile( $mysync ),
+                'setlogfile: logdir vallogdir, logfile vallogfile.txt, vallogdir/vallogfile.txt' ) ;
+
+	SKIP: {
+	skip( 'Too hard to have a well known timezone on Windows', 6 ) if ( 'MSWin32' eq $OSNAME ) ;
+
+        local $ENV{TZ} = 'GMT' ;
+
+	$mysync = {
+                timestart => 2,
+	} ;
+
+        is( 'LOG_imapsync/1970_01_01_00_00_02_000__.txt', setlogfile( $mysync ),
+                'setlogfile: default is like LOG_imapsync/1970_01_01_00_00_02_000__.txt' ) ;
+
+        $mysync = {
+                timestart => 2,
+                user1     => 'user1',
+                user2     => 'user2',
+        } ;
+
+        is( 'LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: default is like LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync->{logdir}  = undef ;
+        $mysync->{logfile} = undef ;
+        is( 'LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: logdir undef, LOG_imapsync/1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync->{logdir} = q{} ;
+        $mysync->{logfile} = undef ;
+        is( '1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: logdir empty, 1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync->{logdir} = 'vallogdir' ;
+        $mysync->{logfile} = undef ;
+        is( 'vallogdir/1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
+                'setlogfile: logdir vallogdir, vallogdir/1970_01_01_00_00_02_000_user1_user2.txt' ) ;
+
+        $mysync = {
+                user1     => 'us/er1a*|?:"<>b',
+                user2     => 'u/ser2a*|?:"<>b',
+        } ;
+
+        is( 'LOG_imapsync/1970_01_01_00_00_00_000_us_er1a_______b_u_ser2a_______b.txt', setlogfile( $mysync ),
+                'setlogfile: logdir undef, LOG_imapsync/1970_01_01_00_00_00_000_us_er1a_______b_u_ser2a_______b.txt' ) ;
+
+
+	} ;
+
+	note( 'Leaving  tests_setlogfile()' ) ;
+        return ;
+}
+
+
+sub tests_move_slash {
+	note( 'Entering tests_move_slash()' ) ;
+
+	is( undef, move_slash(  ), 'move_slash: no parameters => undef' ) ;
+	is( '_', move_slash( '/' ), 'move_slash: / => _' ) ;
+	is( '_abc_def_', move_slash( '/abc/def/' ), 'move_slash: /abc/def/ => _abc_def_' ) ;
+	note( 'Leaving  tests_move_slash()' ) ;
 	return ;
 }
 
+sub move_slash {
+	my $string = shift ;
+
+	if ( ! defined $string ) { return ; }
+
+	$string =~ tr{/}{_} ;
+
+	return(  $string ) ;
+}
+
 sub setlogfile {
         my( $mysync ) = shift ;
+	my $suffix = ( filter_forbidden_characters( move_slash( $mysync->{user1} ) ) || q{} )
+			. '_' .
+			( filter_forbidden_characters( move_slash( $mysync->{user2} ) ) || q{} ) ;
+
         $mysync->{logdir}  = defined $mysync->{logdir}  ? $mysync->{logdir}  : 'LOG_imapsync' ;
         $mysync->{logfile} = defined $mysync->{logfile} ? "$mysync->{logdir}/$mysync->{logfile}" :
-                logfile( $mysync->{timestart}, $mysync->{user2}, $mysync->{logdir} ) ;
+                logfile( $mysync->{timestart}, $suffix, $mysync->{logdir} ) ;
         #myprint( "logdir  = $mysync->{logdir}\n"  ) ;
         #myprint( "logfile = $mysync->{logfile}\n"  ) ;
         return( $mysync->{logfile} ) ;
 }
 
-sub tests_setlogfile {
-        my $mysync = {
-                timestart => 2,
-                user2     => 'user2',
+
+sub tests_logfile {
+	note( 'Entering tests_logfile()' ) ;
+
+        SKIP: {
+                # Too hard to have a well known timezone on Windows
+                skip( 'Too hard to have a well known timezone on Windows', 8 ) if ( 'MSWin32' eq $OSNAME ) ;
+
+                local $ENV{TZ} = 'GMT' ;
+                { POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
+                        is( '1970_01_01_00_00_00_000.txt', logfile(  ),           'logfile: no args    => 1970_01_01_00_00_00.txt' ) ;
+                        is( '1970_01_01_00_00_00_000.txt', logfile( 0 ),          'logfile: 0          => 1970_01_01_00_00_00.txt' ) ;
+                        is( '1970_01_01_00_01_01_000.txt', logfile( 61 ),         'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
+                        is( '1970_01_01_00_01_01_234.txt', logfile( 61.234 ),     'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
+                        is( '2010_08_24_14_00_00_000.txt', logfile( 1_282_658_400 ), 'logfile: 1_282_658_400 => 2010_08_24_14_00_00.txt' ) ;
+                        is( '2010_08_24_14_01_01_000.txt', logfile( 1_282_658_461 ), 'logfile: 1_282_658_461 => 2010_08_24_14_01_01.txt' ) ;
+                        is( '2010_08_24_14_01_01_000_poupinette.txt', logfile( 1_282_658_461, 'poupinette' ), 'logfile: 1_282_658_461 poupinette => 2010_08_24_14_01_01_poupinette.txt' ) ;
+                        is( '2010_08_24_14_01_01_000_removeblanks.txt', logfile( 1_282_658_461, '   remove blanks  ' ), 'logfile: 1_282_658_461   remove blanks   => 2010_08_24_14_01_01_000_removeblanks' ) ;
+                }
+                POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
         } ;
 
-        ok( 'LOG_imapsync/1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: default is like LOG_imapsync/1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir}  = undef ;
-        $mysync->{logfile} = undef ;
-        ok( 'LOG_imapsync/1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir undef, LOG_imapsync/1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir} = q{} ;
-        $mysync->{logfile} = undef ;
-        ok( '1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir empty, 1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir} = 'vallogdir' ;
-        $mysync->{logfile} = undef ;
-        ok( 'vallogdir/1970_01_01_01_00_02_user2.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir vallogdir, vallogdir/1970_01_01_01_00_02_user2.txt' ) ;
-
-        $mysync->{logdir}  = 'vallogdir' ;
-        $mysync->{logfile} = 'vallogfile.txt' ;
-        ok( 'vallogdir/vallogfile.txt' eq setlogfile( $mysync ),
-                'setlogfile: logdir vallogdir, logfile vallogfile.txt, vallogdir/vallogfile.txt' ) ;
-
+	note( 'Leaving  tests_logfile()' ) ;
         return ;
 }
 
 
-sub logfile {
-	my ( $time, $suffix, $dir ) = @_ ;
 
-	$time   ||= 0 ;
-	$suffix ||= q{} ;
-	my $sep_suffix = ( $suffix ) ? '_' : q{} ;
+sub logfile  {
+        my ( $time, $suffix, $dir ) = @_ ;
+
+        $time   ||= 0 ;
+        $suffix ||= q{} ;
+	$suffix =~ tr/ //ds ;
+        my $sep_suffix = ( $suffix ) ? '_' : q{} ;
         $dir    ||= q{} ;
-	my $sep_dir = ( $dir ) ? '/' : q{} ;
+        my $sep_dir = ( $dir ) ? '/' : q{} ;
 
-	my $date_str = POSIX::strftime( '%Y_%m_%d_%H_%M_%S', localtime $time ) ;
+        my $date_str = POSIX::strftime( '%Y_%m_%d_%H_%M_%S', localtime $time ) ;
+	# Because of ab tests or web access, more than one sync withing one second is possible
+	# so we add millisecons
+	$date_str .= sprintf "_%03d", ($time - int( $time ) ) * 1000 ; # without rounding
         my $logfile = "${dir}${sep_dir}${date_str}${sep_suffix}${suffix}.txt" ;
-	$debug and myprint( "date_str: $date_str\n"  ) ;
-	$debug and myprint( "logfile : $logfile\n"  ) ;
-	return( $logfile ) ;
+        $debug and myprint( "date_str: $date_str\n"  ) ;
+        $debug and myprint( "logfile : $logfile\n"  ) ;
+        return( $logfile ) ;
 }
 
-sub tests_logfile {
-	SKIP: {
-		# Too hard to have a well known timezone on Windows
-		skip( 'Too hard to have a well known timezone on Windows', 6 ) if ( 'MSWin32' eq $OSNAME ) ;
-
-		local $ENV{TZ} = 'GMT' ;
-		{ POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
-			ok( '1970_01_01_00_00_00.txt' eq logfile(  ),           'logfile: no args    => 1970_01_01_00_00_00.txt' ) ;
-			ok( '1970_01_01_00_00_00.txt' eq logfile( 0 ),          'logfile: 0          => 1970_01_01_00_00_00.txt' ) ;
-			ok( '1970_01_01_00_01_01.txt' eq logfile( 61 ),         'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
-			ok( '2010_08_24_14_00_00.txt' eq logfile( 1282658400 ), 'logfile: 1282658400 => 2010_08_24_14_00_00.txt' ) ;
-			ok( '2010_08_24_14_01_01.txt' eq logfile( 1282658461 ), 'logfile: 1282658461 => 2010_08_24_14_01_01.txt' ) ;
-			ok( '2010_08_24_14_01_01_poupinette.txt' eq logfile( 1282658461, 'poupinette' ), 'logfile: 1282658461 poupinette => 2010_08_24_14_01_01_poupinette.txt' ) ;
-                }
-		POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
-	} ;
-	return ;
-}
-
-
-
-
-
-
-
-
-
-
-
-
 
 
 sub tests_million_folders_baby_2 {
-	my %long ;
-	@long{ 1 .. 900_000 } = (1) x 900_000 ;
-	#myprint( %long, "\n"  ) ;
-	my $pasglop = 0 ;
-	foreach my $elem (  1 .. 900_000 ) {
-		#$debug and myprint( "$elem "  ) ;
-		if ( not exists  $long{ $elem }  ) {
-			$pasglop++ ;
-		}
-	}
+	note( 'Entering tests_million_folders_baby_2()' ) ;
+
+        my %long ;
+        @long{ 1 .. 900_000 } = (1) x 900_000 ;
+        #myprint( %long, "\n"  ) ;
+        my $pasglop = 0 ;
+        foreach my $elem (  1 .. 900_000 ) {
+                #$debug and myprint( "$elem "  ) ;
+                if ( not exists  $long{ $elem }  ) {
+                        $pasglop++ ;
+                }
+        }
         ok( 0 == $pasglop, 'tests_million_folders_baby_2: search among 900_000' ) ;
-	# myprint( "$pasglop\n"  ) ;
+        # myprint( "$pasglop\n"  ) ;
+
+	note( 'Leaving  tests_million_folders_baby_2()' ) ;
         return ;
 }
 
 
 
 sub tests_always_fail {
-	ok( 0 == 1, '0 == 1' ) ;
-	ok( 1 == 1, '1 == 1' ) ;
+	note( 'Entering tests_always_fail()' ) ;
+
+        is( 0, 1, 'always_fail: 0 is 1' ) ;
+
+	note( 'Leaving  tests_always_fail()' ) ;
         return ;
 }
 
 sub logfileprepa {
-	my $logfile = shift ;
+        my $logfile = shift ;
 
-	my $dirname = dirname( $logfile ) ;
-	is_valid_directory( $dirname ) || return( 0 ) ;
-	return( 1 ) ;
+        my $dirname = dirname( $logfile ) ;
+        do_valid_directory( $dirname ) || return( 0 ) ;
+        return( 1 ) ;
 }
 
 sub teelaunch {
         my $mysync = shift ;
-	my $logfile = $mysync->{logfile} ;
-	logfileprepa( $logfile ) || croak "Error no valid directory to write log file $logfile : $!" ;
-	my $logfile_handle ;
-	open $logfile_handle, '>', $logfile
-	  or croak( "Can not open $logfile for write: $!" ) ;
-	my $tee = IO::Tee->new( $logfile_handle, \*STDOUT ) ;
-	*STDERR = *$tee{IO} ;
-	select $tee ;
+        my $logfile = $mysync->{logfile} ;
+        logfileprepa( $logfile ) || croak "Error no valid directory to write log file $logfile : $OS_ERROR" ;
+
+        open my $logfile_handle, '>', $logfile
+          or croak( "Can not open $logfile for write: $OS_ERROR" ) ;
+        my $tee = IO::Tee->new( $logfile_handle, \*STDOUT ) ;
+        *STDERR = *$tee{IO} ;
+        select $tee ;
         $tee->autoflush( 1 ) ;
         $mysync->{logfile_handle} = $logfile_handle ;
         $mysync->{tee} = $tee ;
-	return $logfile_handle ;
+        return $logfile_handle ;
 }
 
 sub getpwuid_any_os {
@@ -8706,311 +10519,641 @@ sub getpwuid_any_os {
 
         return( scalar  getlogin ) if ( 'MSWin32' eq $OSNAME ) ; # Windows system
         return( scalar  getpwuid $uid ) ; # Unix system
+
+
+}
+
+sub simulong {
+	my $max_seconds = shift ;
+	my $division = 5 ;
+	my $last = $division * $max_seconds ;
+	foreach my $i ( 1 .. ( $last ) ) {
+		myprint( "Are you still here $i/$last\n" ) ;
+		#myprint( "Are you still here $i/$last\n" . ( "Ah" x 40 . "\n") x 4000 ) ;
+		sleep( 1 / $division ) ;
+	}
+
+	return ;
 }
 
 
 
+sub printenv {
+        myprint( "Environment variables listing:\n",
+		( map { "$_ => $ENV{$_}\n" } sort keys  %ENV),
+		"Environment variables listing end\n"   ) ;
+	return ;
+}
+
+sub testsexit {
+	my $mysync = shift ;
+        if ( ! ( $mysync->{ tests }  or $mysync->{ testsdebug } or $mysync->{ testsunit } ) ) {
+		return ;
+	}
+        my $test_builder = Test::More->builder ;
+        tests( $mysync ) ; 
+        testsdebug( $mysync ) ;
+	testunitsession( $mysync ) ;
+
+	my @summary = $test_builder->summary() ;
+	my @details = $test_builder->details() ;
+	my $nb_tests_run = scalar( @summary ) ;
+	my $nb_tests_expected = $test_builder->expected_tests() ;
+	my $nb_tests_failed = count_0s( @summary ) ;
+	my $tests_failed = report_failures( @details ) ;
+	if ( $nb_tests_failed or ( $nb_tests_run != $nb_tests_expected ) ) {
+		#$test_builder->reset(  ) ;
+		myprint( "Summary of tests: failed $nb_tests_failed tests, run $nb_tests_run tests, expected to run $nb_tests_expected tests.\n",
+                "List of failed tests:\n", $tests_failed ) ;
+		exit $EXIT_TESTS_FAILED ;
+	}
+        exit ;
+	#return ;
+}
+
+sub after_get_options {
+	my $numopt = shift ;
+
+
+        # exit with --help option or no option at all
+        $debug and myprint( "numopt:$numopt\n"  ) ;
+        myprint( usage( $sync ) ) and exit  if ( $help or not $numopt ) ;
+
+        return ;
+}
+
+sub easyany {
+	my $mysync = shift ;
+
+	# Gmail
+	if ( $mysync->{gmail1} and $mysync->{gmail2} ) {
+		$debug and myprint( "gmail1 gmail2\n") ;
+		gmail12( $mysync ) ;
+		return ;
+	}
+	if ( $mysync->{gmail1}  ) {
+		$debug and myprint( "gmail1\n" ) ;
+		gmail1( $mysync ) ;
+	}
+	if ( $mysync->{gmail2} ) {
+		$debug and myprint( "gmail2\n" ) ;
+		gmail2( $mysync ) ;
+	}
+	# Office 365
+	if ( $mysync->{office1} ) {
+		office1( $mysync ) ;
+	}
+
+	if ( $mysync->{office2} ) {
+		office2( $mysync ) ;
+	}
+
+	# Domino
+	if ( $mysync->{domino1} ) {
+		domino1( $mysync ) ;
+	}
+
+	if ( $mysync->{domino2} ) {
+		domino2( $mysync ) ;
+	}
+
+
+	return ;
+}
+
+# From https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt
+sub gmail12  {
+	my $mysync = shift ;
+	# Gmail at host1 and host2
+	$mysync->{host1} ||= 'imap.gmail.com' ;
+	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
+	$mysync->{host2} ||= 'imap.gmail.com' ;
+	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
+	$mysync->{maxbytespersecond} ||= 20_000 ; # should be 10_000 computed from by Gmail documentation
+	$mysync->{maxbytesafter} ||= 1_000_000_000 ;
+	$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
+	$mysync->{maxsleep} = $MAX_SLEEP ;
+	
+	push @exclude, '\[Gmail\]$' ;
+	return ;
+}
+
+sub gmail1  {
+	my $mysync = shift ;
+	# Gmail at host2
+	$mysync->{host1} ||= 'imap.gmail.com' ;
+	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
+	$mysync->{maxbytespersecond} ||= 40_000 ; # should be 20_000 computed from by Gmail documentation
+	$mysync->{maxbytesafter} ||= 2_500_000_000 ;
+	$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
+	$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;
+	$mysync->{maxsleep} = $MAX_SLEEP ;
+	
+	push @useheader, 'X-Gmail-Received', 'Message-Id' ;
+	push @regextrans2, 's,\[Gmail\].,,' ;
+	push @folderlast, '[Gmail]/All Mail' ;
+	return ;
+}
+
+sub gmail2  {
+	my $mysync = shift ;
+	# Gmail at host2
+	$mysync->{host2} ||= 'imap.gmail.com' ;
+	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
+	$mysync->{maxbytespersecond} ||= 20_000 ; # should be 10_000 computed from by Gmail documentation
+	$mysync->{maxbytesafter} ||= 1_000_000_000 ; # In fact it is documented as half: 500_000_000
+	$maxsize ||= 25_000_000 ;
+	$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
+	$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;
+	$expunge1            = ( defined $expunge1 )  ? $expunge1  : 1 ;
+	$addheader           = ( defined $addheader ) ? $addheader : 1 ;
+	$mysync->{maxsleep} = $MAX_SLEEP ;
+	
+	push @exclude, '\[Gmail\]$' ;
+	push @useheader, 'X-Gmail-Received', 'Message-Id' ;
+	push @regextrans2, 's,\[Gmail\].,,' ;
+	push @regextrans2, 's/[ ]+/_/g' ;
+	push @regextrans2, q{s/['\\^"]/_/g} ; # Verified this
+	push @folderlast, "[Gmail]/All Mail" ;
+	return ;
+}
+
+
+# From https://imapsync.lamiral.info/FAQ.d/FAQ.Exchange.txt
+sub office1 {
+	# Office 365 at host1
+	my $mysync = shift ;
+
+	$debug and myprint( "office1 configuration\n" ) ;
+	$mysync->{host1} ||= 'outlook.office365.com' ;
+	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
+	return ;
+}
+
+sub office2 {
+	# Office 365 at host1
+	my $mysync = shift ;
+	$mysync->{host2} ||= 'outlook.office365.com' ;
+	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
+	$maxsize ||= 45_000_000 ;
+	$mysync->{maxmessagespersecond} ||= 4 ;
+	push @regexflag, 's/\\Flagged//g' ;
+	$disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
+	push @regexmess, 's,(.{10500}),$1\r\n,g' ;
+	return ;
+}
+
+sub exchange1 {
+	# Exchange 2010/2013 at host1
+
+	# Well nothing to do so far
+	return ;
+}
+
+sub exchange2 {
+	# Exchange 2010/2013 at host2
+	my $mysync = shift ;
+	$maxsize ||= 10_000_000 ;
+	$mysync->{maxmessagespersecond} ||= 4 ;
+	push @regexflag, 's/\\Flagged//g' ;
+	$disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
+	push @regexmess, 's,(.{10500}),$1\r\n,g' ;
+	return ;
+}
+
+sub domino1 {
+	# Domino at host1
+	my $mysync = shift ;
+
+	$sep1    = q{\\} ;
+	$prefix1 = q{} ;
+	$messageidnodomain = ( defined $messageidnodomain ) ? $messageidnodomain : 1 ;
+	return ;
+}
+
+sub domino2 {
+	# Domino at host1
+	my $mysync = shift ;
+
+	$sep2    = q{\\} ;
+	$prefix2 = q{} ;
+	$messageidnodomain = ( defined $messageidnodomain ) ? $messageidnodomain : 1 ;
+	push @regextrans2, 's,^Inbox\\\\(.*),$1,i' ;
+	return ;
+}
+
+
+sub tests_resolv {
+	note( 'Entering tests_resolv()' ) ;
+	
+	# is( , resolv(  ), 'resolv:  => ' ) ;
+	is( undef, resolv(  ), 'resolv: no args => undef' ) ;
+	is( undef, resolv( '' ), 'resolv: empty string => undef' ) ;
+	is( undef, resolv( 'hostnotexist' ), 'resolv: hostnotexist => undef' ) ;
+	is( '127.0.0.1', resolv( '127.0.0.1' ), 'resolv: 127.0.0.1 => 127.0.0.1' ) ;
+	is( '127.0.0.1', resolv( 'localhost' ), 'resolv: localhost => 127.0.0.1' ) ;
+	is( '5.135.158.182', resolv( 'imapsync.lamiral.info' ), 'resolv: imapsync.lamiral.info => 5.135.158.182' ) ;
+	
+	# ip6-localhost ( in /etc/hosts )
+	is( '::1', resolv( 'ip6-localhost' ), 'resolv: ip6-localhost => ::1' ) ;
+	is( '::1', resolv( '::1' ), 'resolv: ::1 => ::1' ) ;
+	# ks2
+	is( '2001:41d0:8:d8b6::1', resolv( '2001:41d0:8:d8b6::1' ),  'resolv:  2001:41d0:8:d8b6::1 => 2001:41d0:8:d8b6::1' ) ;
+	is( '2001:41d0:8:d8b6::1', resolv( 'ks2ipv6.lamiral.info' ), 'resolv: ks2ipv6.lamiral.info => 2001:41d0:8:d8b6::1' ) ;
+	# ks3
+	is( '2001:41d0:8:bebd::1', resolv( '2001:41d0:8:bebd::1' ),  'resolv:  2001:41d0:8:bebd::1 => 2001:41d0:8:bebd::1' ) ;
+	is( '2001:41d0:8:bebd::1', resolv( 'ks3ipv6.lamiral.info' ), 'resolv: ks3ipv6.lamiral.info => 2001:41d0:8:bebd::1' ) ;
+	
+	
+	note( 'Leaving  tests_resolv()' ) ;
+        return ;
+}
+
+
+
+sub resolv {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+        my $addr ;
+	if ( defined &Socket::getaddrinfo ) {
+		$addr = resolv_with_getaddrinfo( $host ) ;
+		return( $addr ) ;
+	}
+        
+        
+        
+        my $iaddr = inet_aton( $host ) ;
+        if ( ! $iaddr ) { return ; }
+        $addr = inet_ntoa( $iaddr ) ;
+	
+	return $addr ;
+}
+
+sub resolv_with_getaddrinfo {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+
+	my ( $err, @res ) = Socket::getaddrinfo( $host, "", { socktype => Socket::SOCK_RAW } ) ;
+	if (  $err ) {
+		myprint( "Cannot getaddrinfo of $host: $err\n" ) ;
+		return ;
+	}
+
+	my @addr ;
+	while( my $ai = shift @res ) {
+		my ( $err, $ipaddr ) = Socket::getnameinfo( $ai->{addr}, Socket::NI_NUMERICHOST(), Socket::NIx_NOSERV() ) ;
+		if ( $err ) {
+			myprint( "Cannot getnameinfo of $host: $err\n" ) ;
+			return ;
+		}
+		$debug and myprint "$host => $ipaddr\n" ;
+		push @addr, $ipaddr ;
+
+		my ( $err_r, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
+		$debug and myprint "$host => $ipaddr => $reverse\n" ;
+	}
+	
+        return $addr[0] ;
+}
+
+sub tests_resolvrev {
+	note( 'Entering tests_resolvrev()' ) ;
+	
+	# is( , resolvrev(  ), 'resolvrev:  => ' ) ;
+	is( undef, resolvrev(  ), 'resolvrev: no args => undef' ) ;
+	is( undef, resolvrev( '' ), 'resolvrev: empty string => undef' ) ;
+	is( undef, resolvrev( 'hostnotexist' ), 'resolvrev: hostnotexist => undef' ) ;
+	is( 'localhost', resolvrev( '127.0.0.1' ), 'resolvrev: 127.0.0.1 => localhost' ) ;
+	is( 'localhost', resolvrev( 'localhost' ), 'resolvrev: localhost => localhost' ) ;
+	is( 'ks.lamiral.info', resolvrev( 'imapsync.lamiral.info' ), 'resolvrev: imapsync.lamiral.info => ks.lamiral.info' ) ;
+	
+	# ip6-localhost ( in /etc/hosts )
+	is( 'ip6-localhost', resolvrev( 'ip6-localhost' ), 'resolvrev: ip6-localhost => ip6-localhost' ) ;
+	is( 'ip6-localhost', resolvrev( '::1' ), 'resolvrev: ::1 => ip6-localhost' ) ;
+	# ks2
+	is( 'ks2ipv6.lamiral.info', resolvrev( '2001:41d0:8:d8b6::1' ),  'resolvrev:  2001:41d0:8:d8b6::1 => ks2ipv6.lamiral.info' ) ;
+	is( 'ks2ipv6.lamiral.info', resolvrev( 'ks2ipv6.lamiral.info' ), 'resolvrev: ks2ipv6.lamiral.info => ks2ipv6.lamiral.info' ) ;
+	# ks3
+	is( 'ks3ipv6.lamiral.info', resolvrev( '2001:41d0:8:bebd::1' ),  'resolvrev:  2001:41d0:8:bebd::1 => ks3ipv6.lamiral.info' ) ;
+	is( 'ks3ipv6.lamiral.info', resolvrev( 'ks3ipv6.lamiral.info' ), 'resolvrev: ks3ipv6.lamiral.info => ks3ipv6.lamiral.info' ) ;
+	
+	
+	note( 'Leaving  tests_resolvrev()' ) ;
+        return ;
+}
+
+sub resolvrev {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+
+	if ( defined &Socket::getaddrinfo ) {
+		my $name = resolvrev_with_getaddrinfo( $host ) ;
+		return( $name ) ;
+	}
+	
+	return ;
+}
+
+sub resolvrev_with_getaddrinfo {
+	my $host = shift @ARG ;
+	
+	if ( ! $host ) { return ; }
+
+	my ( $err, @res ) = Socket::getaddrinfo( $host, "", { socktype => Socket::SOCK_RAW } ) ;
+	if (  $err ) {
+		myprint( "Cannot getaddrinfo of $host: $err\n" ) ;
+		return ;
+	}
+
+	my @name ;
+	while( my $ai = shift @res ) {
+		my ( $err, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
+		if ( $err ) {
+			myprint( "Cannot getnameinfo of $host: $err\n" ) ;
+			return ;
+		}
+		$debug and myprint "$host => $reverse\n" ;
+		push @name, $reverse ;
+	}
+	
+    return $name[0] ;
+}
+
+
+
+sub tests_imapsping {
+	note( 'Entering tests_imapsping()' ) ;
+
+	is( undef, imapsping(  ), 'imapsping: no args => undef' ) ;
+	is( undef, imapsping( 'hostnotexist' ), 'imapsping: hostnotexist => undef' ) ;
+	is( 1, imapsping( 'imapsync.lamiral.info' ), 'imapsping: imapsync.lamiral.info => 1' ) ;
+        is( 1, imapsping( 'ks2ipv6.lamiral.info' ), 'imapsping: ks2ipv6.lamiral.info => 1' ) ;
+	note( 'Leaving  tests_imapsping()' ) ;
+	return ;
+}
+
+sub imapsping {
+	my $host = shift ;
+	return tcpping( $host, $IMAP_SSL_PORT ) ;
+}
+
+sub tests_tcpping {
+	note( 'Entering tests_tcpping()' ) ;
+
+	is( undef, tcpping(  ), 'tcpping: no args => undef' ) ;
+	is( undef, tcpping( 'hostnotexist' ), 'tcpping: one arg => undef' ) ;
+	is( undef, tcpping( undef, 888 ), 'tcpping: arg undef, port => undef' ) ;
+	is( undef, tcpping( 'hostnotexist', 993 ), 'tcpping: hostnotexist 993 => undef' ) ;
+	is( undef, tcpping( 'hostnotexist', 888 ), 'tcpping: hostnotexist 888 => undef' ) ;
+	is( 1, tcpping( 'imapsync.lamiral.info', 993 ), 'tcpping: imapsync.lamiral.info 993 => 1' ) ;
+	is( 0, tcpping( 'imapsync.lamiral.info', 888 ), 'tcpping: imapsync.lamiral.info 888 => 0' ) ;
+	is( 1, tcpping( '5.135.158.182', 993 ), 'tcpping: 5.135.158.182 993 => 1' ) ;
+	is( 0, tcpping( '5.135.158.182', 888 ), 'tcpping: 5.135.158.182 888 => 0' ) ;
+
+	# Net::Ping supports ipv6 only after release 1.50
+	# http://cpansearch.perl.org/src/RURBAN/Net-Ping-2.59/Changes
+	# Anyway I plan to avoid Net-Ping for that too long standing feature
+	# Net-Ping is integrated in Perl itself, who knows ipv6 for a long time
+	is( 1, tcpping( '2001:41d0:8:d8b6::1', 993 ), 'tcpping: 2001:41d0:8:d8b6::1 993 => 1' ) ;
+	is( 0, tcpping( '2001:41d0:8:d8b6::1', 888 ), 'tcpping: 2001:41d0:8:d8b6::1 888 => 0' ) ;
+
+	note( 'Leaving  tests_tcpping()' ) ;
+	return ;
+}
+
+sub tcpping {
+	if ( 2 != scalar( @ARG ) ) {
+		return ;
+	}
+	my ( $host, $port ) = @ARG ;
+	if ( ! $host ) { return ; }
+	if ( ! $port ) { return ; }
+
+	my $mytimeout = $TCP_PING_TIMEOUT ;
+        require Net::Ping ;
+	#my $p = Net::Ping->new( 'tcp' ) ;
+	my $p = Net::Ping->new(  ) ;
+	$p->{port_num} = $port ;
+	$p->service_check( 1 ) ;
+	$p->hires( 1 ) ;
+	my ($ping_ok, $rtt, $ip ) = $p->ping( $host, $mytimeout ) ;
+	if ( ! defined $ping_ok ) { return ; }
+	my $rtt_approx = sprintf( "%.3f", $rtt ) ;	
+	$debug and myprint( "Host $host timeout $mytimeout port $port ok $ping_ok ip $ip acked in $rtt_approx s\n" ) ;
+	$p->close(  ) ;
+	if( $ping_ok ) {
+		return 1 ;
+	}else{
+		return 0 ;
+	}
+}
+
+sub tests_sslcheck {
+	note( 'Entering tests_sslcheck()' ) ;
+
+	my $mysync ;
+
+	is( undef, sslcheck( $mysync ), 'sslcheck: no sslcheck => undef' ) ;
+
+	$mysync = {
+		sslcheck => 1,
+	} ;
+
+	is( 0, sslcheck( $mysync ), 'sslcheck: no host => 0' ) ;
+
+	$mysync = {
+		sslcheck => 1,
+		host1 => 'imapsync.lamiral.info',
+		tls1 => 1,
+	} ;
+
+	is( 0, sslcheck( $mysync ), 'sslcheck: tls1 => 0' ) ;
+
+	$mysync = {
+		sslcheck => 1,
+		host1 => 'imapsync.lamiral.info',
+	} ;
+
+
+	is( 1, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info => 1' ) ;
+	is( 1, $mysync->{ssl1}, 'sslcheck: imapsync.lamiral.info => ssl1 1' ) ;
+
+	$mysync->{sslcheck} = 0 ;
+	is( undef, sslcheck( $mysync ), 'sslcheck: sslcheck off => undef' ) ;
+
+	note( 'Leaving  tests_sslcheck()' ) ;
+	return ;
+}
+
+sub sslcheck {
+	my $mysync = shift ;
+
+	if ( ! $mysync->{sslcheck} ) {
+		return ;
+	}
+	my $nb_on = 0 ;
+	$debug and myprint( "sslcheck\n" ) ;
+	if (
+		( ! defined $mysync->{port1} )
+		and
+		( ! defined $mysync->{tls1} )
+		and
+		( ! defined $mysync->{ssl1} )
+		and
+		( defined $mysync->{host1} )
+		and
+		( probe_imapssl( $mysync->{host1} ) )
+	) {
+		$mysync->{ssl1} = 1 ;
+		myprint( "Host1: sslcheck detected open ssl port $IMAP_SSL_PORT so turning ssl on (use --nossl1 --notls1 to turn off SSL and TLS wizardry)\n" ) ;
+		$nb_on++ ;
+	}
+
+	if (
+		( ! defined $mysync->{port2} )
+		and
+		( ! defined $mysync->{tls2} )
+		and
+		( ! defined $mysync->{ssl2} )
+		and
+		( defined $mysync->{host2} )
+		and
+		( probe_imapssl( $mysync->{host2} ) )
+	) {
+		$mysync->{ssl2} = 1 ;
+		myprint( "Host2: sslcheck detected open ssl port $IMAP_SSL_PORT so turning ssl on (use --nossl2 --notls2 to turn off SSL and TLS wizardry)\n" ) ;
+		$nb_on++ ;
+	}
+	return $nb_on ;
+}
+
+
+sub testslive {
+        my $mysync = shift ;
+        $mysync->{host1} = 'test1.lamiral.info' ;
+        $mysync->{user1} = 'test1' ;
+        $mysync->{password1} = 'secret1' ;
+        $mysync->{host2} = 'test2.lamiral.info' ;
+        $mysync->{user2} = 'test2' ;
+        $mysync->{password2} ='secret2' ;
+        return ;
+}
+
+sub testslive6 {
+        my $mysync = shift ;
+        $mysync->{host1} = 'ks2ipv6.lamiral.info' ;
+        $mysync->{user1} = 'test1' ;
+        $mysync->{password1} = 'secret1' ;
+        $mysync->{host2} = 'ks2ipv6.lamiral.info' ;
+        $mysync->{user2} = 'test2' ;
+        $mysync->{password2} ='secret2' ;
+        return ;
+}
+
+
+sub tests_backslash_caret {
+        note( 'Entering tests_backslash_caret()' ) ;
+
+        is( "lalala", backslash_caret( "lalala" ), 'backslash_caret: lalala => lalala' ) ;
+        is( "lalala\n", backslash_caret( "lalala\n" ), 'backslash_caret: lalala => lalala 2nd' ) ;
+        is( '^', backslash_caret( '\\' ), 'backslash_caret: \\ => ^' ) ;
+        is( "^\n", backslash_caret( "\\\n" ), 'backslash_caret: \\ => ^' ) ;
+        is( "\\lalala", backslash_caret( "\\lalala" ), 'backslash_caret: \\lalala => \\lalala' ) ;
+        is( "\\lal\\ala", backslash_caret( "\\lal\\ala" ), 'backslash_caret: \\lal\\ala => \\lal\\ala' ) ;
+        is( "\\lalala\n", backslash_caret( "\\lalala\n" ), 'backslash_caret: \\lalala => \\lalala 2nd' ) ;
+        is( "lalala^\n", backslash_caret( "lalala\\\n" ), 'backslash_caret: lalala\\\n => lalala^\n' ) ;
+        is( "lalala^\nlalala^\n", backslash_caret( "lalala\\\nlalala\\\n" ), 'backslash_caret: lalala\\\nlalala\\\n => lalala^\nlalala^\n' ) ;
+        is( "lal\\ala^\nlalala^\n", backslash_caret( "lal\\ala\\\nlalala\\\n" ), 'backslash_caret: lal\\ala\\\nlalala\\\n => lal\\ala^\nlalala^\n' ) ;
+
+        note( 'Leaving  tests_backslash_caret()' ) ;
+        return ;
+}
+
+sub backslash_caret {
+        my $string = shift ;
+        
+        $string =~ s{\\ $ }{^}gxms ;
+
+        return $string ;
+}
+
 sub usage {
-	my $localhost_info = localhost_info();
-	my $thank = thank_author();
-	my $imapsync_release = q{};
-	$imapsync_release = check_last_release() if (not defined $releasecheck);
-        my $escape_char = ( 'MSWin32' eq $OSNAME ) ? '^' : '\\';
-        myprint( <<"EOF" ) ;
+	my $mysync = shift ;
+        
+        my $usage = q{} ;
+        my $usage_from_pod ;
+        my $usage_footer = usage_footer( $mysync ) ;
 
- usage: $0 [options]
+        # pod2usage writes on a filehandle only and I want a variable
+        open my $fh_pod2usage, ">", \$usage_from_pod or do { 
+                warn $OS_ERROR ;
+                return ;
+        } ;
+        
+        pod2usage( 
+                -exitval   => 'NOEXIT',
+                -noperldoc => 1,
+                -verbose => 99,
+                -sections => [ qw(NAME VERSION USAGE OPTIONS) ],
+                -indent => 1,
+                -loose => 1,
+                -output => $fh_pod2usage,
+        ) ;
+        close $fh_pod2usage ;
+        
+        if ( 'MSWin32' eq $OSNAME ) {
+                $usage_from_pod = backslash_caret( $usage_from_pod ) ;
+        }
+        $usage = join( q{}, $usage_from_pod, $usage_footer ) ;
 
- Several options are mandatory.
- str means string
- int means integer
- reg means regular expression
- cmd means command
+        return( $usage ) ;
+}
 
- --dry               : Makes imapsync doing nothing, just print what would
-                       be done without --dry.
+sub tests_usage {
+        my $usage ;
+        like( $usage = usage( $sync ), qr/Name:/, 'usage2: contains Name:' ) ;
+        myprint( $usage ) ;
+        like( $usage, qr/Version:/, 'usage2: contains Version:' ) ;
+        like( $usage, qr/Usage:/, 'usage2: contains Usage:' ) ;
+        like( $usage, qr/imapsync/, 'usage2: contains imapsync' ) ;
+        return ;
+}
 
- --host1        str  : Source or "from" imap server. Mandatory.
- --port1        int  : Port to connect on host1. Default is 143, 993 if --ssl1
- --user1        str  : User to login on host1. Mandatory.
- --showpasswords     : Shows passwords on output instead of "MASKED".
-                       Useful to restart a complete run by just reading the log.
- --password1    str  : Password for the user1.
- --host2        str  : "destination" imap server. Mandatory.
- --port2        int  : Port to connect on host2. Default is 143, 993 if --ssl2
- --user2        str  : User to login on host2. Mandatory.
- --password2    str  : Password for the user2.
+sub usage_footer {
+	my $mysync = shift ;
+        
+        my $footer = q{} ;
 
- --passfile1    str  : Password file for the user1. It must contain the
-                       password on the first line. This option avoids to show
-                       the password on the command line like --password1 does.
- --passfile2    str  : Password file for the user2. Contains the password.
+        my $localhost_info = localhost_info(  ) ;
+        my $rcs = $mysync->{rcs} ;
+        my $homepage = homepage(  ) ;
+        my $imapsync_release = q{} ;
+        $imapsync_release = check_last_release(  ) if ( not defined $releasecheck ) ;
 
- --ssl1              : Use a SSL connection on host1.
- --ssl2              : Use a SSL connection on host2.
- --tls1              : Use a TLS connection on host1.
- --tls2              : Use a TLS connection on host2.
- --debugssl     int  : SSL debug mode from 0 to 4.
- --sslargs1     str  : Pass any ssl parameter for host1 ssl or tls connection. Example:
-                       --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3
-                       See all possibilities in the new() method of IO::Socket::SSL
-                       http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods
- --sslargs2     str  : Pass any ssl parameter for host2 ssl or tls connection.
-                       See --sslargs1
-
- --timeout1     int  : Connection timeout in seconds for host1.
-                       Default is 120 and 0 means no timeout at all.
- --timeout2     int  : Connection timeout in seconds for host2.
-                       Default is 120 and 0 means no timeout at all.
-
- --authmech1    str  : Auth mechanism to use with host1:
-                       PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
- --authmech2    str  : Auth mechanism to use with host2. See --authmech1
-
- --authuser1    str  : User to auth with on host1 (admin user).
-                       Avoid using --authmech1 SOMETHING with --authuser1.
- --authuser2    str  : User to auth with on host2 (admin user).
- --proxyauth1        : Use proxyauth on host1. Requires --authuser1.
-                       Required by Sun/iPlanet/Netscape IMAP servers to
-                       be able to use an administrative user.
- --proxyauth2        : Use proxyauth on host2. Requires --authuser2.
-
- --authmd51          : Use MD5 authentification for host1.
- --authmd52          : Use MD5 authentification for host2.
- --domain1      str  : Domain on host1 (NTLM authentication).
- --domain2      str  : Domain on host2 (NTLM authentication).
-
-
- --folder       str  : Sync this folder.
- --folder       str  : and this one, etc.
- --folderrec    str  : Sync this folder recursively.
- --folderrec    str  : and this one, etc.
-
- --folderfirst  str  : Sync this folder first. --folderfirst "Work"
- --folderfirst  str  : then this one, etc.
- --folderlast   str  : Sync this folder last. --folderlast "[Gmail]/All Mail"
- --folderlast   str  : then this one, etc.
-
- --nomixfolders      : Do not merge folders when host1 is case sensitive
-                       while host2 is not (like Exchange). Only the first
-                       similar folder is synced (ex: Sent SENT sent -> Sent).
-
- --skipemptyfolders  : Empty host1 folders are not created on host2.
-
- --include      reg  : Sync folders matching this regular expression
- --include      reg  : or this one, etc.
-                       in case both --include --exclude options are
-                       use, include is done before.
- --exclude      reg  : Skips folders matching this regular expression
-                       Several folders to avoid:
-                        --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
- --exclude      reg  : or this one, etc.
-
- --subfolder2   str  : Move whole host1 folders hierarchy under this
-                       host2 folder  str    .
-                       It does it by adding two --regextrans2 options before
-                       all others. Add --debug to see what's really going on.
-
- --automap           : guesses folders mapping, for folders like
-                       "Sent", "Junk", "Drafts", "All", "Archive", "Flagged".
- --f1f2    str1=str2 : Force folder str1 to be synced to str2,
-                       --f1f2 overrides --automap and --regextrans2.
- --regextrans2  reg  : Apply the whole regex to each destination folders.
- --regextrans2  reg  : and this one. etc.
-                       When you play with the --regextrans2 option, first
-                       add also the safe options --dry --justfolders
-                       Then, when happy, remove --dry, remove --justfolders.
-                       Have in mind that --regextrans2 is applied after prefix
-                       and separator inversion. For examples see
-                       http://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt
-
- --tmpdir       str  : Where to store temporary files and subdirectories.
-                       Will be created if it doesn't exist.
-                       Default is system specific, Unix is /tmp but
-                       it's often small and deleted at reboot.
-                       --tmpdir /var/tmp should be better.
- --pidfile      str  : The file where imapsync pid is written.
- --pidfilelocking    : Abort if pidfile already exists. Usefull to avoid
-                       concurrent transfers on the same mailbox.
-
- --nolog             : Turn off logging on file
- --logfile      str  : Change the default log filename (can be dirname/filename).
- --logdir       str  : Change the default log directory. Default is LOG_imapsync
-
- --prefix1      str  : Remove prefix to all destination folders
-                       (usually INBOX. or INBOX/ or an empty string "")
-                       you have to use --prefix1 if host1 imap server
-                       does not have NAMESPACE capability, so imapsync
-                       suggests to use it. All other cases are bad.
- --prefix2      str  : Add prefix to all host2 folders. See --prefix1
- --sep1         str  : Host1 separator in case NAMESPACE is not supported.
- --sep2         str  : Host2 separator in case NAMESPACE is not supported.
-
- --skipmess     reg  : Skips messages maching the regex.
-                       Example: 'm/[\\x80-ff]/' # to avoid 8bits messages.
-                       --skipmess is applied before --regexmess
- --skipmess     reg  : or this one, etc.
-
- --pipemess     cmd  : Apply this cmd command to each message content
-                       before the copy.
- --pipemess     cmd  : and this one, etc.
-
- --disarmreadreceipts : Disarms read receipts (host2 Exchange issue)
-
- --regexmess    reg  : Apply the whole regex to each message before transfer.
-                       Example: 's/\\000/ /g' # to replace null by space.
- --regexmess    reg  : and this one, etc.
-
- --regexflag    reg  : Apply the whole regex to each flags list.
-                       Example: 's/\"Junk"//g' # to remove "Junk" flag.
- --regexflag    reg  : and this one, etc.
-
- --delete            : Deletes messages on host1 server after a successful
-                       transfer. Option --delete has the following behavior:
-                       it marks messages as deleted with the IMAP flag
-                       \\Deleted, then messages are really deleted with an
-                       EXPUNGE IMAP command.
-
- --delete2           : Delete messages in host2 that are not in
-                       host1 server. Useful for backup or pre-sync.
- --delete2duplicates : Delete messages in host2 that are duplicates.
-                       Works only without --useuid since duplicates are
-                       detected with an header part of each message.
-
- --delete2folders    : Delete folders in host2 that are not in host1 server.
-                       For safety, first try it like this (it is safe):
-                       --delete2folders --dry --justfolders --nofoldersizes
- --delete2foldersonly   reg : Deleted only folders matching regex.
-                              Example: --delete2foldersonly "/^Junk\$|^INBOX.Junk\$/"
- --delete2foldersbutnot reg : Do not delete folders matching regex.
-                              Example: --delete2foldersbutnot "/Tasks\$|Contacts\$|Foo\$/"
- --noexpunge         : Do not expunge messages on host1.
-                       Expunge really deletes messages marked deleted.
-                       Expunge is made at the beginning, on host1 only.
-                       Newly transferred messages are also expunged if
-                       option --delete is given.
-                       No expunge is done on host2 account (unless --expunge2)
- --expunge1          : Expunge messages on host1 after messages transfer.
- --expunge2          : Expunge messages on host2 after messages transfer.
- --uidexpunge2       : uidexpunge messages on the host2 account
-                       that are not on the host1 account, requires --delete2
- --nomixfolders      : Avoid merging folders that are considered different on
-                       host1 but the same on destination host2 because of
-                       case sensitivities and insensitivities.
-
- --syncinternaldates : Sets the internal dates on host2 same as host1.
-                       Turned on by default. Internal date is the date
-                       a message arrived on a host (mtime).
- --idatefromheader   : Sets the internal dates on host2 same as the
-                       "Date:" headers.
-
- --maxsize      int  : Skip messages larger  (or equal) than  int  bytes
- --minsize      int  : Skip messages smaller (or equal) than  int  bytes
- --maxage       int  : Skip messages older than  int  days.
-                       final stats (skipped) don't count older messages
-                       see also --minage
- --minage       int  : Skip messages newer than  int  days.
-                       final stats (skipped) don't count newer messages
-                       You can do (+ are the messages selected):
-                       past|----maxage+++++++++++++++>now
-                       past|+++++++++++++++minage---->now
-                       past|----maxage+++++minage---->now (intersection)
-                       past|++++minage-----maxage++++>now (union)
-
- --search       str  : Selects only messages returned by this IMAP SEARCH
-                       command. Applied on both sides.
- --search1      str  : Same as --search for selecting host1 messages only.
- --search2      str  : Same as --search for selecting host2 messages only.
-                       --search CRIT equals --search1 CRIT --search2 CRIT
-
- --exitwhenover int  : Stop syncing when total bytes transferred reached.
-                       Gmail per day allows
-                       2500000000 = 2.5 GB downloaded from Gmail as host2
-                        500000000 = 500 MB uploaded to Gmail as host1.
-
- --maxlinelength int : skip messages with a line length longer than  int  bytes.
-                       RFC 2822 says it must be no more than 1000 bytes.
-
- --useheader    str  : Use this header to compare messages on both sides.
-                       Ex: Message-ID or Subject or Date.
- --useheader    str    and this one, etc.
-
- --subscribed        : Transfers subscribed folders.
- --subscribe         : Subscribe to the folders transferred on the
-                       host2 that are subscribed on host1. On by default.
- --subscribeall      : Subscribe to the folders transferred on the
-                       host2 even if they are not subscribed on host1.
-
- --nofoldersizes     : Do not calculate the size of each folder in bytes
-                       and message counts. Default is to calculate them.
- --nofoldersizesatend: Do not calculate the size of each folder in bytes
-                       and message counts at the end. Default is on.
- --justfoldersizes   : Exit after having printed the folder sizes.
-
- --syncacls          : Synchronises acls (Access Control Lists).
- --nosyncacls        : Does not synchronize acls. This is the default.
-                       Acls in IMAP are not standardized, be careful.
-
- --usecache          : Use cache to speedup.
- --nousecache        : Do not use cache. Caveat: --useuid --nousecache creates
-                       duplicates on multiple runs.
- --useuid            : Use uid instead of header as a criterium to recognize
-                       messages. Option --usecache is then implied unless
-                       --nousecache is used.
-
- --debug             : Debug mode.
- --debugfolders      : Debug mode for the folders part only.
- --debugcontent      : Debug content of the messages transfered. Huge ouput.
- --debugflags        : Debug mode for flags.
- --debugimap1        : IMAP debug mode for host1. Very verbose.
- --debugimap2        : IMAP debug mode for host2. Very verbose.
- --debugimap         : IMAP debug mode for host1 and host2.
- --debugmemory       : Debug mode showing memory consumption after each copy.
-
- --errorsmax     int : Exit when int number of errors is reached. Default is 50.
-
- --tests             : Run local non-regression tests. Exit code 0 means all ok.
- --testslive         : Run a live test with test1.lamiral.info imap server.
-                       Useful to check the basics. Needs internet connexion.
-
- --version           : Print only software version.
- --noreleasecheck    : Do not check for new imapsync release (a http request).
- --releasecheck      : Check for new imapsync release (a http request).
- --noid              : Do not send/receive ID command to imap servers.
- --justconnect       : Just connect to both servers and print useful
-                       information. Need only --host1 and --host2 options.
- --justlogin         : Just login to both host1 and host2 with users
-                       credentials, then exit.
- --justfolders       : Do only things about folders (ignore messages).
-
- --help              : print this help.
-
- Example: to synchronize imap account "test1" on "test1.lamiral.info"
-                     to  imap account "test2" on "test2.lamiral.info"
-                     with test1 password "secret1"
-                     and  test2 password "secret2"
-
- $0 $escape_char
-    --host1 test1.lamiral.info --user1 test1 --password1 secret1 $escape_char
-    --host2 test2.lamiral.info --user2 test2 --password2 secret2
-
-$localhost_info
+        $footer = 
+        qq{$localhost_info
 $rcs
 $imapsync_release
 
-$thank
-EOF
-	return( 1 ) ;
+$homepage
+} ;
+        return( $footer ) ;
 }
 
 
+
 sub usage_complete {
-	myprint( <<'EOF'  ) ;
+        # Unused, I guess this function could be deleted
+        my $usage = <<'EOF' ;
 --skipheader   reg     : Don't take into account header keyword
                          matching  reg    ex: --skipheader 'X.*'
 
 --skipsize             : Don't take message size into account to compare
                          messages on both sides. On by default.
-			 Use --no-skipsize for using size comparaison.
+                         Use --no-skipsize for using size comparaison.
 --allowsizemismatch    : allow RFC822.SIZE != fetched msg size
                          consider also --skipsize to avoid duplicate messages
                          when running syncs more than one time per mailbox
@@ -9024,48 +11167,283 @@ sub usage_complete {
 --split2      int      : same thing on host2.
 --nofixInboxINBOX      : Don't fix Inbox INBOX mapping.
 EOF
+        return( $usage ) ;
+}
+
+
+sub myGetOptions {
+# Started as a copy of Luke Ross Getopt::Long::CGI
+# https://metacpan.org/release/Getopt-Long-CGI
+# So this sub function is under the same license as Getopt-Long-CGI Luke Ross wants it,
+# which was Perl 5.6 or later licenses at the date of the copy.
+
+    my $mycgi = shift @ARG ;
+    my $arguments_ref = shift @ARG ;
+    my %options = @ARG ;
+
+    if ( not under_cgi_context(  ) ) {
+        # Not CGI - pass upstream for normal command line handling
+        return Getopt::Long::GetOptionsFromArray( $arguments_ref, %options ) ;
+    }
+    my $b_ref = $options{'debugbasket=s'} ;
+
+    my $badthings = 0 ;
+    foreach my $key (sort keys %options) {
+        my $val = $options{$key};
+        #push( @{$b_ref}, "opt:[$key] val:[$val]" . ( ('SCALAR' eq ref($val) and defined  $$val  ) ? " [$$val]" : q{} ) . "\n" ) ;
+
+        if ( $key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/mxs ) {
+                push  @{$b_ref}, "Unknown option type: [$key]\n"  ;
+		$badthings++ ;
+            next ; # Unknown item
+        }
+
+        my $name = [split '|', $1, 1 ]->[0];
+
+        if (($3 || q{}) eq '+') {
+            ${ $val } = $mycgi->param($name); # "Incremental" integer
+        } elsif ($2) {
+            my @values = $mycgi->multi_param($name);
+            my $type = $2;
+	    #myprint( "[$type][@values][", $3 || q{}, "][$val][", ref($val), "]\n" ) ;
+            if (($3 || q{}) eq '%' or ref($val) eq 'HASH') {
+                my %values = map { split /=/mxs, $_ } @values;
+
+                if ($type =~ m/i$/mxs) {
+                    foreach my $k (keys %values) {
+                        $values{$k} = int $values{$k} ;
+                    }
+                } elsif ($type =~ m/f$/mxs) {
+                    foreach my $k (keys %values) {
+                        $values{$k} = 0 + $values{$k}
+                    }
+                }
+                if ( 'REF' eq ref $val ) {
+                        #push( @{$b_ref}, "refref($$val): " . ref($$val) . " %values= ", %values, "\n\n" ) ;
+                        %{ ${ $val } } = %values;
+                } else {
+                        #push( @{$b_ref}, "ref($val): " . ref($val) . " %values= ", %values, "\n\n" ) ;
+                        %{ $val } = %values;
+                }
+            } else {
+                if ($type =~ m/i$/mxs) {
+                    @values = map { int $_ } @values;
+                } elsif ($type =~ m/f$/mxs) {
+                    @values = map { 0 + $_ } @values;
+                }
+                if (($3 || q{}) eq '@' or ref($val) eq 'ARRAY') {
+                    @{ $val } = @values ;
+                } else {
+                    ${ $val } = $values[0] ;
+                }
+            }
+        } else {
+            # Checkbox
+	    # Considers only --name
+	    # Should consider also --no-name and --noname
+            ${ $val } = $mycgi->param($name) ? 1 : undef ;
+            #push( @{$b_ref}, "param($name) ref($val): " . ref($val) . " val=[$$val]\n\n" ) ;
+	    #myprint( "param($name) ref($val): " . ref($val) . " val=[$$val]\n\n" ) ;
+	    #myprint( "param($name) ref($val): " . ref($val) . " \n\n" ) ;
+        }
+    }
+    if ( $badthings ) {
+		return ; # undef or ()
+    } else {
+		return( 1 ) ;
+    }
+}
+
+
+sub tests_get_options  {
+	note( 'Entering tests_get_options()' ) ;
+
+	# CAVEAT: still setting global variables, be carefull
+	# with tests, the context increases! $debug stays on for example.
+	# API:
+	# * input arguments: two ways, command line or CGI
+	#    * the program arguments
+	#    * QUERY_STRING env variable
+	# * return
+	#   * undef if bad things happened like
+	#     * options not known
+	#     * --delete 2 input
+	#   * number of arguments or QUERY_STRING length
+	my $mysync ;
+	is( undef, get_options( $mysync, qw( --noexist ) ),                   'get_options: --noexist  => undef' ) ;
+	is( undef, get_options( $mysync, qw( --lalala --noexist --version ) ), 'get_options: --lalala --noexist --version  => undef' ) ;
+	is( undef, get_options( $mysync, qw( --delete 2 ) ), 'get_options: --delete 2 => undef' ) ;
+	is( 1,     get_options( $mysync, "--version" ), 'get_options: --version => 1' ) ;
+	is( 1,     get_options( $mysync, "--help" ), 'get_options: --help => 1' ) ;
+	is( undef, get_options( $mysync, qw( --debug --noexist --version ) ), 'get_options: --debug --noexist --version  => undef' ) ;
+
+	note( 'Leaving  tests_get_options()' ) ;
+	return ;
+}
+
+sub tests_get_options_cgi  {
+	note( 'Entering tests_get_options_cgi()' ) ;
+
+# Temporary, have to think harder about testing CGI context in command line --tests
+	# API:
+	# * input arguments: two ways, command line or CGI
+	#    * the program arguments
+	#    * QUERY_STRING env variable
+	# * return
+	#   * QUERY_STRING length
+
+	# CGI context
+	local $ENV{SERVER_SOFTWARE} = 'Votre serviteur' ;
+
+	# Real full test
+	# = 'host1=test1.lamiral.info&user1=test1&password1=secret1&host2=test2.lamiral.info&user2=test2&password2=secret2&debugenv=on'
+	my $mysync ;
+	require CGI ;
+	CGI->import( qw( -no_debug ) ) ;
+
+	# Testing boolean
+	$mysync->{cgi} = CGI->new( 'version=on&debugenv=on' ) ;
+	local $ENV{'QUERY_STRING'} = 'version=on&debugenv=on' ;
+	is( 22,   get_options_cgi( $mysync ), 'get_options: QUERY_STRING => 22' ) ;
+	is(  1,   $version,        'get_options: $version => 1' ) ;
+	# debugenv is not allowed in cgi context
+	is(  undef,   $mysync->{debugenv},        'get_options: $mysync->{debugenv} => undef' ) ;
+
+	# QUERY_STRING in this test is only for return value of get_options_cgi
+	# Have to think harder, GET/POST context, is this return value a good thing?
+	local $ENV{'QUERY_STRING'} = 'host1=test1.lamiral.info&user1=test1' ;
+	$mysync->{cgi} = CGI->new( 'host1=test1.lamiral.info&user1=test1' ) ;
+	is( 36,      get_options_cgi( $mysync,  ), 'get_options: QUERY_STRING => 36' ) ;
+	is( 'test1',  $mysync->{user1},    'get_options: $mysync->{user1} => test1' ) ;
+
+	# Testing @
+	$mysync->{cgi} = CGI->new( 'folder=fd1' ) ;
+	get_options_cgi( $mysync ) ;
+	is_deeply( [ 'fd1' ],  [ @folder ],    'get_options: @folder => fd1' ) ;
+	$mysync->{cgi} = CGI->new( 'folder=fd1&folder=fd2' ) ;
+	get_options_cgi( $mysync ) ;
+	is_deeply( [ 'fd1', 'fd2' ],  [ @folder ],    'get_options: @folder => fd1' ) ;
+
+	# Testing %
+	$mysync->{cgi} = CGI->new( 'f1f2=s1=d1&f1f2=s2=d2&f1f2=s3=d3' ) ;
+	get_options_cgi( $mysync ) ;
+	#$mysync->{f1f2} = { 's1' => 'd1', 's2' => 'd2' } ;
+	is_deeply( { 's1' => 'd1', 's2' => 'd2', 's3' => 'd3' },
+	$mysync->{f1f2}, 'get_options: f1f2 => s1=d1 s2=d2 s3=d3' ) ;
+
+	# Testing boolean ! with --noxxx, doesnot work
+	$mysync->{cgi} = CGI->new( 'nodry=on' ) ;
+	is( undef,  $mysync->{dry},    'get_options: --nodry => $mysync->{dry} => 0' ) ;
+
+	note( 'Leaving  tests_get_options_cgi()' ) ;
 	return ;
 }
 
 
 
-sub get_options {
-	# In CGI context arguments are not in @ARGV but in QUERY_STRING variable (with GET).
-	my $numopt = scalar  @ARGV  || length $ENV{'QUERY_STRING'} ;
-	my $argv   = join "\x00", @ARGV ;
+sub get_options_cgi {
+        # In CGI context arguments are not in @ARGV but in QUERY_STRING variable (with GET).
+	my $mysync = shift @ARG ;
+	my $mycgi = $mysync->{cgi} || return ;
+	my @arguments = @ARG ;
+	# final 0 is used to print usage when no option is given
+        my $numopt = length $ENV{'QUERY_STRING'} || 1 ;
+	$mysync->{f1f2} = {} ;
+        my $opt_ret = myGetOptions(
+	$mycgi,
+	\@arguments,
+	'abort'            => \$mysync->{abort},
+        'host1=s'          => \$mysync->{host1},
+        'host2=s'          => \$mysync->{host2},
+        'user1=s'          => \$mysync->{user1},
+        'user2=s'          => \$mysync->{user2},
+        'password1=s'      => \$mysync->{password1},
+        'password2=s'      => \$mysync->{password2},
+        'dry!'             => \$mysync->{dry},
+        'version'          => \$version,
+        'ssl1!'            => \$mysync->{ssl1},
+        'ssl2!'            => \$mysync->{ssl2},
+        'tls1!'            => \$mysync->{tls1},
+        'tls2!'            => \$mysync->{tls2},
+        'justlogin!'       => \$justlogin,
+        'addheader!'       => \$addheader,
+        'automap!'         => \$mysync->{automap},
+        'justautomap!'     => \$mysync->{justautomap},
+	'gmail1'           => \$mysync->{gmail1},
+	'gmail2'           => \$mysync->{gmail2},
+	'office1'          => \$mysync->{office1},
+	'office2'          => \$mysync->{office2},
+	'exchange1'        => \$mysync->{exchange1},
+	'exchange2'        => \$mysync->{exchange2},
+	'domino1'          => \$mysync->{domino1},
+	'domino2'          => \$mysync->{domino2},
+        'f1f2=s%'          => \$mysync->{f1f2},
+        'folder=s'         => \@folder,
+        'testslive!'       => \$mysync->{testslive},
+        'testslive6!'      => \$mysync->{testslive6},
+        ) ;
 
-	if ( $argv =~ m/-delete\x002/x ) {
-		myprint( "May be you mean --delete2 instead of --delete 2\n"  ) ;
-		exit 1 ;
+        $debug and output( $mysync, "get options: [$opt_ret][$numopt]\n"  ) ;
+
+	if ( ! $opt_ret ) {
+		return ;
 	}
-	$sync->{f1f2} = {} ;
-        my $opt_ret = Imapsync::Getopt::Long::GetOptions(
+	return $numopt ;
+}
+
+sub get_options_cmd {
+	my $mysync = shift @ARG ;
+	my @arguments = @ARG ;
+	my $mycgi = $mysync->{cgi} ;
+	# final 0 is used to print usage when no option is given on command line
+        my $numopt = scalar  @arguments || 0 ;
+        my $argv   = join "\x00", @arguments ;
+
+        if ( $argv =~ m/-delete\x002/x ) {
+                output( $mysync, "May be you mean --delete2 instead of --delete 2\n"  ) ;
+                return ;
+        }
+        $mysync->{f1f2} = {} ;
+        my $opt_ret = myGetOptions(
+	$mycgi,
+	\@arguments,
         'debug!'        => \$debug,
         'debuglist!'    => \$debuglist,
         'debugcontent!' => \$debugcontent,
-        'debugsleep=f'  => \$sync->{debugsleep},
+        'debugsleep=f'  => \$mysync->{debugsleep},
         'debugflags!'   => \$debugflags,
         'debugimap!'    => \$debugimap,
         'debugimap1!'   => \$debugimap1,
         'debugimap2!'   => \$debugimap2,
         'debugdev!'     => \$debugdev,
-        'debugmemory!'  => \$sync->{debugmemory},
-        'debugfolders!' => \$sync->{debugfolders},
-        'debugssl=i'    => \$sync->{debugssl},
-	'debugbasket=s' => \@debugbasket,
-	'debugcgi!'     => \$debugcgi,
-        'host1=s'     => \$host1,
-        'host2=s'     => \$host2,
-        'port1=i'     => \$port1,
-        'port2=i'     => \$port2,
-	'inet4'       => \$sync->{inet4},
-	'inet6'       => \$sync->{inet6},
-        'user1=s'     => \$user1,
-        'user2=s'     => \$user2,
+        'debugmemory!'  => \$mysync->{debugmemory},
+        'debugfolders!' => \$mysync->{debugfolders},
+        'debugssl=i'    => \$mysync->{debugssl},
+        'debugbasket=s' => \@debugbasket,
+        'debugcgi!'     => \$debugcgi,
+	'debugenv'      => \$mysync->{debugenv},
+        'simulong=i'    => \$mysync->{simulong},
+	'abort'         => \$mysync->{abort},
+        'host1=s'     => \$mysync->{host1},
+        'host2=s'     => \$mysync->{host2},
+        'port1=i'     => \$mysync->{port1},
+        'port2=i'     => \$mysync->{port2},
+        'inet4|ipv4'    => \$mysync->{inet4},
+        'inet6|ipv6'    => \$mysync->{inet6},
+        'user1=s'     => \$mysync->{user1},
+        'user2=s'     => \$mysync->{user2},
+	'gmail1'      => \$mysync->{gmail1},
+	'gmail2'      => \$mysync->{gmail2},
+	'office1'     => \$mysync->{office1},
+	'office2'     => \$mysync->{office2},
+	'exchange1'   => \$mysync->{exchange1},
+	'exchange2'   => \$mysync->{exchange2},
+	'domino1'     => \$mysync->{domino1},
+	'domino2'     => \$mysync->{domino2},
         'domain1=s'   => \$domain1,
         'domain2=s'   => \$domain2,
-        'password1=s' => \$password1,
-        'password2=s' => \$password2,
+        'password1=s' => \$mysync->{password1},
+        'password2=s' => \$mysync->{password2},
         'passfile1=s' => \$passfile1,
         'passfile2=s' => \$passfile2,
         'authmd5!'    => \$authmd5,
@@ -9073,34 +11451,34 @@ sub get_options {
         'authmd52!'   => \$authmd52,
         'sep1=s'      => \$sep1,
         'sep2=s'      => \$sep2,
-        'folder=s'    => \@folder,
-        'folderrec=s' => \@folderrec,
-        'include=s'   => \@include,
-        'exclude=s'   => \@exclude,
-        'folderfirst=s' => \@folderfirst,
-        'folderlast=s' => \@folderlast,
-        'prefix1=s'   => \$prefix1,
-        'prefix2=s'   => \$prefix2,
-	'subfolder2=s' => \$subfolder2,
-        'fixslash2!'   => \$fixslash2,
-        'fixInboxINBOX!' => \$fixInboxINBOX,
-        'regextrans2=s' => \@regextrans2,
-        'mixfolders!' => \$mixfolders,
+        'folder=s'          => \@folder,
+        'folderrec=s'       => \@folderrec,
+        'include=s'         => \@include,
+        'exclude=s'         => \@exclude,
+        'folderfirst=s'     => \@folderfirst,
+        'folderlast=s'      => \@folderlast,
+        'prefix1=s'         => \$prefix1,
+        'prefix2=s'         => \$prefix2,
+        'subfolder2=s'      => \$subfolder2,
+        'fixslash2!'        => \$fixslash2,
+        'fixInboxINBOX!'    => \$fixInboxINBOX,
+        'regextrans2=s'     => \@regextrans2,
+        'mixfolders!'       => \$mixfolders,
         'skipemptyfolders!' => \$skipemptyfolders,
-        'regexmess=s' => \@regexmess,
-        'skipmess=s' => \@skipmess,
-        'pipemess=s' => \@pipemess,
-	'pipemesscheck!' => \$pipemesscheck,
+        'regexmess=s'       => \@regexmess,
+        'skipmess=s'        => \@skipmess,
+        'pipemess=s'        => \@pipemess,
+        'pipemesscheck!'    => \$pipemesscheck,
         'disarmreadreceipts!' => \$disarmreadreceipts,
-        'regexflag=s' => \@regexflag,
-        'filterflags!' => \$filterflags,
-        'flagscase!'  => \$flagscase,
+        'regexflag=s'         => \@regexflag,
+        'filterflags!'        => \$filterflags,
+        'flagscase!'          => \$flagscase,
         'syncflagsaftercopy!' => \$syncflagsaftercopy,
-        'delete|delete1!' => \$delete,
-        'delete2!'    => \$delete2,
-        'delete2duplicates!' => \$delete2duplicates,
-        'delete2folders!'    => \$delete2folders,
-        'delete2foldersonly=s' => \$delete2foldersonly,
+        'delete|delete1!'     => \$delete1,
+        'delete2!'            => \$delete2,
+        'delete2duplicates!'  => \$delete2duplicates,
+        'delete2folders!'     => \$delete2folders,
+        'delete2foldersonly=s'   => \$delete2foldersonly,
         'delete2foldersbutnot=s' => \$delete2foldersbutnot,
         'syncinternaldates!' => \$syncinternaldates,
         'idatefromheader!'   => \$idatefromheader,
@@ -9114,11 +11492,10 @@ sub get_options {
         'search2=s'   => \$search2,
         'foldersizes!' => \$foldersizes,
         'foldersizesatend!' => \$foldersizesatend,
-        'dry!'        => \$dry,
-        'expunge!'    => \$expunge,
-        'expunge1!'    => \$expunge1,
-        'expunge2!'    => \$expunge2,
-        'uidexpunge2!' => \$uidexpunge2,
+        'dry!'              => \$mysync->{dry},
+        'expunge1|expunge!' => \$expunge1,
+        'expunge2!'         => \$expunge2,
+        'uidexpunge2!'      => \$uidexpunge2,
         'subscribed!' => \$subscribed,
         'subscribe!'  => \$subscribe,
         'subscribeall|subscribe_all!'  => \$subscribeall,
@@ -9130,8 +11507,8 @@ sub get_options {
         'version'     => \$version,
         'help'        => \$help,
         'timeout=i'   => \$timeout,
-        'timeout1=i'   => \$sync->{h1}->{timeout},
-        'timeout2=i'   => \$sync->{h2}->{timeout},
+        'timeout1=i'   => \$mysync->{h1}->{timeout},
+        'timeout2=i'   => \$mysync->{h2}->{timeout},
         'skipheader=s' => \$skipheader,
         'useheader=s' => \@useheader,
         'wholeheaderifneeded!'   => \$wholeheaderifneeded,
@@ -9140,14 +11517,15 @@ sub get_options {
         'allowsizemismatch!' => \$allowsizemismatch,
         'fastio1!'     => \$fastio1,
         'fastio2!'     => \$fastio2,
-        'ssl1!'        => \$ssl1,
-        'ssl2!'        => \$ssl2,
-        'ssl1_ssl_version=s' => \$sync->{h1}->{sslargs}->{SSL_version},
-        'ssl2_ssl_version=s' => \$sync->{h2}->{sslargs}->{SSL_version},
-        'sslargs1=s%'        => \$sync->{h1}->{sslargs},
-        'sslargs2=s%'        => \$sync->{h2}->{sslargs},
-        'tls1!'        => \$tls1,
-        'tls2!'        => \$tls2,
+	'sslcheck!'    => \$mysync->{sslcheck},
+        'ssl1!'        => \$mysync->{ssl1},
+        'ssl2!'        => \$mysync->{ssl2},
+        'ssl1_ssl_version=s' => \$mysync->{h1}->{sslargs}->{SSL_version},
+        'ssl2_ssl_version=s' => \$mysync->{h2}->{sslargs}->{SSL_version},
+        'sslargs1=s%'        => \$mysync->{h1}->{sslargs},
+        'sslargs2=s%'        => \$mysync->{h2}->{sslargs},
+        'tls1!'        => \$mysync->{tls1},
+        'tls2!'        => \$mysync->{tls2},
         'uid1!'        => \$uid1,
         'uid2!'        => \$uid2,
         'authmech1=s' => \$authmech1,
@@ -9161,13 +11539,15 @@ sub get_options {
         'buffersize=i' => \$buffersize,
         'reconnectretry1=i' => \$reconnectretry1,
         'reconnectretry2=i' => \$reconnectretry2,
-        'tests!'       => \$tests,
-        'testsdebug|tests_debug!' => \$testsdebug,
-        'testslive!'   => \$testslive,
-        'justlogin!'  => \$justlogin,
-        'tmpdir=s'    => \$tmpdir,
-        'pidfile=s'    => \$sync->{pidfile},
-        'pidfilelocking!' => \$sync->{pidfilelocking},
+        'tests!'          => \$mysync->{ tests },
+        'testsdebug|tests_debug!' => \$mysync->{ testsdebug },
+	'testsunit=s@'    => \$mysync->{testsunit},
+        'testslive!'      => \$mysync->{testslive},
+        'testslive6!'     => \$mysync->{testslive6},
+        'justlogin!'      => \$justlogin,
+        'tmpdir=s'        => \$tmpdir,
+        'pidfile=s'       => \$mysync->{pidfile},
+        'pidfilelocking!' => \$mysync->{pidfilelocking},
         'releasecheck!' => \$releasecheck,
         'modulesversion|modules_version!' => \$modulesversion,
         'usecache!'    => \$usecache,
@@ -9179,119 +11559,278 @@ sub get_options {
         'checkselectable!' => \$checkselectable,
         'checkmessageexists!' => \$checkmessageexists,
         'expungeaftereach!' => \$expungeaftereach,
-        'abletosearch!' => \$abletosearch,
-        'showpasswords!' => \$showpasswords,
-        'maxlinelength=i' => \$maxlinelength,
-        'maxlinelengthcmd=s' => \$maxlinelengthcmd,
-        'minmaxlinelength=i' => \$minmaxlinelength,
-        'debugmaxlinelength!' => \$debugmaxlinelength,
+        'abletosearch!'  => \$mysync->{abletosearch},
+        'abletosearch1!' => \$mysync->{abletosearch1},
+        'abletosearch2!' => \$mysync->{abletosearch2},
+        'showpasswords!' => \$mysync->{showpasswords},
+        'maxlinelength=i'        => \$maxlinelength,
+        'maxlinelengthcmd=s'     => \$maxlinelengthcmd,
+        'minmaxlinelength=i'     => \$minmaxlinelength,
+        'debugmaxlinelength!'    => \$debugmaxlinelength,
         'fixcolonbug!'           => \$fixcolonbug,
         'create_folder_old!'     => \$create_folder_old,
-        'maxmessagespersecond=f' => \$maxmessagespersecond,
-        'maxbytespersecond=i'    => \$maxbytespersecond,
+        'maxmessagespersecond=f' => \$mysync->{maxmessagespersecond},
+        'maxbytespersecond=i'    => \$mysync->{maxbytespersecond},
+	'maxbytesafter=i'        => \$mysync->{maxbytesafter},
+	'maxsleep=f'             => \$mysync->{maxsleep},
         'skipcrossduplicates!'   => \$skipcrossduplicates,
         'debugcrossduplicates!'  => \$debugcrossduplicates,
-        'log!'                   => \$sync->{log},
-        'logfile=s'        => \$sync->{logfile},
-        'logdir=s'         => \$sync->{logdir},
-        'errorsmax=i'      => \$sync->{errorsmax},
-        'errorsdump!'      => \$sync->{errorsdump},
+        'log!'                   => \$mysync->{log},
+        'logfile=s'        => \$mysync->{logfile},
+        'logdir=s'         => \$mysync->{logdir},
+        'errorsmax=i'      => \$mysync->{errorsmax},
+        'errorsdump!'      => \$mysync->{errorsdump},
         'fetch_hash_set=s' => \$fetch_hash_set,
-        'automap!'         => \$sync->{automap},
-        'justautomap!'     => \$sync->{justautomap},
-        'id!'              => \$sync->{id},
-        'f1f2=s%'          => \$sync->{f1f2},
-        'justfolderlists!' => \$sync->{justfolderlists},
-        'delete1emptyfolders' => \$sync->{delete1emptyfolders},
+        'automap!'         => \$mysync->{automap},
+        'justautomap!'     => \$mysync->{justautomap},
+        'id!'              => \$mysync->{id},
+        'f1f2=s%'          => \$mysync->{f1f2},
+        'justfolderlists!' => \$mysync->{justfolderlists},
+        'delete1emptyfolders' => \$mysync->{delete1emptyfolders},
         ) ;
 
+        $debug and output( $mysync, "get options: [$opt_ret][$numopt]\n"  ) ;
 
-	$debugcgi and myprint( map { "$_ => $ENV{$_}\n" } sort keys  %ENV   ) ;
-	$debugcgi and myprint( "@debugbasket\n"  ) ;
-        $debug and myprint( "get options: [$opt_ret]\n"  ) ;
-
-        # just the version
-        myprint( imapsync_version(  ), "\n" ) and exit 0 if ( $version ) ;
-        # $tmpdir is used in tests_pipemess()
-	$tmpdir ||= File::Spec->tmpdir(  ) ;
-	if ( $tests or $testsdebug ) {
-		$test_builder = Test::More->builder ;
-		if ( $tests ) { tests(  ) ; }
-		if ( $testsdebug ) { testsdebug(  ) ; }
-		#$test_builder->reset(  ) ;
-		exit ;
+	if ( ! $opt_ret ) {
+		return ;
 	}
+	return $numopt ;
+}
 
-	#$help = 1 if ! $numopt;
-	load_modules(  );
-
-	# exit with --help option or no option at all
-	$debug and myprint( "numopt:$numopt\n"  ) ;
-        usage(  ) and exit  if ( $help or not $numopt ) ;
-
-	# don't go on if options are not all known.
-        exit $EX_USAGE unless ( $opt_ret ) ;
-
-	# init live varaiables
-	testslive(  ) if ( $testslive ) ;
+sub get_options  {
+	my $mysync = shift @ARG ;
+	my @arguments = @ARG ;
+	my $mycgi = $mysync->{cgi} ;
 
+	if ( under_cgi_context(  ) ) {
+		# CGI context
+		return get_options_cgi( $mysync, @arguments )  ;
+	}else{
+		# Command line context ;
+		return get_options_cmd( $mysync, @arguments )  ;
+	}
 	return ;
 }
 
-sub testslive {
-	$host1 = 'test1.lamiral.info' ;
-	$user1 = 'test1' ;
-	$password1 = 'secret1' ;
-	$host2 = 'test2.lamiral.info' ;
-	$user2 = 'test2' ;
-	$password2 ='secret2' ;
+sub testunitsession {
+	my $mysync = shift ;
+	
+	if ( ! $mysync ) { return ; }
+	if ( ! $mysync->{ testsunit } ) { return ; }
+
+	my @functions = @{ $mysync->{ testsunit } } ;
+	
+	if ( ! @functions ) { return ; }
+
+	SKIP: {
+		if ( ! @functions ) { skip 'No test in normal run' ; }
+		testsunit( @functions ) ;
+                done_testing(  ) ;
+	}
+	return ;
+}
+
+sub tests_count_0s {
+	note( 'Entering tests_count_zeros()' ) ;
+	is( 0, count_0s(  ), 'count_0s: no parameters => undef' ) ;
+	is( 1, count_0s( 0 ), 'count_0s: 0 => 1' ) ;
+	is( 0, count_0s( 1 ), 'count_0s: 1 => 0' ) ;
+	is( 1, count_0s( 1, 0, 1 ), 'count_0s: 1, 0, 1 => 1' ) ;
+	is( 2, count_0s( 1, 0, 1, 0 ), 'count_0s: 1, 0, 1, 0 => 2' ) ;
+	note( 'Leaving  tests_count_zeros()' ) ;
+	return ;
+}
+sub count_0s {
+	my @array = @ARG ;
+	
+	if ( ! @array ) { return 0 ; }
+	my $nb_zeros = 0 ;
+	map { $_ == 0 and $nb_zeros += 1 } @array ;
+	return $nb_zeros ;
+}
+
+sub tests_report_failures {
+        note( 'Entering tests_report_failures()' ) ;
+	is( undef, report_failures(  ), 'report_failures: no parameters => undef' ) ;
+	is( "n° 1 - first\n", report_failures( ({'ok' => 0, name => 'first'}) ), 'report_failures: "first" failed => n° 1 - first' ) ;
+	is( q{}, report_failures( ( {'ok' => 1, name => 'first'} ) ), 'report_failures: "first" success =>' ) ;
+	is( "n° 2 - second\n", report_failures( ( {'ok' => 1, name => 'second'}, {'ok' => 0, name => 'second'} ) ), 'report_failures: "second" failed => n° 2 - second' ) ;
+	is( "n° 1 - first\nn° 2 - second\n", report_failures( ( {'ok' => 0, name => 'first'}, {'ok' => 0, name => 'second'} ) ), 'report_failures: both failed => n° 1 - first n° 2 - second' ) ;
+	note( 'Leaving  tests_report_failures()' ) ;
+	return ;
+}
+
+sub report_failures {
+	my @details = @ARG ;
+	
+	if ( ! @details ) { return ; }
+	
+	my $counter = 1 ;
+	my $report  = q{} ;
+	foreach my $details ( @details ) {
+		if ( ! $details->{ 'ok' } ) {
+			my $name = $details->{ 'name' } || 'NONAME' ;
+			$report .= "n° $counter - $name\n" ;
+		}
+		$counter += 1 ;
+	}
+	return $report ;
+
+}
+
+sub tests_true {
+	note( 'Entering tests_true()' ) ;
+	is( 1, 1, 'true: 1 is 1' ) ;
+	note( 'Leaving  tests_true()' ) ;
+	return ;
+}
+
+sub tests_testsunit {
+	note( 'Entering tests_testunit()' ) ;
+	is( undef, testsunit(  ), 'testsunit: no parameters => undef' ) ;
+	is( undef, testsunit( undef ), 'testsunit: an undef parameter => undef' ) ;
+	is( undef, testsunit( q{} ), 'testsunit: an empty parameter => undef' ) ;
+	is( undef, testsunit( 'idonotexist' ), 'testsunit: a do not exist function as parameter => undef' ) ;
+	is( undef, testsunit( 'tests_true' ), 'testsunit: tests_true => undef' ) ;
+	note( 'Leaving  tests_testunit()' ) ;
+	return ;
+}
+
+sub testsunit {
+	my @functions = @ARG ;
+	
+	if ( ! @functions ) { #
+                myprint( "testsunit warning: no argument given\n" ) ;
+                return ; 
+        }
+			
+	foreach my $function ( @functions ) {
+		if ( ! $function ) {
+                        myprint( "testsunit warning: argument is empty\n" ) ;
+                        next ; 
+                }
+		if ( ! exists &$function ) {
+                        myprint( "testsunit warning: function $function does not exist\n" ) ;
+                        next ; 
+                }
+		if ( ! defined &$function ) {
+                        myprint( "testsunit warning: function $function is not defined\n" ) ;
+                        next ; 
+                }
+		my $function_ref = \&{ $function } ;
+		&$function_ref() ; 
+	}
 	return ;
 }
 
 sub testsdebug {
-      SKIP: {
-                skip 'No test in normal run' if ( not $testsdebug ) ;
+	my $mysync = shift ;
+	if ( ! $mysync->{ testsdebug } ) { return ; }
+	SKIP: {
+                if ( ! $mysync->{ testsdebug } ) { 
+			skip 'No test in normal run' ;
+		}
+		
+		note( 'Entering testsdebug()' ) ;
+		ok( ( ( not -d 'W/tmp/tests' ) or rmtree( 'W/tmp/tests/' ) ), 'testsdebug: rmtree W/tmp/tests' ) ;
                 #tests_bytes_display_string(  ) ;
                 #tests_ucsecond(  ) ;
                 #tests_mkpath(  ) ;
-                #eval { tests_mkpath(  ) ; } or ok( 0 == 1,  'tests_mkpath fail badly?' ) ;
                 #tests_format_for_imap_arg(  ) ;
                 #tests_is_a_release_number(  ) ;
                 #tests_delete1emptyfolders(  ) ;
                 #tests_memory_consumption(  ) ;
                 #tests_imap2_folder_name() ;
                 #tests_length_ref(  ) ;
-		#tests_is_valid_directory(  ) ;
-                #tests_firstline(  ) ;
                 #tests_diff_or_NA(  ) ;
                 #tests_match_number(  ) ;
                 #tests_all_defined(  ) ;
                 #tests_guess_separator(  ) ;
-                tests_pipemess(  ) ;
                 #tests_message_for_host2(  ) ;
+                #tests_special_from_folders_hash(  ) ;
+                #tests_do_valid_directory(  ) ;
+		#tests_notmatch(  ) ;
+		#tests_match(  ) ;
+		#tests_get_options(  ) ;
+		#tests_rand32(  ) ;
+		#tests_string_to_file(  ) ;
+		#tests_hashsynclocal(  ) ;
+		#tests_output(  ) ;
+		#tests_output_reset_with(  ) ;
+		#tests_output_start(  ) ;
+		#tests_hashsync(  ) ;
+		#tests_check_last_release(  ) ;
+		#tests_cpu_number(  ) ;
+		#tests_load_and_delay(  ) ;
+		#tests_loadavg(  ) ;
+                #tests_backtick(  ) ;
+                #tests_firstline(  ) ;
+                #tests_pipemess(  ) ;
+		#tests_not_long_imapsync_version_public(  ) ;
+		#tests_get_options_cgi(  ) ;
+                #tests_guess_special(  ) ;
+####tests_reconnect_if_needed(  ) ;
+		#tests_reconnect_12_if_needed(  ) ;
+                #tests_sleep_max_bytes(  ) ;
+		#tests_file_to_string(  ) ;
+		#tests_under_cgi_context(  ) ;
+		#tests_umask(  ) ;
+		#tests_umask_str(  ) ;
+		#tests_set_umask(  ) ;
+		#tests_createhashfileifneeded(  ) ;
+                #tests_filter_forbidden_characters(  ) ;
+                #tests_logfile(  ) ;
+                #tests_setlogfile(  ) ;
+		#tests_move_slash(  ) ;
+		#tests_testsunit(  ) ;
+		#tests_always_fail(  ) ;
+		#tests_count_0s(  ) ;
+		#tests_report_failures(  ) ;
+		#tests_max(  ) ;
+		#tests_min(  ) ;
+		#tests_sleep_if_needed(  ) ;
+		#tests_imapsping(  ) ;
+		#tests_tcpping(  ) ;
+		#tests_sslcheck(  ) ;
+		#tests_resolv(  ) ;
+		#tests_resolvrev(  ) ;
+		#tests_connect_socket(  ) ;
+                #tests_probe_imapssl(  ) ;
+                #tests_mailimapclient_connect(  ) ;
+                #tests_guess_prefix(  ) ;
+                #tests_usage(  ) ;
+                #tests_version_from_rcs(  ) ;
+                #tests_mailimapclient_connect_bug(  ) ; # it fails with Mail-IMAPClient <= 3.39
+                tests_backslash_caret(  ) ;
+
+		note( 'Leaving  testsdebug()' ) ;
                 done_testing(  ) ;
-                note('End of imapsync --tests_debug') ;
         }
         return ;
 }
 
-sub tests {
 
-      SKIP: {
-                skip 'No test in normal run' if ( not $tests ) ;
+
+sub tests {
+	my $mysync = shift ;
+	if ( ! $mysync->{ tests } ) { return ; }
+
+	SKIP: {
+                skip 'No test in normal run' if ( ! $mysync->{ tests } ) ;
+		note( 'Entering tests()' ) ;
                 tests_folder_routines(  ) ;
                 tests_compare_lists(  ) ;
-                tests_regexmess();
+                tests_regexmess(  ) ;
                 tests_skipmess(  ) ;
                 tests_flags_regex();
                 tests_ucsecond(  ) ;
                 tests_permanentflags();
                 tests_flags_filter(  ) ;
                 tests_separator_invert(  ) ;
-                tests_imap2_folder_name() ;
-                tests_command_line_nopassword();
+                tests_imap2_folder_name(  ) ;
+                tests_command_line_nopassword(  ) ;
                 tests_good_date(  ) ;
-                tests_max();
+                tests_max(  ) ;
                 tests_remove_not_num();
                 tests_memory_consumption( ) ;
                 tests_is_a_release_number();
@@ -9305,7 +11844,7 @@ sub tests {
                 tests_clean_cache_2(  ) ;
                 tests_touch(  ) ;
                 tests_flagscase(  ) ;
-                eval { tests_mkpath(  ) ; } or ok( 0 == 1,  'tests_mkpath fail badly?' ) ;
+                tests_mkpath(  ) ;
                 tests_extract_header(  ) ;
                 tests_decompose_header(  ) ;
                 tests_epoch(  ) ;
@@ -9316,7 +11855,6 @@ sub tests {
                 tests_cache_folder(  ) ;
                 tests_time_remaining(  ) ;
                 tests_decompose_regex(  ) ;
-                tests_Banner(  ) ;
                 tests_backtick(  ) ;
                 tests_bytes_display_string(  ) ;
                 tests_header_line_normalize(  ) ;
@@ -9340,149 +11878,63 @@ sub tests {
                 tests_quota_extract_storage_limit_in_bytes(  ) ;
                 tests_quota_extract_storage_current_in_bytes(  ) ;
                 tests_guess_special(  ) ;
-		tests_is_valid_directory(  ) ;
+                tests_do_valid_directory(  ) ;
                 tests_delete1emptyfolders(  ) ;
                 tests_message_for_host2(  ) ;
                 tests_length_ref(  ) ;
-                tests_firstline(  ) ;               
+                tests_firstline(  ) ;
                 tests_diff_or_NA(  ) ;
-                #tests_always_fail(  ) ;
                 tests_match_number(  ) ;
                 tests_all_defined(  ) ;
-                done_testing( 693 ) ;
-                note('End of imapsync --tests') ;
+                tests_special_from_folders_hash(  ) ;
+		tests_notmatch(  ) ;
+		tests_match(  ) ;
+		tests_get_options(  ) ;
+		tests_get_options_cgi(  ) ;
+		tests_rand32(  ) ;
+		tests_hashsynclocal(  ) ;
+		tests_hashsync(  ) ;
+		tests_output(  ) ;
+		tests_output_reset_with(  ) ;
+		tests_output_start(  ) ;
+		tests_check_last_release(  ) ;
+		tests_loadavg(  ) ;
+		tests_cpu_number(  ) ;
+		tests_load_and_delay(  ) ;
+		#tests_imapsping(  ) ;
+		#tests_tcpping(  ) ;
+		tests_sslcheck(  ) ;
+		tests_not_long_imapsync_version_public(  ) ;
+		tests_reconnect_if_needed(  ) ;
+		tests_reconnect_12_if_needed(  ) ;
+		tests_sleep_if_needed(  ) ;
+		tests_string_to_file(  ) ;
+		tests_file_to_string(  ) ;
+		tests_under_cgi_context(  ) ;
+		tests_umask(  ) ;
+		tests_umask_str(  ) ;
+		tests_set_umask(  ) ;
+		tests_createhashfileifneeded(  ) ;
+		tests_move_slash(  ) ;
+		tests_testsunit(  ) ;
+		tests_count_0s(  ) ;
+		tests_report_failures(  ) ;
+		tests_min(  ) ;
+		#tests_resolv(  ) ;
+		#tests_resolvrev(  ) ;
+		tests_connect_socket(  ) ;
+                tests_probe_imapssl(  ) ;
+                tests_mailimapclient_connect(  ) ;
+                tests_usage(  ) ;
+                tests_version_from_rcs(  ) ;
+                tests_backslash_caret(  ) ;
+                #tests_mailimapclient_connect_bug(  ) ; # it fails with Mail-IMAPClient <= 3.39
+		#tests_always_fail(  ) ;
+		done_testing( 1012 ) ;
+		note( 'Leaving  tests()' ) ;
         }
         return ;
 }
 
 
 
-# IMAPClient 3.xx ads
-
-package Mail::IMAPClient;
-
-sub Tls {
-	my $self  = shift ;
-	my $value = shift ;
-	if ( defined  $value  ) { $self->{TLS} = $value }
-	return $self->{TLS};
-}
-
-sub Reconnect_counter {
-	my $self  = shift ;
-        my $value = shift ;
-	$self->{Reconnect_counter} = 0 if ( not defined  $self->{Reconnect_counter}  ) ;
-	if ( defined  $value  ) { $self->{Reconnect_counter} = $value }
-	return( $self->{Reconnect_counter} ) ;
-}
-
-
-sub Banner {
-	my $self  = shift ;
-	my $value = shift ;
-	if ( defined $value ) { $self->{ BANNER } = $value }
-	return $self->{ BANNER };
-}
-
-sub capability_update {
-	my $self = shift ;
-
-	delete $self->{CAPABILITY} ;
-	return( $self->capability ) ;
-}
-
-
-package Imapsync::Getopt::Long ;
-# Started as a copy of Luke Ross Getopt::Long::CGI
-# https://metacpan.org/release/Getopt-Long-CGI
-# So this section is under the same license as Getopt-Long-CGI Luke Ross wants it,
-# which was Perl 5.6 or later licenses at the date of the copy.
-
-use strict ;
-use warnings ;
-
-use Getopt::Long(  ) ;
-
-
-sub GetOptions {
-    my %options = @_ ;
-
-    if ( not $ENV{SERVER_SOFTWARE} ) {
-        # Not CGI - pass upstream for normal command line handling
-        return Getopt::Long::GetOptions( %options ) ;
-    }
-    my $b_ref = $options{'debugbasket=s'} ;
-    require CGI ;
-    require CGI::Carp ;
-    CGI::Carp->import( 'fatalsToBrowser' ) ;
-
-    my $cgi = CGI->new(  ) ;
-    $cgi->param( 'debugcgi' ) and myprint( "

Current Values

\n" . $cgi->Dump ) ; - - foreach my $key (sort keys %options) { - my $val = $options{$key}; - #push( @{$b_ref}, "opt:[$key] val:[$val]" . ( ('SCALAR' eq ref($val) and defined $$val ) ? " [$$val]" : q{} ) . "\n" ) ; - if ( $key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/ ) { - push @{$b_ref}, "Unknown opt: [$key]\n" ; - next ; # Unknown item - } - - my $name = [split '|', $1, 1 ]->[0]; - - if (($3 || q{}) eq '+') { - ${ $val } = $cgi->param($name); # "Incremental" integer - } elsif ($2) { - my @values = $cgi->param($name); - my $type = $2; - if (($3 || q{}) eq '%' or ref($val) eq 'HASH') { - my %values = map { split /=/, $_, 1 } @values; - if ($type =~ m/i$/) { - foreach my $k (keys %values) { - $values{$k} = int $values{$k} ; - } - } elsif ($type =~ m/f$/) { - foreach my $k (keys %values) { - $values{$k} = 0 + $values{$k} - } - } - if ( ref($val) eq 'CODE') { - while(my($k, $v) = each %values) { - $val->($name, $k, $v); - } - } elsif ( 'REF' eq ref $val ) { - #push( @{$b_ref}, "refref($$val): " . ref($$val) . " %values= ", %values, "\n\n" ) ; - %{ ${ $val } } = %values; - } else { - #push( @{$b_ref}, "ref($val): " . ref($val) . " %values= ", %values, "\n\n" ) ; - %{ $val } = %values; - } - } else { - if ($type =~ m/i$/) { - @values = map { int $_ } @values; - } elsif ($type =~ m/f$/) { - @values = map { 0 + $_ } @values; - } - if (($3 || q{}) eq '@' or ref($val) eq 'ARRAY') { - if (ref($val) eq 'CODE') { - $val->($name, \@values) - } else { - @{ $val } = @values ; - } - } else { - if (ref($val) eq 'CODE') { - $val->($name, $values[0]); - } else { - ${ $val } = $values[0]; - } - } - } - } else { - # Checkbox - ${ $val } = $cgi->param($name) ? 1 : undef ; - #push( @{$b_ref}, "param($name) ref($val): " . ref($val) . " val=[$$val]\n\n" ) ; - } - } - return( 1 ) ; -} - - diff --git a/data/Dockerfiles/phpfpm/Dockerfile b/data/Dockerfiles/phpfpm/Dockerfile index 84a1f67b..5259e70d 100644 --- a/data/Dockerfiles/phpfpm/Dockerfile +++ b/data/Dockerfiles/phpfpm/Dockerfile @@ -41,8 +41,8 @@ RUN apk add -U --no-cache libxml2-dev \ Net_Sieve \ NET_SMTP \ Mail_mime \ - && pecl install redis-${REDIS_PECL} memcached-${MEMCACHED_PECL} APCu-${APCU_PECL} imagick-${IMAGICK_PECL} \ - && docker-php-ext-enable redis apcu memcached imagick \ + && pecl install redis-${REDIS_PECL} memcached-${MEMCACHED_PECL} APCu-${APCU_PECL} imagick-${IMAGICK_PECL} mailparse \ + && docker-php-ext-enable redis apcu memcached imagick mailparse \ && pecl clear-cache \ && docker-php-ext-configure intl \ && docker-php-ext-install -j 4 intl gettext ldap sockets soap pdo pdo_mysql xmlrpc gd zip pcntl opcache \ diff --git a/data/Dockerfiles/postfix/postfix.sh b/data/Dockerfiles/postfix/postfix.sh index 326a6d18..c152606d 100755 --- a/data/Dockerfiles/postfix/postfix.sh +++ b/data/Dockerfiles/postfix/postfix.sh @@ -83,7 +83,11 @@ query = SELECT CONCAT_WS(':', username, password) AS auth_data FROM relayhosts WHERE id IN ( SELECT relayhost FROM domain WHERE CONCAT('@', domain) = '%s' - ); + OR '%s' IN ( + SELECT CONCAT('@', alias_domain) FROM alias_domain + ) + ) + AND username != ''; EOF cat < /opt/postfix/conf/sql/mysql_virtual_alias_domain_catchall_maps.cf @@ -119,6 +123,28 @@ query = SELECT goto FROM alias AND active='1'; EOF +cat < /opt/postfix/conf/sql/mysql_recipient_bcc_maps.cf +user = ${DBUSER} +password = ${DBPASS} +hosts = mysql +dbname = ${DBNAME} +query = SELECT bcc_dest FROM bcc_maps + WHERE local_dest='%s' + AND type='rcpt' + AND active='1'; +EOF + +cat < /opt/postfix/conf/sql/mysql_sender_bcc_maps.cf +user = ${DBUSER} +password = ${DBPASS} +hosts = mysql +dbname = ${DBNAME} +query = SELECT bcc_dest FROM bcc_maps + WHERE local_dest='%s' + AND type='sender' + AND active='1'; +EOF + cat < /opt/postfix/conf/sql/mysql_virtual_domains_maps.cf user = ${DBUSER} password = ${DBPASS} diff --git a/data/Dockerfiles/watchdog/watchdog.sh b/data/Dockerfiles/watchdog/watchdog.sh index 902f66dc..ec7133e5 100755 --- a/data/Dockerfiles/watchdog/watchdog.sh +++ b/data/Dockerfiles/watchdog/watchdog.sh @@ -28,21 +28,19 @@ progress() { [[ ${CURRENT} -gt ${TOTAL} ]] && return [[ ${CURRENT} -lt 0 ]] && CURRENT=0 PERCENT=$(( 200 * ${CURRENT} / ${TOTAL} % 2 + 100 * ${CURRENT} / ${TOTAL} )) - log_msg "${SERVICE} health level: ${PERCENT}% (${CURRENT}/${TOTAL}), health trend: ${DIFF}" - log_data "$(printf "%d,%d,%d,%d" ${PERCENT} ${CURRENT} ${TOTAL} ${DIFF})" "${SERVICE}" + redis-cli -h redis LPUSH WATCHDOG_LOG "{\"time\":\"$(date +%s)\",\"service\":\"${SERVICE}\",\"lvl\":\"${PERCENT}\",\"hpnow\":\"${CURRENT}\",\"hptotal\":\"${TOTAL}\",\"hpdiff\":\"${DIFF}\"}" > /dev/null + log_msg "${SERVICE} health level: ${PERCENT}% (${CURRENT}/${TOTAL}), health trend: ${DIFF}" no_redis } log_msg() { - redis-cli -h redis LPUSH WATCHDOG_LOG "{\"time\":\"$(date +%s)\",\"message\":\"$(printf '%s' "${1}")\"}" > /dev/null + if [[ ${2} != "no_redis" ]]; then + redis-cli -h redis LPUSH WATCHDOG_LOG "{\"time\":\"$(date +%s)\",\"message\":\"$(printf '%s' "${1}" | \ + tr '%&;$"_[]{}-\r\n' ' ')\"}" > /dev/null + fi + redis-cli -h redis LTRIM WATCHDOG_LOG 0 9999 > /dev/null echo $(date) $(printf '%s\n' "${1}") } -log_data() { - [[ -z ${1} ]] && return 1 - [[ -z ${2} ]] && return 2 - redis-cli -h redis LPUSH WATCHDOG_DATA "{\"time\":\"$(date +%s)\",\"service\":\"data\",\"$(printf '%s' "${2}")\":\"$(printf '%s' "${1}")\"}" > /dev/null -} - function mail_error() { [[ -z ${1} ]] && return 1 [[ -z ${2} ]] && return 2 @@ -234,27 +232,6 @@ Empty return 1 } -dns_checks() { - err_count=0 - diff_c=0 - THRESHOLD=28 - # Reduce error count by 2 after restarting an unhealthy container - trap "[ ${err_count} -gt 1 ] && err_count=$(( ${err_count} - 2 ))" USR1 - while [ ${err_count} -lt ${THRESHOLD} ]; do - host_ip=$(get_container_ip unbound-mailcow) - err_c_cur=${err_count} - /usr/lib/nagios/plugins/check_dns -H google.com 1>&2; err_count=$(( ${err_count} + ($? * 2))) - /usr/lib/nagios/plugins/check_dns -s ${host_ip} -H google.com 1>&2; err_count=$(( ${err_count} + ($? * 2))) - dig +dnssec org. @${host_ip} | grep -E 'flags:.+ad' 1>&2; err_count=$(( ${err_count} + ($? * 2))) - [ ${err_c_cur} -eq ${err_count} ] && [ ! $((${err_count} - 1)) -lt 0 ] && err_count=$((${err_count} - 1)) diff_c=1 - [ ${err_c_cur} -ne ${err_count} ] && diff_c=$(( ${err_c_cur} - ${err_count} )) - progress "Unbound" ${THRESHOLD} $(( ${THRESHOLD} - ${err_count} )) ${diff_c} - diff_c=0 - sleep $(( ( RANDOM % 30 ) + 10 )) - done - return 1 -} - # Create watchdog agents ( while true; do @@ -322,17 +299,6 @@ done ) & BACKGROUND_TASKS+=($!) -( -while true; do - if ! dns_checks; then - log_msg "Unbound hit error limit" - [[ ! -z ${WATCHDOG_NOTIFY_EMAIL} ]] && mail_error "${WATCHDOG_NOTIFY_EMAIL}" "unbound-mailcow" - #echo unbound-mailcow > /tmp/com_pipe - fi -done -) & -BACKGROUND_TASKS+=($!) - ( while true; do if ! rspamd_checks; then diff --git a/data/conf/dovecot/dovecot.conf b/data/conf/dovecot/dovecot.conf index 6cf1897b..19b803df 100644 --- a/data/conf/dovecot/dovecot.conf +++ b/data/conf/dovecot/dovecot.conf @@ -55,6 +55,9 @@ namespace inbox { mailbox "Deleted Items" { special_use = \Trash } + mailbox "Rubbish" { + special_use = \Trash + } mailbox "Gelöschte Objekte" { special_use = \Trash } @@ -163,7 +166,7 @@ namespace { prefix = Shared/%%u/ location = maildir:%%h/:INDEXPVT=~/Shared/%%u subscriptions = no - list = yes + list = children } protocols = imap sieve lmtp pop3 service dict { diff --git a/data/conf/mysql/my.cnf b/data/conf/mysql/my.cnf index 668e390a..772c8a62 100644 --- a/data/conf/mysql/my.cnf +++ b/data/conf/mysql/my.cnf @@ -6,6 +6,13 @@ innodb_file_per_table = TRUE innodb_file_format = barracuda innodb_large_prefix = TRUE #sql_mode=IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_AUTO_CREATE_USER,NO_ENGINE_SUBSTITUTION +max_allowed_packet=192M +max-connections=1500 +innodb-strict-mode=0 +skip-host-cache +skip-name-resolve +log-warnings=0 +event_scheduler=1 [client] default-character-set = utf8mb4 diff --git a/data/conf/nginx/meta_exporter.conf b/data/conf/nginx/meta_exporter.conf new file mode 100644 index 00000000..30369a32 --- /dev/null +++ b/data/conf/nginx/meta_exporter.conf @@ -0,0 +1,19 @@ +server { + listen 9081; + index index.php index.html; + server_name _; + error_log /var/log/nginx/error.log; + access_log /var/log/nginx/access.log; + root /meta_exporter; + client_max_body_size 10M; + location ~ \.php$ { + client_max_body_size 10M; + try_files $uri =404; + fastcgi_split_path_info ^(.+\.php)(/.+)$; + fastcgi_pass phpfpm:9000; + fastcgi_index pipe.php; + include fastcgi_params; + fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; + fastcgi_param PATH_INFO $fastcgi_path_info; + } +} diff --git a/data/conf/postfix/main.cf b/data/conf/postfix/main.cf index edf5c6d5..4e8c577f 100644 --- a/data/conf/postfix/main.cf +++ b/data/conf/postfix/main.cf @@ -39,7 +39,27 @@ postscreen_greet_ttl = 2d postscreen_greet_wait = 3s postscreen_non_smtp_command_enable = no postscreen_pipelining_enable = no -proxy_read_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_sender_acl.cf, proxy:mysql:/opt/postfix/conf/sql/mysql_sender_dependent_default_transport_maps.cf, proxy:mysql:/opt/postfix/conf/sql/mysql_sasl_passwd_maps.cf, proxy:mysql:/opt/postfix/conf/sql/mysql_tls_enforce_in_policy.cf, $local_recipient_maps $mydestination $virtual_alias_maps $virtual_alias_domains $virtual_mailbox_maps $virtual_mailbox_domains $relay_recipient_maps $relay_domains $canonical_maps $sender_canonical_maps $recipient_canonical_maps $relocated_maps $transport_maps $mynetworks $smtpd_sender_login_maps +proxy_read_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_sender_acl.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_sender_dependent_default_transport_maps.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_sasl_passwd_maps.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_tls_enforce_in_policy.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_sender_bcc_maps.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_recipient_bcc_maps.cf, + $local_recipient_maps, + $mydestination, + $virtual_alias_maps, + $virtual_alias_domains, + $virtual_mailbox_maps, + $virtual_mailbox_domains, + $relay_recipient_maps, + $relay_domains, + $canonical_maps, + $sender_canonical_maps, + $recipient_canonical_maps, + $relocated_maps, + $transport_maps, + $mynetworks, + $smtpd_sender_login_maps queue_run_delay = 300s relay_domains = proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_relay_domain_maps.cf relay_recipient_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_relay_recipient_maps.cf @@ -79,10 +99,15 @@ smtpd_tls_mandatory_ciphers = high smtpd_tls_security_level = may tls_ssl_options = NO_COMPRESSION tls_high_cipherlist = EDH+CAMELLIA:EDH+aRSA:EECDH+aRSA+AESGCM:EECDH+aRSA+SHA256:EECDH:+CAMELLIA128:+AES128:+SSLv3:!aNULL:!eNULL:!LOW:!3DES:!MD5:!EXP:!PSK:!DSS:!RC4:!SEED:!IDEA:!ECDSA:kEDH:CAMELLIA128-SHA:AES128-SHA -virtual_alias_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_alias_maps.cf, proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_spamalias_maps.cf, proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_alias_domain_maps.cf, proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_alias_domain_catchall_maps.cf +virtual_alias_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_alias_maps.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_spamalias_maps.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_alias_domain_maps.cf, + proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_alias_domain_catchall_maps.cf virtual_gid_maps = static:5000 virtual_mailbox_base = /var/vmail/ virtual_mailbox_domains = proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_domains_maps.cf +recipient_bcc_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_recipient_bcc_maps.cf +sender_bcc_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_sender_bcc_maps.cf virtual_mailbox_maps = proxy:mysql:/opt/postfix/conf/sql/mysql_virtual_mailbox_maps.cf virtual_minimum_uid = 104 virtual_transport = lmtp:inet:dovecot:24 diff --git a/data/conf/postfix/master.cf b/data/conf/postfix/master.cf index 77790d56..4911271e 100644 --- a/data/conf/postfix/master.cf +++ b/data/conf/postfix/master.cf @@ -12,6 +12,11 @@ submission inet n - n - - smtpd 588 inet n - n - - smtpd -o smtpd_client_restrictions=permit_mynetworks,permit_sasl_authenticated,reject -o smtpd_tls_auth_only=no +590 inet n - n - - smtpd + -o smtpd_client_restrictions=permit_mynetworks,reject + -o smtpd_tls_auth_only=no + -o smtpd_milters= + -o non_smtpd_milters= smtp_enforced_tls unix - - n - - smtp -o smtp_tls_security_level=encrypt -o syslog_name=enforced-tls-smtp diff --git a/data/conf/rspamd/custom/.empty b/data/conf/rspamd/custom/.empty deleted file mode 100644 index d00491fd..00000000 --- a/data/conf/rspamd/custom/.empty +++ /dev/null @@ -1 +0,0 @@ -1 diff --git a/data/conf/rspamd/dynmaps/settings.php b/data/conf/rspamd/dynmaps/settings.php index 335c0c66..fcc656a8 100644 --- a/data/conf/rspamd/dynmaps/settings.php +++ b/data/conf/rspamd/dynmaps/settings.php @@ -17,7 +17,7 @@ $opt = [ ]; try { $pdo = new PDO($dsn, $database_user, $database_pass, $opt); - $stmt = $pdo->query("SELECT * FROM `filterconf`"); + $stmt = $pdo->query("SELECT '1' FROM `filterconf`"); } catch (PDOException $e) { echo 'settings { }'; diff --git a/data/conf/rspamd/local.d/composites.conf b/data/conf/rspamd/local.d/composites.conf index e895fb0f..ea35dc92 100644 --- a/data/conf/rspamd/local.d/composites.conf +++ b/data/conf/rspamd/local.d/composites.conf @@ -1,4 +1,8 @@ MX_IMPLICIT { - expression = "MX_GOOD and MX_MISSING"; - score = -0.01; + expression = "MX_GOOD and MX_MISSING"; + score = -0.01; +} +VIRUS_FOUND { + expression = "CLAM_VIRUS & !MAILCOW_WHITE"; + score = 2000; } diff --git a/data/conf/rspamd/local.d/force_actions.conf b/data/conf/rspamd/local.d/force_actions.conf index 956402f5..a1b9899d 100644 --- a/data/conf/rspamd/local.d/force_actions.conf +++ b/data/conf/rspamd/local.d/force_actions.conf @@ -1,14 +1,4 @@ rules { - DKIM_FAIL { - action = "add header"; - expression = "R_DKIM_REJECT & !MAILLIST & !MAILCOW_WHITE & !MAILCOW_BLACK"; - require_action = ["no action", "greylist", "soft reject"]; - } - VIRUS_FOUND { - action = "reject"; - expression = "CLAM_VIRUS & !MAILCOW_WHITE"; - honor_action = ["reject"]; - } WHITELIST_FORWARDING_HOST_NO_REJECT { action = "add header"; expression = "WHITELISTED_FWD_HOST"; @@ -19,9 +9,4 @@ rules { expression = "WHITELISTED_FWD_HOST"; require_action = ["greylist", "soft reject"]; } - ADD_UNAUTH_SUBJ { - action = "rewrite subject"; - subject = "[Unauth] %s"; - expression = "SPOOFED_SENDER"; - } } diff --git a/data/conf/rspamd/local.d/statistic.conf b/data/conf/rspamd/local.d/statistic.conf index 4b410842..b66f5018 100644 --- a/data/conf/rspamd/local.d/statistic.conf +++ b/data/conf/rspamd/local.d/statistic.conf @@ -7,8 +7,7 @@ classifier "bayes" { servers = "redis:6379"; min_tokens = 11; min_learns = 20; - autolearn = true; - + autolearn = [-20, 50]; per_user = < substr($email, 0, $a), 'domain' => substr(substr($email, $a), 1)); +} +if (!function_exists('getallheaders')) { + function getallheaders() { + if (!is_array($_SERVER)) { + return array(); + } + $headers = array(); + foreach ($_SERVER as $name => $value) { + if (substr($name, 0, 5) == 'HTTP_') { + $headers[str_replace(' ', '-', ucwords(strtolower(str_replace('_', ' ', substr($name, 5)))))] = $value; + } + } + return $headers; + } +} + +$raw_data = file_get_contents('php://input'); +$headers = getallheaders(); + +$qid = $headers['X-Rspamd-Qid']; +$score = $headers['X-Rspamd-Score']; +$rcpts = $headers['X-Rspamd-Rcpt']; +$user = $headers['X-Rspamd-User']; +$ip = $headers['X-Rspamd-Ip']; +$action = $headers['X-Rspamd-Action']; +$sender = $headers['X-Rspamd-From']; +$symbols = $headers['X-Rspamd-Symbols']; + +$raw_size = (int)$_SERVER['CONTENT_LENGTH']; + +try { + if ($max_size = $redis->Get('Q_MAX_SIZE')) { + if (!empty($max_size) && ($max_size * 1048576) < $raw_size) { + error_log(sprintf("Message too large: %d exceeds %d", $raw_size, ($max_size * 1048576))); + http_response_code(505); + exit; + } + } + if ($exclude_domains = $redis->Get('Q_EXCLUDE_DOMAINS')) { + $exclude_domains = json_decode($exclude_domains, true); + } + $retention_size = (int)$redis->Get('Q_RETENTION_SIZE'); +} +catch (RedisException $e) { + error_log($e); + http_response_code(504); + exit; +} + +$filtered_rcpts = array(); +foreach (json_decode($rcpts, true) as $rcpt) { + $parsed_mail = parse_email($rcpt); + if (in_array($parsed_mail['domain'], $exclude_domains)) { + error_log(sprintf("Skipped domain %s", $parsed_mail['domain'])); + continue; + } + try { + $stmt = $pdo->prepare("SELECT `goto` FROM `alias` + WHERE + ( + `address` = :rcpt + OR + `address` IN ( + SELECT username FROM mailbox, alias_domain + WHERE (alias_domain.alias_domain = :domain_part + AND mailbox.username = CONCAT(:local_part, '@', alias_domain.target_domain) + AND mailbox.active = '1' + AND alias_domain.active='1') + ) + ) + AND `active`= '1';"); + $stmt->execute(array( + ':rcpt' => $rcpt, + ':local_part' => $parsed_mail['local'], + ':domain_part' => $parsed_mail['domain'] + )); + $gotos = $stmt->fetch(PDO::FETCH_ASSOC)['goto']; + if (!empty($gotos)) { + $filtered_rcpts = array_unique(array_merge($filtered_rcpts, explode(',', $gotos))); + } + } + catch (PDOException $e) { + error_log($e->getMessage()); + http_response_code(502); + exit; + } +} +foreach ($filtered_rcpts as $rcpt) { + + try { + $stmt = $pdo->prepare("INSERT INTO `quarantaine` (`qid`, `score`, `sender`, `rcpt`, `symbols`, `user`, `ip`, `msg`, `action`) + VALUES (:qid, :score, :sender, :rcpt, :symbols, :user, :ip, :msg, :action)"); + $stmt->execute(array( + ':qid' => $qid, + ':score' => $score, + ':sender' => $sender, + ':rcpt' => $rcpt, + ':symbols' => $symbols, + ':user' => $user, + ':ip' => $ip, + ':msg' => $raw_data, + ':action' => $action + )); + $stmt = $pdo->prepare('DELETE FROM `quarantaine` WHERE `id` NOT IN ( + SELECT `id` + FROM ( + SELECT `id` + FROM `quarantaine` + WHERE `rcpt` = :rcpt + ORDER BY id DESC + LIMIT :retention_size + ) x + );'); + $stmt->execute(array( + ':rcpt' => $rcpt, + ':retention_size' => $retention_size + )); + } + catch (PDOException $e) { + error_log($e->getMessage()); + http_response_code(503); + exit; + } +} + diff --git a/data/conf/rspamd/meta_exporter/vars.inc.php b/data/conf/rspamd/meta_exporter/vars.inc.php new file mode 100644 index 00000000..d47e9079 --- /dev/null +++ b/data/conf/rspamd/meta_exporter/vars.inc.php @@ -0,0 +1,3 @@ + diff --git a/data/conf/rspamd/override.d/logging.inc b/data/conf/rspamd/override.d/logging.inc index 64a2b7d4..23a9f3cf 100644 --- a/data/conf/rspamd/override.d/logging.inc +++ b/data/conf/rspamd/override.d/logging.inc @@ -1,3 +1,4 @@ type = "console"; systemd = false; .include "$CONFDIR/logging.inc" +.include(try=true; priority=20) "$CONFDIR/override.d/logging.custom.inc" diff --git a/data/conf/rspamd/override.d/ratelimit.conf b/data/conf/rspamd/override.d/ratelimit.conf index 3c0a55c3..f9e359bc 100644 --- a/data/conf/rspamd/override.d/ratelimit.conf +++ b/data/conf/rspamd/override.d/ratelimit.conf @@ -9,6 +9,6 @@ rates { } whitelisted_rcpts = "postmaster,mailer-daemon"; max_rcpt = 5; -custom_keywords = "/etc/rspamd/custom/ratelimit.lua"; +custom_keywords = "/etc/rspamd/lua/ratelimit.lua"; user_keywords = ["user", "customrl"]; dynamic_rates = { customrl = "customrl"} diff --git a/data/conf/rspamd/override.d/worker-controller-password.inc b/data/conf/rspamd/override.d/worker-controller-password.inc new file mode 100644 index 00000000..dcf2c804 --- /dev/null +++ b/data/conf/rspamd/override.d/worker-controller-password.inc @@ -0,0 +1 @@ +# Placeholder diff --git a/data/conf/rspamd/override.d/worker-controller.inc b/data/conf/rspamd/override.d/worker-controller.inc index ae136461..22d9a024 100644 --- a/data/conf/rspamd/override.d/worker-controller.inc +++ b/data/conf/rspamd/override.d/worker-controller.inc @@ -1,8 +1,9 @@ bind_socket = "*:11334"; -enable_password = "$2$pppq86q9uns51zd5ekfxecj7bxwaefo3$p7f9xdhamydjhtypcr639it3kqeiknx3dk9on7skjypyi8uwwcmy"; secure_ip = "192.168.0.0/16"; secure_ip = "172.16.0.0/12"; secure_ip = "10.0.0.0/8"; secure_ip = "127.0.0.1"; secure_ip = "::1"; secure_ip = "fd4d:6169:6c63:6f77::/64" +.include(try=true; priority=10) "$CONFDIR/override.d/worker-controller-password.inc" +.include(try=true; priority=20) "$CONFDIR/override.d/worker-controller.custom.inc" diff --git a/data/conf/rspamd/override.d/worker-normal.inc b/data/conf/rspamd/override.d/worker-normal.inc index 71569636..a7ab4baf 100644 --- a/data/conf/rspamd/override.d/worker-normal.inc +++ b/data/conf/rspamd/override.d/worker-normal.inc @@ -1,2 +1,3 @@ bind_socket = "*:11333"; task_timeout = 12s; +.include(try=true; priority=20) "$CONFDIR/override.d/worker-normal.custom.inc" diff --git a/data/conf/rspamd/override.d/worker-proxy.inc b/data/conf/rspamd/override.d/worker-proxy.inc index b87c7f29..0df926a7 100644 --- a/data/conf/rspamd/override.d/worker-proxy.inc +++ b/data/conf/rspamd/override.d/worker-proxy.inc @@ -5,3 +5,4 @@ upstream { default = true; hosts = "rspamd:11333" } +.include(try=true; priority=20) "$CONFDIR/override.d/worker-proxy.custom.inc" diff --git a/data/web/admin.php b/data/web/admin.php index 06af3db9..08288386 100644 --- a/data/web/admin.php +++ b/data/web/admin.php @@ -7,26 +7,9 @@ $_SESSION['return_to'] = $_SERVER['REQUEST_URI']; $tfa_data = get_tfa(); ?>
-
@@ -57,7 +40,7 @@ $tfa_data = get_tfa();
- +
@@ -95,6 +78,42 @@ $tfa_data = get_tfa();
+ +
+
API
+
+
+
+ +
+ +
+
+
+ +
+ +
+
+
+
+ +
+
+
+
+
+ + +
+
+
+
+
+
+
@@ -120,7 +139,6 @@ $tfa_data = get_tfa();
-
@@ -230,7 +249,7 @@ $tfa_data = get_tfa(); ?> -
+
@@ -291,7 +310,7 @@ $tfa_data = get_tfa();

- +
@@ -328,7 +347,7 @@ $tfa_data = get_tfa();
- +
@@ -358,7 +377,7 @@ $tfa_data = get_tfa();

- +
@@ -376,6 +395,43 @@ $tfa_data = get_tfa();
+ +
+
Quarantäne
+
+ + +
+
+
+ + +
+
+
+
+ + +
+
+
+
+
+ +
+ + +
+
+
@@ -444,10 +500,29 @@ $tfa_data = get_tfa(); endforeach; ?> -
- - -
+

+ + +

+ + + +
+
+ + +
+
+ + +
+
+ + +
+
@@ -455,108 +530,6 @@ $tfa_data = get_tfa(); -
-
-
Postfix -
- - - -
-
-
-
-
-
-
-
-
- -
-
-
Dovecot -
- - - -
-
-
-
-
-
-
-
-
- -
-
-
SOGo -
- - - -
-
-
-
-
-
-
-
-
- -
-
-
Fail2ban -
- - - -
-
-
-
-
-
-
-
-
- -
-
-
Rspamd history -
- - - -
-
-
-
-
-
-
-
-
- -
-
-
Autodiscover -
- - - -
-
-
-
-
-
-
-
-
- li{float:none}.navbar-nav>li>a{padding-top:10px;padding-bottom:10px}.collapse.in{display:block!important}.navbar-nav .open .dropdown-menu{position:static;float:none;width:auto;margin-top:0;background-color:transparent;border:0;-webkit-box-shadow:none;box-shadow:none}} \ No newline at end of file diff --git a/data/web/css/debug.css b/data/web/css/debug.css new file mode 100644 index 00000000..585d1905 --- /dev/null +++ b/data/web/css/debug.css @@ -0,0 +1,37 @@ +table.footable>tbody>tr.footable-empty>td { + font-size:15px !important; + font-style:italic; +} +.pagination a { + text-decoration: none !important; +} +.panel panel-default { + overflow: visible !important; +} +.table-responsive { + overflow: visible !important; +} +@media screen and (max-width: 767px) { + .table-responsive { + overflow-x: scroll !important; + } +} +.footer-add-item { + display:block; + text-align: center; + font-style: italic; + padding: 10px; + background: #F5F5F5; +} +@media (min-width: 992px) { + .container { + width: 80%; + } +} +.mass-actions-debug { + user-select: none; + padding:10px 0 10px 10px; +} +.inputMissingAttr { + border-color: #FF4136; +} \ No newline at end of file diff --git a/data/web/css/mailbox.css b/data/web/css/mailbox.css index 5004cda1..44babe6a 100644 --- a/data/web/css/mailbox.css +++ b/data/web/css/mailbox.css @@ -34,4 +34,12 @@ table.footable>tbody>tr.footable-empty>td { } .inputMissingAttr { border-color: #FF4136; -} \ No newline at end of file +} +.dns-found { + max-width: 300px; + word-break: break-all; +} +.dns-recommended { + max-width: 150px; + word-break: break-all; +} diff --git a/data/web/css/quarantaine.css b/data/web/css/quarantaine.css new file mode 100644 index 00000000..7a5ee761 --- /dev/null +++ b/data/web/css/quarantaine.css @@ -0,0 +1,37 @@ +table.footable>tbody>tr.footable-empty>td { + font-size:15px !important; + font-style:italic; +} +.pagination a { + text-decoration: none !important; +} +.panel panel-default { + overflow: visible !important; +} +.table-responsive { + overflow: visible !important; +} +@media screen and (max-width: 767px) { + .table-responsive { + overflow-x: scroll !important; + } +} +.footer-add-item { + display:block; + text-align: center; + font-style: italic; + padding: 10px; + background: #F5F5F5; +} +@media (min-width: 992px) { + .container { + width: 80%; + } +} +.mass-actions-quarantaine { + user-select: none; + padding:10px 0 10px 10px; +} +.inputMissingAttr { + border-color: #FF4136; +} \ No newline at end of file diff --git a/data/web/debug.php b/data/web/debug.php new file mode 100644 index 00000000..0723ba6a --- /dev/null +++ b/data/web/debug.php @@ -0,0 +1,328 @@ + +
+ + + +
+
+
+ +
+
+
+

Rspamd UI

+
+
+
+
+
+
+
+ +
+
+
+ +
+ +
+
+
+ +
+ +
+
+
+
+ +
+
+
+
+
+ Rspamd UI +
+
+
+
+
+ +
+
+
+

Rspamd settings map

+
+
+ +
+
+
+ +
+
+
+

Container information

+
+
+
    + +
  • + + setTimestamp(mktime( + $StartedAt['hour'], + $StartedAt['minute'], + $StartedAt['second'], + $StartedAt['month'], + $StartedAt['day'], + $StartedAt['year'])); + $user_tz = new DateTimeZone(getenv('TZ')); + $date->setTimezone($user_tz); + $started = $date->format('r'); + ?> + (Started on ), + Restart +     +
  • + +
+
+
+
+ +
+
+
Postfix +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
Dovecot +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
SOGo +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
Fail2ban +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
Rspamd history +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
Autodiscover +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
Watchdog +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
ACME +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
API +
+ + + +
+
+
+
+
+
+
+
+
+ +
+
+
+
+ + + + + diff --git a/data/web/edit.php b/data/web/edit.php index e06a0229..11c924b5 100644 --- a/data/web/edit.php +++ b/data/web/edit.php @@ -608,6 +608,52 @@ if (isset($_SESSION['mailcow_cc_role'])) { +

BCC map

+
+
+ +
+ +
+ + BCC destinations can only be valid email addresses. Separated by whitespace, semicolon, new line or comma. +
+
+
+ +
+ +
+
+
+
+
+ +
+
+
+
+
+ +
+
+
+ + + OK' : 'Error: ' . $response['msg'] . ''; + if ($response['type'] == "success") { + break; + } + usleep(1500000); + $retry++; + } + echo (!isset($last_response)) ? 'Already running' : $last_response; + } + if ($_GET['action'] == "stop") { + header('Content-Type: text/html; charset=utf-8'); + $retry = 0; + while (docker($_GET['service'], 'info')['State']['Running'] == 1 && $retry <= 3) { + $response = docker($_GET['service'], 'post', 'stop'); + $response = json_decode($response, true); + $last_response = ($response['type'] == "success") ? 'OK' : 'Error: ' . $response['msg'] . ''; + if ($response['type'] == "success") { + break; + } + usleep(1500000); + $retry++; + } + echo (!isset($last_response)) ? 'Not running' : $last_response; + } + if ($_GET['action'] == "restart") { + header('Content-Type: text/html; charset=utf-8'); + $response = docker($_GET['service'], 'post', 'restart'); + $response = json_decode($response, true); + $last_response = ($response['type'] == "success") ? 'OK' : 'Error: ' . $response['msg'] . ''; + echo (!isset($last_response)) ? 'Cannot restart container' : $last_response; + } + if ($_GET['action'] == "logs") { + $lines = (empty($_GET['lines']) || !is_numeric($_GET['lines'])) ? 1000 : $_GET['lines']; + header('Content-Type: text/plain; charset=utf-8'); + print_r(preg_split('/\n/', docker($_GET['service'], 'logs', $lines))); + } +} + +?> diff --git a/data/web/diagnostics.php b/data/web/inc/ajax/dns_diagnostics.php similarity index 59% rename from data/web/diagnostics.php rename to data/web/inc/ajax/dns_diagnostics.php index 09d5740d..1f8f8a3a 100644 --- a/data/web/diagnostics.php +++ b/data/web/inc/ajax/dns_diagnostics.php @@ -1,14 +1,34 @@ OK'); +define('state_missing', "✗"); define('state_nomatch', "?"); -define('state_optional', "(optional)"); +define('state_optional', " 2"); if (isset($_SESSION['mailcow_cc_role']) && $_SESSION['mailcow_cc_role'] == "admin") { -require_once("inc/header.inc.php"); + +$domains = mailbox('get', 'domains'); +foreach(mailbox('get', 'domains') as $dn) { + $domains = array_merge($domains, mailbox('get', 'alias_domains', $dn)); +} + +if (isset($_GET['domain'])) { + if (is_valid_domain_name($_GET['domain'])) { + if (in_array($_GET['domain'], $domains)) { + $domain = $_GET['domain']; + } + else { + echo "No such domain in context"; + die(); + } + } + else { + echo "Invalid domain name"; + die(); + } +} $ch = curl_init('http://ip4.mailcow.email'); curl_setopt($ch, CURLOPT_IPRESOLVE, CURL_IPRESOLVE_V4); @@ -47,6 +67,9 @@ if ($https_port === FALSE) { $https_port = substr($_SERVER['HTTP_HOST'], $https_port+1); } +$spf_link = 'SPF Record Syntax'; +$dmarc_link = 'DMARC Assistant'; + $records = array(); $records[] = array($mailcow_hostname, 'A', $ip); $records[] = array($ptr, 'PTR', $mailcow_hostname); @@ -54,10 +77,6 @@ if (!empty($ip6)) { $records[] = array($mailcow_hostname, 'AAAA', $ip6); $records[] = array($ptr6, 'PTR', $mailcow_hostname); } -$domains = mailbox('get', 'domains'); -foreach(mailbox('get', 'domains') as $domain) { - $domains = array_merge($domains, mailbox('get', 'alias_domains', $domain)); -} if (!isset($autodiscover_config['sieve'])) { $autodiscover_config['sieve'] = array('server' => $mailcow_hostname, 'port' => array_pop(explode(':', getenv('SIEVE_PORT')))); @@ -72,53 +91,47 @@ $records[] = array('_' . $autodiscover_config['smtp']['tlsport'] . '._tcp.' . $a $records[] = array('_' . $autodiscover_config['imap']['port'] . '._tcp.' . $autodiscover_config['imap']['server'], 'TLSA', generate_tlsa_digest($autodiscover_config['imap']['server'], $autodiscover_config['imap']['port'])); $records[] = array('_' . $autodiscover_config['pop3']['port'] . '._tcp.' . $autodiscover_config['pop3']['server'], 'TLSA', generate_tlsa_digest($autodiscover_config['pop3']['server'], $autodiscover_config['pop3']['port'])); $records[] = array('_' . $autodiscover_config['sieve']['port'] . '._tcp.' . $autodiscover_config['sieve']['server'], 'TLSA', generate_tlsa_digest($autodiscover_config['sieve']['server'], $autodiscover_config['sieve']['port'], 1)); +$records[] = array($domain, 'MX', $mailcow_hostname); +$records[] = array('autodiscover.' . $domain, 'CNAME', $mailcow_hostname); +$records[] = array('_autodiscover._tcp.' . $domain, 'SRV', $mailcow_hostname . ' ' . $https_port); +$records[] = array('autoconfig.' . $domain, 'CNAME', $mailcow_hostname); +$records[] = array($domain, 'TXT', $spf_link, state_optional); +$records[] = array('_dmarc.' . $domain, 'TXT', $dmarc_link, state_optional); -$spf_link = 'SPF Record Syntax'; -$dmarc_link = 'DMARC Assistant'; +if (!empty($dkim = dkim('details', $domain))) { + $records[] = array($dkim['dkim_selector'] . '._domainkey.' . $domain, 'TXT', $dkim['dkim_txt']); +} -foreach ($domains as $domain) { - $records[] = array($domain, 'MX', $mailcow_hostname); - $records[] = array('autodiscover.' . $domain, 'CNAME', $mailcow_hostname); - $records[] = array('_autodiscover._tcp.' . $domain, 'SRV', $mailcow_hostname . ' ' . $https_port); - $records[] = array('autoconfig.' . $domain, 'CNAME', $mailcow_hostname); - $records[] = array($domain, 'TXT', $spf_link, state_optional); - $records[] = array('_dmarc.' . $domain, 'TXT', $dmarc_link, state_optional); - - if (!empty($dkim = dkim('details', $domain))) { - $records[] = array($dkim['dkim_selector'] . '._domainkey.' . $domain, 'TXT', $dkim['dkim_txt']); +$current_records = dns_get_record('_pop3._tcp.' . $domain, DNS_SRV); +if (count($current_records) == 0 || $current_records[0]['target'] != '') { + if ($autodiscover_config['pop3']['tlsport'] != '110') { + $records[] = array('_pop3._tcp.' . $domain, 'SRV', $autodiscover_config['pop3']['server'] . ' ' . $autodiscover_config['pop3']['tlsport']); } - - $current_records = dns_get_record('_pop3._tcp.' . $domain, DNS_SRV); - if (count($current_records) == 0 || $current_records[0]['target'] != '') { - if ($autodiscover_config['pop3']['tlsport'] != '110') { - $records[] = array('_pop3._tcp.' . $domain, 'SRV', $autodiscover_config['pop3']['server'] . ' ' . $autodiscover_config['pop3']['tlsport']); - } - } else { - $records[] = array('_pop3._tcp.' . $domain, 'SRV', '. 0'); - } - $current_records = dns_get_record('_pop3s._tcp.' . $domain, DNS_SRV); - if (count($current_records) == 0 || $current_records[0]['target'] != '') { - if ($autodiscover_config['pop3']['port'] != '995') { - $records[] = array('_pop3s._tcp.' . $domain, 'SRV', $autodiscover_config['pop3']['server'] . ' ' . $autodiscover_config['pop3']['port']); - } - } else { - $records[] = array('_pop3s._tcp.' . $domain, 'SRV', '. 0'); - } - if ($autodiscover_config['imap']['tlsport'] != '143') { - $records[] = array('_imap._tcp.' . $domain, 'SRV', $autodiscover_config['imap']['server'] . ' ' . $autodiscover_config['imap']['tlsport']); - } - if ($autodiscover_config['imap']['port'] != '993') { - $records[] = array('_imaps._tcp.' . $domain, 'SRV', $autodiscover_config['imap']['server'] . ' ' . $autodiscover_config['imap']['port']); - } - if ($autodiscover_config['smtp']['tlsport'] != '587') { - $records[] = array('_submission._tcp.' . $domain, 'SRV', $autodiscover_config['smtp']['server'] . ' ' . $autodiscover_config['smtp']['tlsport']); - } - if ($autodiscover_config['smtp']['port'] != '465') { - $records[] = array('_smtps._tcp.' . $domain, 'SRV', $autodiscover_config['smtp']['server'] . ' ' . $autodiscover_config['smtp']['port']); - } - if ($autodiscover_config['sieve']['port'] != '4190') { - $records[] = array('_sieve._tcp.' . $domain, 'SRV', $autodiscover_config['sieve']['server'] . ' ' . $autodiscover_config['sieve']['port']); +} else { + $records[] = array('_pop3._tcp.' . $domain, 'SRV', '. 0'); +} +$current_records = dns_get_record('_pop3s._tcp.' . $domain, DNS_SRV); +if (count($current_records) == 0 || $current_records[0]['target'] != '') { + if ($autodiscover_config['pop3']['port'] != '995') { + $records[] = array('_pop3s._tcp.' . $domain, 'SRV', $autodiscover_config['pop3']['server'] . ' ' . $autodiscover_config['pop3']['port']); } +} else { + $records[] = array('_pop3s._tcp.' . $domain, 'SRV', '. 0'); +} +if ($autodiscover_config['imap']['tlsport'] != '143') { + $records[] = array('_imap._tcp.' . $domain, 'SRV', $autodiscover_config['imap']['server'] . ' ' . $autodiscover_config['imap']['tlsport']); +} +if ($autodiscover_config['imap']['port'] != '993') { + $records[] = array('_imaps._tcp.' . $domain, 'SRV', $autodiscover_config['imap']['server'] . ' ' . $autodiscover_config['imap']['port']); +} +if ($autodiscover_config['smtp']['tlsport'] != '587') { + $records[] = array('_submission._tcp.' . $domain, 'SRV', $autodiscover_config['smtp']['server'] . ' ' . $autodiscover_config['smtp']['tlsport']); +} +if ($autodiscover_config['smtp']['port'] != '465') { + $records[] = array('_smtps._tcp.' . $domain, 'SRV', $autodiscover_config['smtp']['server'] . ' ' . $autodiscover_config['smtp']['port']); +} +if ($autodiscover_config['sieve']['port'] != '4190') { + $records[] = array('_sieve._tcp.' . $domain, 'SRV', $autodiscover_config['sieve']['server'] . ' ' . $autodiscover_config['sieve']['port']); } $record_types = array( @@ -141,15 +154,11 @@ $data_field = array( 'TXT' => 'txt', ); ?> -
-

-

0 && count($cname) > 0) { if ($a[0]['ip'] == $cname[0]['ip']) { $currents = array(array('host' => $record[0], 'class' => 'IN', 'type' => 'CNAME', 'target' => $record[2])); - $aaaa = dns_get_record($record[0], DNS_AAAA); $cname = dns_get_record($record[2], DNS_AAAA); if (count($aaaa) == 0 || count($cname) == 0 || $aaaa[0]['ipv6'] != $cname[0]['ipv6']) { - $currents[0]['target'] = $aaaa[0]['ipv6']; + $currents[0]['target'] = $aaaa[0]['ipv6'] . ' 1'; } - } else { - $currents = array(array('host' => $record[0], 'class' => 'IN', 'type' => 'CNAME', 'target' => $a[0]['ip'])); + } + else { + $currents = array(array('host' => $record[0], 'class' => 'IN', 'type' => 'CNAME', 'target' => $a[0]['ip'] . ' 1')); } } } - + foreach ($currents as &$current) { - if ($current['type'] != $record[1]) - { + if ($current['type'] != $record[1]) { + unset($current); continue; } - - elseif ($current['type'] == 'TXT' && strpos($current['txt'], 'v=DMARC1') === 0 && $record[2] == $dmarc_link) { - $current['txt'] = str_replace(' ', '', $current['txt']); - $state = state_optional . '
' . $current[$data_field[$current['type']]]; + elseif ($current['type'] == 'TXT' && + stripos($current['txt'], 'v=dmarc') === 0 && + $record[2] == $dmarc_link) { + $current['txt'] = str_replace(' ', '', $current['txt']); + $state = $current[$data_field[$current['type']]] . state_optional; } - else if ($current['type'] == 'TXT' && strpos($current['txt'], 'v=spf1') === 0 && $record[2] == $spf_link) { - $state = state_optional . '
' . $current[$data_field[$current['type']]]; + elseif ($current['type'] == 'TXT' && + stripos($current['txt'], 'v=spf' && + $record[2] == $spf_link) === 0) { + $state = $current[$data_field[$current['type']]] . state_optional; } - else if ($current['type'] == 'TXT' && strpos($current['txt'], 'v=DKIM1') === 0 && strpos($record[2], 'v=DKIM1') === 0) { - $current['txt'] = str_replace(' ', '', $current['txt']); - if ($current[$data_field[$current['type']]] == $record[2]) - $state = state_good; + elseif ($current['type'] == 'TXT' && + stripos($current['txt'], 'v=dkim') === 0 && + stripos($record[2], 'v=dkim') === 0) { + $current['txt'] = str_replace(' ', '', $current['txt']); + if ($current[$data_field[$current['type']]] == $record[2]) { + $state = state_good; + } } - else if ($current['type'] != 'TXT' && isset($data_field[$current['type']]) && $state != state_good) { - $state = state_nomatch; - if ($current[$data_field[$current['type']]] == $record[2]) - $state = state_good; + elseif ($current['type'] != 'TXT' && + isset($data_field[$current['type']]) && $state != state_good) { + $state = state_nomatch; + if ($current[$data_field[$current['type']]] == $record[2]) { + $state = state_good; + } } } unset($current); - + if (isset($record[3]) && $record[3] == state_optional && ($state == state_missing || $state == state_nomatch)) { $state = state_optional; } @@ -234,17 +258,23 @@ foreach ($records as $record) } $state = implode('
', $state); } - - echo sprintf('', $record[0], $record[1], $record[2], $state); + echo sprintf(' + + + + + ', $record[0], $record[1], $record[2], $state); } ?>
%s%s%s%s
%s%s%s
-
+

+ 1
+ 2 +

diff --git a/data/web/inc/ajax/log_driver.php b/data/web/inc/ajax/log_driver.php new file mode 100644 index 00000000..319f672d --- /dev/null +++ b/data/web/inc/ajax/log_driver.php @@ -0,0 +1,12 @@ + diff --git a/data/web/inc/ajax/qitem_details.php b/data/web/inc/ajax/qitem_details.php new file mode 100644 index 00000000..a4b80be1 --- /dev/null +++ b/data/web/inc/ajax/qitem_details.php @@ -0,0 +1,83 @@ + 10485760) { + echo json_encode(array('error' => 'Message size exceeds 10 MiB.')); + exit; + } + if (!empty($mailc['msg'])) { + // Init message array + $data = array(); + // Init parser + $mail_parser = new PhpMimeMailParser\Parser(); + // Load msg to parser + $mail_parser->setText($mailc['msg']); + // Get text/plain content + $data['text_plain'] = $mail_parser->getMessageBody('text'); + // Get subject + $data['subject'] = $mail_parser->getHeader('subject'); + // Get attachments + if (is_dir($tmpdir)) { + rrmdir($tmpdir); + } + mkdir('/tmp/' . $_GET['id']); + $mail_parser->saveAttachments($tmpdir, true); + $atts = $mail_parser->getAttachments(true); + if (count($atts) > 0) { + foreach ($atts as $key => $val) { + $data['attachments'][$key] = array( + // Index + // 0 => file name + // 1 => mime type + // 2 => file size + // 3 => vt link by sha256 + $val->getFilename(), + $val->getContentType(), + filesize($tmpdir . $val->getFilename()), + 'https://www.virustotal.com/file/' . hash_file('SHA256', $tmpdir . $val->getFilename()) . '/analysis/' + ); + } + } + if (isset($_GET['att'])) { + $dl_id = intval($_GET['att']); + $dl_filename = $data['attachments'][$dl_id][0]; + if (!is_dir($tmpdir . $dl_filename) && file_exists($tmpdir . $dl_filename)) { + header('Pragma: public'); + header('Expires: 0'); + header('Cache-Control: must-revalidate, post-check=0, pre-check=0'); + header('Cache-Control: private', false); + header('Content-Type: ' . $data['attachments'][$dl_id][1]); + header('Content-Disposition: attachment; filename="'. $dl_filename . '";'); + header('Content-Transfer-Encoding: binary'); + header('Content-Length: ' . $data['attachments'][$dl_id][2]); + readfile($tmpdir . $dl_filename); + exit; + } + } + echo json_encode($data); + } +} +?> diff --git a/data/web/inc/ajax/sogo_ctrl.php b/data/web/inc/ajax/sogo_ctrl.php deleted file mode 100644 index e238d9c0..00000000 --- a/data/web/inc/ajax/sogo_ctrl.php +++ /dev/null @@ -1,39 +0,0 @@ -OK' : 'Error: ' . $response['msg'] . ''; - if ($response['type'] == "success") { - break; - } - usleep(1500000); - $retry++; - } - echo (!isset($last_response)) ? 'Already running' : $last_response; -} - -if ($_GET['ACTION'] == "stop") { - $retry = 0; - while (docker('sogo-mailcow', 'info')['State']['Running'] == 1 && $retry <= 3) { - $response = docker('sogo-mailcow', 'post', 'stop'); - $response = json_decode($response, true); - $last_response = ($response['type'] == "success") ? 'OK' : 'Error: ' . $response['msg'] . ''; - if ($response['type'] == "success") { - break; - } - usleep(1500000); - $retry++; - } - echo (!isset($last_response)) ? 'Not running' : $last_response; -} - -?> diff --git a/data/web/inc/footer.inc.php b/data/web/inc/footer.inc.php index 9246d230..eb419308 100644 --- a/data/web/inc/footer.inc.php +++ b/data/web/inc/footer.inc.php @@ -8,6 +8,7 @@ require_once $_SERVER['DOCUMENT_ROOT'] . '/modals/footer.php'; + @@ -26,11 +27,19 @@ $(document).ready(function() { msg = $('').html(message).text(); if (type == 'danger') { auto_hide = 0; + $('#' + localStorage.getItem("add_modal")).modal('show'); + localStorage.removeItem("add_modal"); } else { auto_hide = 5000; } + $.ajax({ + url: '/inc/ajax/log_driver.php', + data: {"type": type,"msg": msg}, + type: "GET" + }); $.notify({message: msg},{z_index: 20000, delay: auto_hide, type: type,placement: {from: "bottom",align: "right"},animate: {enter: 'animated fadeInUp',exit: 'animated fadeOutDown'}}); } + $('[data-cached-form="true"]').formcache({key: $(this).data('id')}); mailcow_alert_box(, ""); @@ -40,6 +49,7 @@ $(document).ready(function() { backdrop: 'static', keyboard: false }); + $('#u2f_status_auth').html('

Initializing, please wait...

'); $('#ConfirmTFAModal').on('shown.bs.modal', function(){ $(this).find('#token').focus(); // If U2F @@ -49,20 +59,21 @@ $(document).ready(function() { cache: false, dataType: 'script', url: "/api/v1/get/u2f-authentication/", - success: function(data){ + complete: function(data){ + $('#u2f_status_auth').html(''); data; + setTimeout(function() { + console.log("Ready to authenticate"); + u2f.sign(appId, challenge, registeredKeys, function(data) { + var form = document.getElementById('u2f_auth_form'); + var auth = document.getElementById('u2f_auth_data'); + console.log("Authenticate callback", data); + auth.value = JSON.stringify(data); + form.submit(); + }); + }, 1000); } }); - setTimeout(function() { - console.log("sign: ", req); - u2f.sign(req, function(data) { - var form = document.getElementById('u2f_auth_form'); - var auth = document.getElementById('u2f_auth_data'); - console.log("Authenticate callback", data); - auth.value = JSON.stringify(data); - form.submit(); - }); - }, 1000); } }); @@ -81,32 +92,34 @@ $(document).ready(function() { if ($(this).val() == "u2f") { $('#U2FModal').modal('show'); $("option:selected").prop("selected", false); + $('#u2f_status_reg').html('

Initializing, please wait...

'); $.ajax({ type: "GET", cache: false, dataType: 'script', url: "/api/v1/get/u2f-registration/", - success: function(data){ + complete: function(data){ data; + setTimeout(function() { + console.log("Ready to register"); + $('#u2f_status_reg').html(''); + u2f.register(appId, registerRequests, registeredKeys, function(deviceResponse) { + var form = document.getElementById('u2f_reg_form'); + var reg = document.getElementById('u2f_register_data'); + console.log("Register callback: ", data); + if (deviceResponse.errorCode && deviceResponse.errorCode != 0) { + var u2f_return_code = document.getElementById('u2f_return_code'); + u2f_return_code.style.display = u2f_return_code.style.display === 'none' ? '' : null; + if (deviceResponse.errorCode == "4") { deviceResponse.errorCode = "4 - The presented device is not eligible for this request. For a registration request this may mean that the token is already registered, and for a sign request it may mean that the token does not know the presented key handle"; } + u2f_return_code.innerHTML = 'Error code: ' + deviceResponse.errorCode; + return; + } + reg.value = JSON.stringify(deviceResponse); + form.submit(); + }); + }, 1000); } }); - setTimeout(function() { - console.log("Register: ", req); - u2f.register([req], sigs, function(data) { - var form = document.getElementById('u2f_reg_form'); - var reg = document.getElementById('u2f_register_data'); - console.log("Register callback", data); - if (data.errorCode && data.errorCode != 0) { - var u2f_return_code = document.getElementById('u2f_return_code'); - u2f_return_code.style.display = u2f_return_code.style.display === 'none' ? '' : null; - if (data.errorCode == "4") { data.errorCode = "4 - The presented device is not eligible for this request. For a registration request this may mean that the token is already registered, and for a sign request it may mean that the token does not know the presented key handle"; } - u2f_return_code.innerHTML = 'Error code: ' + data.errorCode; - return; - } - reg.value = JSON.stringify(data); - form.submit(); - }); - }, 1000); } if ($(this).val() == "none") { $('#DisableTFAModal').modal('show'); @@ -114,13 +127,8 @@ $(document).ready(function() { } }); - // Activate tooltips $(function () { $('[data-toggle="tooltip"]').tooltip() - }) - // Hide alerts after n seconds - $("#alert-fade").fadeTo(7000, 500).slideUp(500, function(){ - $("#alert-fade").alert('close'); }); // Remember last navigation pill @@ -169,36 +177,32 @@ $(document).ready(function() { // Init Bootstrap Selectpicker $('select').selectpicker(); - // Trigger SOGo restart - $('#triggerRestartSogo').click(function(){ - $(this).prop("disabled",true); - $(this).html(' '); - $('#statusTriggerRestartSogo').text('Stopping SOGo workers, this may take a while... '); - $.ajax({ - method: 'get', - url: '/inc/ajax/sogo_ctrl.php', - data: { - 'ajax': true, - 'ACTION': 'stop' - }, - success: function(data) { - $('#statusTriggerRestartSogo').append(data); - $('#statusTriggerRestartSogo').append('
Starting SOGo...'); - $.ajax({ - method: 'get', - url: '/inc/ajax/sogo_ctrl.php', - data: { - 'ajax': true, - 'ACTION': 'start' - }, - success: function(data) { - $('#statusTriggerRestartSogo').append(data); - $('#triggerRestartSogo').html(' '); - } - }); - } + // Trigger container restart + $('#RestartContainer').on('show.bs.modal', function(e) { + var container = $(e.relatedTarget).data('container'); + $('#containerName').text(container); + $('#triggerRestartContainer').click(function(){ + $(this).prop("disabled",true); + $(this).html(' '); + $('#statusTriggerRestartContainer').text('Restarting container, this may take a while... '); + $.ajax({ + method: 'get', + url: '/inc/ajax/container_ctrl.php', + timeout: 10000, + data: { + 'service': container, + 'action': 'restart' + }, + error: function() { + window.location = window.location.href.split("#")[0]; + }, + success: function(data) { + $('#statusTriggerRestartContainer').append(data); + $('#triggerRestartContainer').html(' '); + } + }); }); - }); + }) // CSRF $('').attr('id', 'csrf_token').attr('name', 'csrf_token').appendTo('form'); diff --git a/data/web/inc/functions.bcc.inc.php b/data/web/inc/functions.bcc.inc.php new file mode 100644 index 00000000..1ce58a54 --- /dev/null +++ b/data/web/inc/functions.bcc.inc.php @@ -0,0 +1,292 @@ + 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + $local_dest = strtolower(trim($_data['local_dest'])); + $bcc_dest = array_map('trim', preg_split( "/( |,|;|\n)/", $_data['bcc_dest'])); + $active = intval($_data['active']); + $type = $_data['type']; + if ($type != 'sender' && $type != 'rcpt') { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Invalid BCC map type' + ); + return false; + } + if (empty($bcc_dest)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'BCC destination cannot be empty' + ); + return false; + } + if (is_valid_domain_name($local_dest)) { + if (!hasDomainAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $local_dest)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + $domain = idn_to_ascii($local_dest); + $local_dest_sane = '@' . idn_to_ascii($local_dest); + } + elseif (filter_var($local_dest, FILTER_VALIDATE_EMAIL)) { + if (!hasMailboxObjectAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $local_dest)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + $domain = mailbox('get', 'mailbox_details', $local_dest)['domain']; + if (empty($domain)) { + return false; + } + $local_dest_sane = $local_dest; + } + else { + return false; + } + foreach ($bcc_dest as &$bcc_dest_e) { + if (!filter_var($bcc_dest_e, FILTER_VALIDATE_EMAIL)) { + $bcc_dest_e = null;; + } + $bcc_dest_e = strtolower($bcc_dest_e); + } + $bcc_dest = array_filter($bcc_dest); + $bcc_dest = implode(",", $bcc_dest); + if (empty($bcc_dest)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'BCC map destination cannot be empty' + ); + return false; + } + try { + $stmt = $pdo->prepare("SELECT `id` FROM `bcc_maps` + WHERE `local_dest` = :local_dest AND `type` = :type"); + $stmt->execute(array(':local_dest' => $local_dest_sane, ':type' => $type)); + $num_results = count($stmt->fetchAll(PDO::FETCH_ASSOC)); + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + if ($num_results != 0) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'A BCC map entry "' . htmlspecialchars($local_dest_sane) . '" exists for type "' . $type . '"' + ); + return false; + } + try { + $stmt = $pdo->prepare("INSERT INTO `bcc_maps` (`local_dest`, `bcc_dest`, `domain`, `active`, `type`) VALUES + (:local_dest, :bcc_dest, :domain, :active, :type)"); + $stmt->execute(array( + ':local_dest' => $local_dest_sane, + ':bcc_dest' => $bcc_dest, + ':domain' => $domain, + ':active' => $active, + ':type' => $type + )); + } + catch (PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => 'BCC map entry saved' + ); + break; + case 'edit': + if (!isset($_SESSION['acl']['bcc_maps']) || $_SESSION['acl']['bcc_maps'] != "1" ) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + $ids = (array)$_data['id']; + foreach ($ids as $id) { + $is_now = bcc('details', $id); + if (!empty($is_now)) { + $active = (isset($_data['active'])) ? intval($_data['active']) : $is_now['active_int']; + $bcc_dest = (!empty($_data['bcc_dest'])) ? $_data['bcc_dest'] : $is_now['bcc_dest']; + $local_dest = $is_now['local_dest']; + $type = (!empty($_data['type'])) ? $_data['type'] : $is_now['type']; + } + else { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + $bcc_dest = array_map('trim', preg_split( "/( |,|;|\n)/", $bcc_dest)); + $active = intval($_data['active']); + foreach ($bcc_dest as &$bcc_dest_e) { + if (!filter_var($bcc_dest_e, FILTER_VALIDATE_EMAIL)) { + $bcc_dest_e = null;; + } + $bcc_dest_e = strtolower($bcc_dest_e); + } + $bcc_dest = array_filter($bcc_dest); + $bcc_dest = implode(",", $bcc_dest); + if (empty($bcc_dest)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'BCC map destination cannot be empty' + ); + return false; + } + try { + $stmt = $pdo->prepare("SELECT `id` FROM `bcc_maps` + WHERE `local_dest` = :local_dest AND `type` = :type"); + $stmt->execute(array(':local_dest' => $local_dest, ':type' => $type)); + $id_now = $stmt->fetch(PDO::FETCH_ASSOC)['id']; + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + if (isset($id_now) && $id_now != $id) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'A BCC map entry ' . htmlspecialchars($local_dest) . ' exists for this type' + ); + return false; + } + try { + $stmt = $pdo->prepare("UPDATE `bcc_maps` SET `bcc_dest` = :bcc_dest, `active` = :active, `type` = :type WHERE `id`= :id"); + $stmt->execute(array( + ':bcc_dest' => $bcc_dest, + ':active' => $active, + ':type' => $type, + ':id' => $id + )); + } + catch (PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => 'BCC map entry edited' + ); + break; + case 'details': + $bccdata = array(); + $id = intval($_data); + try { + $stmt = $pdo->prepare("SELECT `id`, + `local_dest`, + `bcc_dest`, + `active` AS `active_int`, + CASE `active` WHEN 1 THEN '".$lang['mailbox']['yes']."' ELSE '".$lang['mailbox']['no']."' END AS `active`, + `type`, + `created`, + `domain`, + `modified` FROM `bcc_maps` + WHERE `id` = :id"); + $stmt->execute(array(':id' => $id)); + $bccdata = $stmt->fetch(PDO::FETCH_ASSOC); + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + if (!hasDomainAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $bccdata['domain'])) { + $bccdata = null; + return false; + } + return $bccdata; + break; + case 'get': + $bccdata = array(); + $all_items = array(); + $id = intval($_data); + try { + $stmt = $pdo->query("SELECT `id`, `domain` FROM `bcc_maps`"); + $all_items = $stmt->fetchAll(PDO::FETCH_ASSOC); + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + foreach ($all_items as $i) { + if (hasDomainAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $i['domain'])) { + $bccdata[] = $i['id']; + } + } + $all_items = null; + return $bccdata; + break; + case 'delete': + $ids = (array)$_data['id']; + foreach ($ids as $id) { + if (!is_numeric($id)) { + return false; + } + try { + $stmt = $pdo->prepare("SELECT `domain` FROM `bcc_maps` WHERE id = :id"); + $stmt->execute(array(':id' => $id)); + $domain = $stmt->fetch(PDO::FETCH_ASSOC)['domain']; + if (!hasDomainAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $domain)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + $stmt = $pdo->prepare("DELETE FROM `bcc_maps` WHERE `id`= :id"); + $stmt->execute(array(':id' => $id)); + } + catch (PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => 'Deleted BCC map id/s ' . implode(', ', $ids) + ); + return true; + break; + } +} \ No newline at end of file diff --git a/data/web/inc/functions.customize.inc.php b/data/web/inc/functions.customize.inc.php index 167647fc..e3d8c64d 100644 --- a/data/web/inc/functions.customize.inc.php +++ b/data/web/inc/functions.customize.inc.php @@ -1,5 +1,4 @@ 'danger', - 'msg' => 'Cannot validate image file: Temporary file not found' + 'msg' => $lang['danger']['img_tmp_missing'] ); return false; } @@ -27,7 +26,7 @@ function customize($_action, $_item, $_data = null) { if ($image->valid() !== true) { $_SESSION['return'] = array( 'type' => 'danger', - 'msg' => 'Cannot validate image file' + 'msg' => $lang['danger']['img_invalid'] ); return false; } @@ -36,7 +35,7 @@ function customize($_action, $_item, $_data = null) { catch (ImagickException $e) { $_SESSION['return'] = array( 'type' => 'danger', - 'msg' => 'Cannot validate image file' + 'msg' => $lang['danger']['img_invalid'] ); return false; } @@ -44,7 +43,7 @@ function customize($_action, $_item, $_data = null) { else { $_SESSION['return'] = array( 'type' => 'danger', - 'msg' => 'Invalid mime type' + 'msg' => $lang['danger']['invalid_mime_type'] ); return false; } @@ -60,7 +59,7 @@ function customize($_action, $_item, $_data = null) { } $_SESSION['return'] = array( 'type' => 'success', - 'msg' => 'File uploaded successfully' + 'msg' => $lang['success']['upload_success'] ); break; } @@ -78,7 +77,7 @@ function customize($_action, $_item, $_data = null) { $apps = (array)$_data['app']; $links = (array)$_data['href']; $out = array(); - if (count($apps) == count($links)) {; + if (count($apps) == count($links)) { for ($i = 0; $i < count($apps); $i++) { $out[] = array($apps[$i] => $links[$i]); } @@ -95,7 +94,28 @@ function customize($_action, $_item, $_data = null) { } $_SESSION['return'] = array( 'type' => 'success', - 'msg' => 'Saved changes to app links' + 'msg' => $lang['success']['app_links'] + ); + break; + case 'ui_texts': + $main_name = $_data['main_name']; + $apps_name = $_data['apps_name']; + $help_text = $_data['help_text']; + try { + $redis->set('MAIN_NAME', htmlspecialchars($main_name)); + $redis->set('APPS_NAME', htmlspecialchars($apps_name)); + $redis->set('HELP_TEXT', $help_text); + } + catch (RedisException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Redis: '.$e + ); + return false; + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => $lang['success']['ui_texts'] ); break; } @@ -114,7 +134,7 @@ function customize($_action, $_item, $_data = null) { if ($redis->del('MAIN_LOGO')) { $_SESSION['return'] = array( 'type' => 'success', - 'msg' => 'Reset default logo' + 'msg' => $lang['success']['reset_main_logo'] ); return true; } @@ -156,6 +176,21 @@ function customize($_action, $_item, $_data = null) { return false; } break; + case 'ui_texts': + try { + $data['main_name'] = ($main_name = $redis->get('MAIN_NAME')) ? $main_name : 'mailcow UI'; + $data['apps_name'] = ($apps_name = $redis->get('APPS_NAME')) ? $apps_name : 'mailcow Apps'; + $data['help_text'] = ($help_text = $redis->get('HELP_TEXT')) ? $help_text : false; + return $data; + } + catch (RedisException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Redis: '.$e + ); + return false; + } + break; case 'main_logo_specs': try { $image = new Imagick(); @@ -168,7 +203,7 @@ function customize($_action, $_item, $_data = null) { catch (ImagickException $e) { $_SESSION['return'] = array( 'type' => 'danger', - 'msg' => 'Error: Imagick exception while reading image' + 'msg' => $lang['danger']['imagick_exception'] ); return false; } diff --git a/data/web/inc/functions.docker.inc.php b/data/web/inc/functions.docker.inc.php index a5f2581c..fed2e1d1 100644 --- a/data/web/inc/functions.docker.inc.php +++ b/data/web/inc/functions.docker.inc.php @@ -1,5 +1,12 @@ 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } $curl = curl_init(); curl_setopt($curl, CURLOPT_HTTPHEADER,array( 'Content-Type: application/json' )); switch($action) { @@ -53,13 +60,16 @@ function docker($service_name, $action, $post_action = null, $post_fields = null } break; case 'post': - if (!empty($post_action)) { + if (!empty($attr1)) { $container_id = docker($service_name, 'get_id'); - if (ctype_xdigit($container_id) && ctype_alnum($post_action)) { - curl_setopt($curl, CURLOPT_URL, 'http://dockerapi:8080/containers/' . $container_id . '/' . $post_action); + if (ctype_xdigit($container_id) && ctype_alnum($attr1)) { + curl_setopt($curl, CURLOPT_URL, 'http://dockerapi:8080/containers/' . $container_id . '/' . $attr1); curl_setopt($curl, CURLOPT_POST, 1); - if (!empty($post_fields)) { - curl_setopt( $curl, CURLOPT_POSTFIELDS, json_encode($post_fields)); + if (!empty($attr2)) { + curl_setopt($curl, CURLOPT_POSTFIELDS, json_encode($attr2)); + } + if (!empty($extra_headers) && is_array($extra_headers)) { + curl_setopt($curl, CURLOPT_HTTPHEADER, $extra_headers); } curl_setopt($curl, CURLOPT_RETURNTRANSFER, 1); $response = curl_exec($curl); diff --git a/data/web/inc/functions.fail2ban.inc.php b/data/web/inc/functions.fail2ban.inc.php index 44e4e5b4..e1801be7 100644 --- a/data/web/inc/functions.fail2ban.inc.php +++ b/data/web/inc/functions.fail2ban.inc.php @@ -95,4 +95,4 @@ function fail2ban($_action, $_data = null) { ); break; } -} \ No newline at end of file +} diff --git a/data/web/inc/functions.inc.php b/data/web/inc/functions.inc.php index 1ba9e644..20d82a92 100644 --- a/data/web/inc/functions.inc.php +++ b/data/web/inc/functions.inc.php @@ -75,15 +75,15 @@ function generate_tlsa_digest($hostname, $port, $starttls = null) { } if (empty($starttls)) { $context = stream_context_create(array("ssl" => array("capture_peer_cert" => true, 'verify_peer' => false, 'allow_self_signed' => true))); - $stream = stream_socket_client('tls://' . $hostname . ':' . $port, $error_nr, $error_msg, 5, STREAM_CLIENT_CONNECT, $context); - // error_nr can be 0, so checking against error_msg - if ($error_msg) { + $stream = stream_socket_client('ssl://' . $hostname . ':' . $port, $error_nr, $error_msg, 5, STREAM_CLIENT_CONNECT, $context); + if (!$stream) { + $error_msg = isset($error_msg) ? $error_msg : '-'; return $error_nr . ': ' . $error_msg; } } else { $stream = stream_socket_client('tcp://' . $hostname . ':' . $port, $error_nr, $error_msg, 5); - if ($error_msg) { + if (!$stream) { return $error_nr . ': ' . $error_msg; } $banner = fread($stream, 512 ); @@ -443,14 +443,31 @@ function user_get_alias_details($username) { } try { $data['address'] = $username; - $stmt = $pdo->prepare("SELECT IFNULL(GROUP_CONCAT(`address` SEPARATOR ', '), '✘') AS `aliases` FROM `alias` + $stmt = $pdo->prepare("SELECT IFNULL(GROUP_CONCAT(`address` SEPARATOR ', '), '✘') AS `shared_aliases` FROM `alias` WHERE `goto` REGEXP :username_goto AND `address` NOT LIKE '@%' + AND `goto` != :username_goto2 AND `address` != :username_address"); - $stmt->execute(array(':username_goto' => '(^|,)'.$username.'($|,)', ':username_address' => $username)); + $stmt->execute(array( + ':username_goto' => '(^|,)'.$username.'($|,)', + ':username_goto2' => $username, + ':username_address' => $username + )); $run = $stmt->fetchAll(PDO::FETCH_ASSOC); while ($row = array_shift($run)) { - $data['aliases'] = $row['aliases']; + $data['shared_aliases'] = $row['shared_aliases']; + } + $stmt = $pdo->prepare("SELECT IFNULL(GROUP_CONCAT(`address` SEPARATOR ', '), '✘') AS `direct_aliases` FROM `alias` + WHERE `goto` = :username_goto + AND `address` != :username_address"); + $stmt->execute( + array( + ':username_goto' => $username, + ':username_address' => $username + )); + $run = $stmt->fetchAll(PDO::FETCH_ASSOC); + while ($row = array_shift($run)) { + $data['direct_aliases'] = $row['direct_aliases']; } $stmt = $pdo->prepare("SELECT IFNULL(GROUP_CONCAT(local_part, '@', alias_domain SEPARATOR ', '), '✘') AS `ad_alias` FROM `mailbox` LEFT OUTER JOIN `alias_domain` on `target_domain` = `domain` @@ -466,7 +483,7 @@ function user_get_alias_details($username) { while ($row = array_shift($run)) { $data['aliases_also_send_as'] = $row['send_as']; } - $stmt = $pdo->prepare("SELECT IFNULL(GROUP_CONCAT(`send_as` SEPARATOR ', '), '✘') AS `send_as` FROM `sender_acl` WHERE `logged_in_as` = :username AND `send_as` LIKE '@%';"); + $stmt = $pdo->prepare("SELECT IFNULL(CONCAT(GROUP_CONCAT(DISTINCT `send_as` SEPARATOR ', '), ', ', GROUP_CONCAT(DISTINCT CONCAT('@',`alias_domain`) SEPARATOR ', ')), '✘') AS `send_as` FROM `sender_acl` LEFT JOIN `alias_domain` ON `alias_domain`.`target_domain` = TRIM(LEADING '@' FROM `send_as`) WHERE `logged_in_as` = :username AND `send_as` LIKE '@%';"); $stmt->execute(array(':username' => $username)); $run = $stmt->fetchAll(PDO::FETCH_ASSOC); while ($row = array_shift($run)) { @@ -851,6 +868,135 @@ function verify_tfa_login($username, $token) { } return false; } +function admin_api($action, $data = null) { + global $pdo; + global $lang; + if ($_SESSION['mailcow_cc_role'] != "admin") { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + switch ($action) { + case "edit": + $regen_key = $data['admin_api_regen_key']; + $active = (isset($data['active'])) ? 1 : 0; + $allow_from = array_map('trim', preg_split( "/( |,|;|\n)/", $data['allow_from'])); + foreach ($allow_from as $key => $val) { + if (!filter_var($val, FILTER_VALIDATE_IP)) { + unset($allow_from[$key]); + continue; + } + } + $allow_from = implode(',', array_unique(array_filter($allow_from))); + if (empty($allow_from)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'List of allowed IPs cannot be empty' + ); + return false; + } + $api_key = implode('-', array( + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))) + )); + $stmt = $pdo->prepare("INSERT INTO `api` (`username`, `api_key`, `active`, `allow_from`) + SELECT `username`, :api_key, :active, :allow_from FROM `admin` WHERE `superadmin`='1' AND `active`='1' + ON DUPLICATE KEY UPDATE `active` = :active_u, `allow_from` = :allow_from_u ;"); + $stmt->execute(array( + ':api_key' => $api_key, + ':active' => $active, + ':active_u' => $active, + ':allow_from' => $allow_from, + ':allow_from_u' => $allow_from + )); + break; + case "regen_key": + $api_key = implode('-', array( + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))), + strtoupper(bin2hex(random_bytes(3))) + )); + $stmt = $pdo->prepare("UPDATE `api` SET `api_key` = :api_key WHERE `username` IN + (SELECT `username` FROM `admin` WHERE `superadmin`='1' AND `active`='1')"); + $stmt->execute(array( + ':api_key' => $api_key + )); + break; + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => sprintf($lang['success']['admin_modified']) + ); +} +function rspamd_ui($action, $data = null) { + global $lang; + if ($_SESSION['mailcow_cc_role'] != "admin") { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + switch ($action) { + case "edit": + $rspamd_ui_pass = $data['rspamd_ui_pass']; + $rspamd_ui_pass2 = $data['rspamd_ui_pass2']; + if (empty($rspamd_ui_pass) || empty($rspamd_ui_pass2)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Password cannot be empty' + ); + return false; + } + if ($rspamd_ui_pass != $rspamd_ui_pass2) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Passwords do not match' + ); + return false; + } + if (strlen($rspamd_ui_pass) < 6) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Please use at least 6 characters for your password' + ); + return false; + } + $docker_return = docker('rspamd-mailcow', 'post', 'exec', array('cmd' => 'worker_password', 'raw' => $rspamd_ui_pass), array('Content-Type: application/json')); + if ($docker_return_array = json_decode($docker_return, true)) { + if ($docker_return_array['type'] == 'success') { + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => 'Rspamd UI password set successfully' + ); + return true; + } + else { + $_SESSION['return'] = array( + 'type' => $docker_return_array['type'], + 'msg' => $docker_return_array['msg'] + ); + return false; + } + } + else { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Unknown error' + ); + return false; + } + break; + } + +} function get_admin_details() { // No parameter to be given, only one admin should exist global $pdo; @@ -860,8 +1006,10 @@ function get_admin_details() { return false; } try { - $stmt = $pdo->prepare("SELECT `username`, `modified`, `created` FROM `admin` WHERE `superadmin`='1' AND active='1'"); - $stmt->execute(); + $stmt = $pdo->query("SELECT `admin`.`username`, `api`.`active` AS `api_active`, `api`.`api_key`, `api`.`allow_from` FROM `admin` + INNER JOIN `api` ON `admin`.`username` = `api`.`username` + WHERE `admin`.`superadmin`='1' + AND `admin`.`active`='1'"); $data = $stmt->fetch(PDO::FETCH_ASSOC); } catch(PDOException $e) { @@ -932,6 +1080,51 @@ function get_logs($container, $lines = false) { return $data_array; } } + if ($container == "watchdog-mailcow") { + if (!is_numeric($lines)) { + list ($from, $to) = explode('-', $lines); + $data = $redis->lRange('WATCHDOG_LOG', intval($from), intval($to)); + } + else { + $data = $redis->lRange('WATCHDOG_LOG', 0, intval($lines)); + } + if ($data) { + foreach ($data as $json_line) { + $data_array[] = json_decode($json_line, true); + } + return $data_array; + } + } + if ($container == "acme-mailcow") { + if (!is_numeric($lines)) { + list ($from, $to) = explode('-', $lines); + $data = $redis->lRange('ACME_LOG', intval($from), intval($to)); + } + else { + $data = $redis->lRange('ACME_LOG', 0, intval($lines)); + } + if ($data) { + foreach ($data as $json_line) { + $data_array[] = json_decode($json_line, true); + } + return $data_array; + } + } + if ($container == "api-mailcow") { + if (!is_numeric($lines)) { + list ($from, $to) = explode('-', $lines); + $data = $redis->lRange('API_LOG', intval($from), intval($to)); + } + else { + $data = $redis->lRange('API_LOG', 0, intval($lines)); + } + if ($data) { + foreach ($data as $json_line) { + $data_array[] = json_decode($json_line, true); + } + return $data_array; + } + } if ($container == "fail2ban-mailcow") { if (!is_numeric($lines)) { list ($from, $to) = explode('-', $lines); diff --git a/data/web/inc/functions.mailbox.inc.php b/data/web/inc/functions.mailbox.inc.php index 654f8972..77512fa0 100644 --- a/data/web/inc/functions.mailbox.inc.php +++ b/data/web/inc/functions.mailbox.inc.php @@ -490,9 +490,20 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { if (in_array($address, $gotos)) { continue; } + $domain = idn_to_ascii(substr(strstr($address, '@'), 1)); + $local_part = strstr($address, '@', true); + $address = $local_part.'@'.$domain; $stmt = $pdo->prepare("SELECT `address` FROM `alias` - WHERE `address`= :address"); - $stmt->execute(array(':address' => $address)); + WHERE `address`= :address OR `address` IN ( + SELECT `username` FROM `mailbox`, `alias_domain` + WHERE ( + `alias_domain`.`alias_domain` = :address_d + AND `mailbox`.`username` = CONCAT(:address_l, '@', alias_domain.target_domain)))"); + $stmt->execute(array( + ':address' => $address, + ':address_l' => $local_part, + ':address_d' => $domain + )); $num_results = count($stmt->fetchAll(PDO::FETCH_ASSOC)); if ($num_results != 0) { $_SESSION['return'] = array( @@ -501,9 +512,6 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { ); return false; } - $domain = idn_to_ascii(substr(strstr($address, '@'), 1)); - $local_part = strstr($address, '@', true); - $address = $local_part.'@'.$domain; $domaindata = mailbox('get', 'domain_details', $domain); if (is_array($domaindata) && $domaindata['aliases_left'] == "0") { $_SESSION['return'] = array( @@ -722,7 +730,7 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { } $active = intval($_data['active']); $quota_b = ($quota_m * 1048576); - $maildir = $domain."/".$local_part."/"; + $maildir = $domain . "/" . $local_part . "/"; if (!is_valid_domain_name($domain)) { $_SESSION['return'] = array( 'type' => 'danger', @@ -1405,7 +1413,7 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { $subfolder2 = (isset($_data['subfolder2'])) ? $_data['subfolder2'] : $is_now['subfolder2']; $enc1 = (!empty($_data['enc1'])) ? $_data['enc1'] : $is_now['enc1']; $mins_interval = (!empty($_data['mins_interval'])) ? $_data['mins_interval'] : $is_now['mins_interval']; - $exclude = (!empty($_data['exclude'])) ? $_data['exclude'] : ''; + $exclude = (!empty($_data['exclude'])) ? $_data['exclude'] : $is_now['exclude']; $maxage = (isset($_data['maxage']) && $_data['maxage'] != "") ? intval($_data['maxage']) : $is_now['maxage']; } else { @@ -2302,7 +2310,7 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { } else { try { - $stmt = $pdo->prepare("SELECT `username` FROM `mailbox` WHERE `kind` NOT REGEXP 'location|thing|group' AND `domain` IN (SELECT `domain` FROM `domain_admins` WHERE `active` = '1' AND `username` = :username) OR 'admin' = :role"); + $stmt = $pdo->prepare("SELECT `username` FROM `mailbox` WHERE `kind` NOT REGEXP 'location|thing|group' AND (`domain` IN (SELECT `domain` FROM `domain_admins` WHERE `active` = '1' AND `username` = :username) OR 'admin' = :role)"); $stmt->execute(array( ':username' => $_SESSION['mailcow_cc_username'], ':role' => $_SESSION['mailcow_cc_role'], @@ -3103,10 +3111,6 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { } foreach ($ids as $id) { if (!is_numeric($id)) { - $_SESSION['return'] = array( - 'type' => 'danger', - 'msg' => $id - ); return false; } try { @@ -3154,10 +3158,6 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { } foreach ($ids as $id) { if (!is_numeric($id)) { - $_SESSION['return'] = array( - 'type' => 'danger', - 'msg' => $id - ); return false; } try { @@ -3366,6 +3366,10 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { $stmt->execute(array( ':domain' => '%@'.$domain, )); + $stmt = $pdo->prepare("DELETE FROM `bcc_maps` WHERE `local_dest` = :domain"); + $stmt->execute(array( + ':domain' => $domain, + )); } catch (PDOException $e) { $_SESSION['return'] = array( @@ -3486,6 +3490,10 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { $stmt->execute(array( ':alias_domain' => $alias_domain, )); + $stmt = $pdo->prepare("DELETE FROM `bcc_maps` WHERE `local_dest` = :alias_domain"); + $stmt->execute(array( + ':alias_domain' => $alias_domain, + )); } catch (PDOException $e) { $_SESSION['return'] = array( @@ -3580,6 +3588,10 @@ function mailbox($_action, $_type, $_data = null, $attr = null) { $stmt->execute(array( ':username' => $username )); + $stmt = $pdo->prepare("DELETE FROM `bcc_maps` WHERE `local_dest` = :username"); + $stmt->execute(array( + ':username' => $username + )); $stmt = $pdo->prepare("SELECT `address`, `goto` FROM `alias` WHERE `goto` REGEXP :username"); $stmt->execute(array(':username' => '(^|,)'.$username.'($|,)')); diff --git a/data/web/inc/functions.quarantaine.inc.php b/data/web/inc/functions.quarantaine.inc.php new file mode 100644 index 00000000..9b55e4e7 --- /dev/null +++ b/data/web/inc/functions.quarantaine.inc.php @@ -0,0 +1,282 @@ + 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + foreach ($ids as $id) { + if (!is_numeric($id)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + try { + $stmt = $pdo->prepare('SELECT `rcpt` FROM `quarantaine` WHERE `id` = :id'); + $stmt->execute(array(':id' => $id)); + $row = $stmt->fetch(PDO::FETCH_ASSOC); + if (hasMailboxObjectAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $row['rcpt'])) { + try { + $stmt = $pdo->prepare("DELETE FROM `quarantaine` WHERE `id` = :id"); + $stmt->execute(array( + ':id' => $id + )); + } + catch (PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + } + else { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + } + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => sprintf($lang['success']['items_deleted'], implode(', ', $ids)) + ); + break; + case 'edit': + if (!isset($_SESSION['acl']['quarantaine']) || $_SESSION['acl']['quarantaine'] != "1" ) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + // Edit settings + if ($_data['action'] == 'settings') { + if ($_SESSION['mailcow_cc_role'] != "admin") { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + $retention_size = $_data['retention_size']; + $max_size = $_data['max_size']; + $exclude_domains = (array)$_data['exclude_domains']; + try { + $redis->Set('Q_RETENTION_SIZE', intval($retention_size)); + $redis->Set('Q_MAX_SIZE', intval($max_size)); + $redis->Set('Q_EXCLUDE_DOMAINS', json_encode($exclude_domains)); + } + catch (RedisException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Redis: '.$e + ); + return false; + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => 'Saved settings' + ); + } + // Release item + elseif ($_data['action'] == 'release') { + if (!is_array($_data['id'])) { + $ids = array(); + $ids[] = $_data['id']; + } + else { + $ids = $_data['id']; + } + foreach ($ids as $id) { + if (!is_numeric($id)) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + try { + $stmt = $pdo->prepare('SELECT `msg`, `qid`, `sender`, `rcpt` FROM `quarantaine` WHERE `id` = :id'); + $stmt->execute(array(':id' => $id)); + $row = $stmt->fetch(PDO::FETCH_ASSOC); + if (!hasMailboxObjectAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $row['rcpt'])) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + } + $sender = (isset($row['sender'])) ? $row['sender'] : 'sender-unknown@rspamd'; + try { + $mail = new PHPMailer(true); + $mail->isSMTP(); + $mail->SMTPDebug = 0; + $mail->SMTPOptions = array( + 'ssl' => array( + 'verify_peer' => false, + 'verify_peer_name' => false, + 'allow_self_signed' => true + ) + ); + if (!empty(gethostbynamel('postfix-mailcow'))) { + $postfix = 'postfix-mailcow'; + } + if (!empty(gethostbynamel('postfix'))) { + $postfix = 'postfix'; + } + else { + $_SESSION['return'] = array( + 'type' => 'warning', + 'msg' => sprintf($lang['danger']['release_send_failed'], 'Cannot determine Postfix host') + ); + return false; + } + $mail->Host = $postfix; + $mail->Port = 590; + $mail->setFrom($sender); + $mail->CharSet = 'UTF-8'; + $mail->Subject = sprintf($lang['quarantaine']['release_subject'], $row['qid']); + $mail->addAddress($row['rcpt']); + $mail->IsHTML(false); + $msg_tmpf = tempnam("/tmp", $row['qid']); + file_put_contents($msg_tmpf, $row['msg']); + $mail->addAttachment($msg_tmpf, $row['qid'] . '.eml'); + $mail->Body = sprintf($lang['quarantaine']['release_body']); + $mail->send(); + unlink($msg_tmpf); + } + catch (phpmailerException $e) { + unlink($msg_tmpf); + $_SESSION['return'] = array( + 'type' => 'warning', + 'msg' => sprintf($lang['danger']['release_send_failed'], $e->errorMessage()) + ); + return false; + } + try { + $stmt = $pdo->prepare("DELETE FROM `quarantaine` WHERE `id` = :id"); + $stmt->execute(array( + ':id' => $id + )); + } + catch (PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + return false; + } + } + $_SESSION['return'] = array( + 'type' => 'success', + 'msg' => $lang['success']['items_released'] + ); + } + return true; + break; + case 'get': + try { + if ($_SESSION['mailcow_cc_role'] == "user") { + $stmt = $pdo->prepare('SELECT `id`, `qid`, `rcpt`, `sender`, UNIX_TIMESTAMP(`created`) AS `created` FROM `quarantaine` WHERE `rcpt` = :mbox'); + $stmt->execute(array(':mbox' => $_SESSION['mailcow_cc_username'])); + $rows = $stmt->fetchAll(PDO::FETCH_ASSOC); + while($row = array_shift($rows)) { + $q_meta[] = $row; + } + } + else { + foreach (mailbox('get', 'mailboxes') as $mbox) { + $stmt = $pdo->prepare('SELECT `id`, `qid`, `rcpt`, `sender`, UNIX_TIMESTAMP(`created`) AS `created` FROM `quarantaine` WHERE `rcpt` = :mbox'); + $stmt->execute(array(':mbox' => $mbox)); + $rows = $stmt->fetchAll(PDO::FETCH_ASSOC); + while($row = array_shift($rows)) { + $q_meta[] = $row; + } + } + } + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + } + return $q_meta; + break; + case 'settings': + if ($_SESSION['mailcow_cc_role'] != "admin") { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => sprintf($lang['danger']['access_denied']) + ); + return false; + } + try { + $settings['exclude_domains'] = json_decode($redis->Get('Q_EXCLUDE_DOMAINS'), true); + $settings['max_size'] = $redis->Get('Q_MAX_SIZE'); + $settings['retention_size'] = $redis->Get('Q_RETENTION_SIZE'); + } + catch (RedisException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'Redis: '.$e + ); + return false; + } + return $settings; + break; + case 'details': + if (!is_numeric($_data) || empty($_data)) { + return false; + } + try { + $stmt = $pdo->prepare('SELECT `rcpt`, `symbols`, `msg`, `domain` FROM `quarantaine` WHERE `id`= :id'); + $stmt->execute(array(':id' => $_data)); + $row = $stmt->fetch(PDO::FETCH_ASSOC); + if (hasMailboxObjectAccess($_SESSION['mailcow_cc_username'], $_SESSION['mailcow_cc_role'], $row['rcpt'])) { + return $row; + } + return false; + } + catch(PDOException $e) { + $_SESSION['return'] = array( + 'type' => 'danger', + 'msg' => 'MySQL: '.$e + ); + } + return false; + break; + } +} \ No newline at end of file diff --git a/data/web/inc/functions.relayhost.inc.php b/data/web/inc/functions.relayhost.inc.php index 233ca0ad..e6722258 100644 --- a/data/web/inc/functions.relayhost.inc.php +++ b/data/web/inc/functions.relayhost.inc.php @@ -56,8 +56,8 @@ function relayhost($_action, $_data = null) { $is_now = relayhost('details', $id); if (!empty($is_now)) { $hostname = (!empty($_data['hostname'])) ? trim($_data['hostname']) : $is_now['hostname']; - $username = (!empty($_data['username'])) ? trim($_data['username']) : $is_now['username']; - $password = (!empty($_data['password'])) ? trim($_data['password']) : $is_now['password']; + $username = (isset($_data['username'])) ? trim($_data['username']) : $is_now['username']; + $password = (isset($_data['password'])) ? trim($_data['password']) : $is_now['password']; $active = (isset($_data['active'])) ? intval($_data['active']) : $is_now['active_int']; } else { diff --git a/data/web/inc/header.inc.php b/data/web/inc/header.inc.php index cedd07ca..c8dbe4b1 100644 --- a/data/web/inc/header.inc.php +++ b/data/web/inc/header.inc.php @@ -15,6 +15,7 @@ + @@ -27,6 +28,8 @@ ' : null; ?> ' : null; ?> ' : null; ?> +' : null; ?> +' : null; ?> @@ -35,7 +38,6 @@
+
+
+
+

+
+

+
+
+
+
+
+ + + + +
+
+
+
diff --git a/data/web/modals/admin.php b/data/web/modals/admin.php index bf17296c..3a387540 100644 --- a/data/web/modals/admin.php +++ b/data/web/modals/admin.php @@ -13,7 +13,7 @@ if (!isset($_SESSION['mailcow_cc_role'])) {