git subrepo commit (merge) mailcow/src/mailcow-dockerized
subrepo: subdir: "mailcow/src/mailcow-dockerized"
merged: "02ae5285"
upstream: origin: "https://github.com/mailcow/mailcow-dockerized.git"
branch: "master"
commit: "649a5c01"
git-subrepo: version: "0.4.3"
origin: "???"
commit: "???"
Change-Id: I870ad468fba026cc5abf3c5699ed1e12ff28b32b
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/Dockerfile b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/Dockerfile
index 219dd14..1990097 100644
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/Dockerfile
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/Dockerfile
@@ -2,8 +2,9 @@
LABEL maintainer "Andre Peters <andre.peters@servercow.de>"
ARG DEBIAN_FRONTEND=noninteractive
-ARG DOVECOT=2.3.13
+ARG DOVECOT=2.3.14.1
ENV LC_ALL C
+ENV GOSU_VERSION 1.12
# Add groups and users before installing Dovecot to not break compatibility
RUN groupadd -g 5000 vmail \
@@ -20,7 +21,6 @@
apt-transport-https \
ca-certificates \
cpanminus \
- cron \
curl \
dnsutils \
dirmngr \
@@ -74,6 +74,7 @@
liburi-perl \
libwww-perl \
lua-sql-mysql \
+ lua-socket \
mariadb-client \
procps \
python3-pip \
@@ -82,6 +83,11 @@
syslog-ng \
syslog-ng-core \
syslog-ng-mod-redis \
+ wget \
+ && dpkgArch="$(dpkg --print-architecture | awk -F- '{ print $NF }')" \
+ && wget -O /usr/local/bin/gosu "https://github.com/tianon/gosu/releases/download/$GOSU_VERSION/gosu-$dpkgArch" \
+ && chmod +x /usr/local/bin/gosu \
+ && gosu nobody true \
&& apt-key adv --fetch-keys https://repo.dovecot.org/DOVECOT-REPO-GPG \
&& echo "deb https://repo.dovecot.org/ce-${DOVECOT}/debian/buster buster main" > /etc/apt/sources.list.d/dovecot.list \
&& apt-get update \
@@ -100,15 +106,14 @@
&& apt-get autoremove --purge -y \
&& apt-get autoclean \
&& rm -rf /var/lib/apt/lists/* \
- && rm -rf /tmp/* /var/tmp/* /etc/cron.daily/* /root/.cache/
+ && rm -rf /tmp/* /var/tmp/* /root/.cache/
COPY trim_logs.sh /usr/local/bin/trim_logs.sh
COPY clean_q_aged.sh /usr/local/bin/clean_q_aged.sh
COPY syslog-ng.conf /etc/syslog-ng/syslog-ng.conf
COPY syslog-ng-redis_slave.conf /etc/syslog-ng/syslog-ng-redis_slave.conf
COPY imapsync /usr/local/bin/imapsync
-COPY postlogin.sh /usr/local/bin/postlogin.sh
-COPY imapsync_cron.pl /usr/local/bin/imapsync_cron.pl
+COPY imapsync_runner.pl /usr/local/bin/imapsync_runner.pl
COPY report-spam.sieve /usr/lib/dovecot/sieve/report-spam.sieve
COPY report-ham.sieve /usr/lib/dovecot/sieve/report-ham.sieve
COPY rspamd-pipe-ham /usr/lib/dovecot/sieve/rspamd-pipe-ham
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/docker-entrypoint.sh b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/docker-entrypoint.sh
index 9c626fa..5ea1609 100755
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/docker-entrypoint.sh
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/docker-entrypoint.sh
@@ -7,7 +7,7 @@
sleep 2
done
-until dig +short mailcow.email @unbound > /dev/null; do
+until dig +short mailcow.email > /dev/null; do
echo "Waiting for DNS..."
sleep 1
done
@@ -60,14 +60,6 @@
}
EOF
-# Write last logins to Redis
-if [[ ! -z ${REDIS_SLAVEOF_IP} ]]; then
- cp /etc/syslog-ng/syslog-ng-redis_slave.conf /etc/syslog-ng/syslog-ng.conf
- echo -n "redis:host=${REDIS_SLAVEOF_IP}:port=${REDIS_SLAVEOF_PORT}" > /etc/dovecot/last_login
-else
- echo -n "redis:host=${IPV4_NETWORK}.249:port=6379" > /etc/dovecot/last_login
-fi
-
# Create dict used for sieve pre and postfilters
cat <<EOF > /etc/dovecot/sql/dovecot-dict-sql-sieve_before.conf
# Autogenerated by mailcow
@@ -118,13 +110,13 @@
echo -n ${ACL_ANYONE} > /etc/dovecot/acl_anyone
if [[ "${SKIP_SOLR}" =~ ^([yY][eE][sS]|[yY])+$ ]]; then
-echo -n 'quota acl zlib listescape mail_crypt mail_crypt_acl mail_log notify replication last_login' > /etc/dovecot/mail_plugins
-echo -n 'quota imap_quota imap_acl acl zlib imap_zlib imap_sieve listescape mail_crypt mail_crypt_acl notify replication mail_log last_login' > /etc/dovecot/mail_plugins_imap
-echo -n 'quota sieve acl zlib listescape mail_crypt mail_crypt_acl notify replication' > /etc/dovecot/mail_plugins_lmtp
+echo -n 'quota acl zlib mail_crypt mail_crypt_acl mail_log notify listescape replication' > /etc/dovecot/mail_plugins
+echo -n 'quota imap_quota imap_acl acl zlib imap_zlib imap_sieve mail_crypt mail_crypt_acl notify listescape replication mail_log' > /etc/dovecot/mail_plugins_imap
+echo -n 'quota sieve acl zlib mail_crypt mail_crypt_acl notify listescape replication' > /etc/dovecot/mail_plugins_lmtp
else
-echo -n 'quota acl zlib listescape mail_crypt mail_crypt_acl mail_log notify fts fts_solr replication last_login' > /etc/dovecot/mail_plugins
-echo -n 'quota imap_quota imap_acl acl zlib imap_zlib imap_sieve listescape mail_crypt mail_crypt_acl notify mail_log fts fts_solr replication last_login' > /etc/dovecot/mail_plugins_imap
-echo -n 'quota sieve acl zlib listescape mail_crypt mail_crypt_acl fts fts_solr notify replication' > /etc/dovecot/mail_plugins_lmtp
+echo -n 'quota acl zlib mail_crypt mail_crypt_acl mail_log notify fts fts_solr listescape replication' > /etc/dovecot/mail_plugins
+echo -n 'quota imap_quota imap_acl acl zlib imap_zlib imap_sieve mail_crypt mail_crypt_acl notify mail_log fts fts_solr listescape replication' > /etc/dovecot/mail_plugins_imap
+echo -n 'quota sieve acl zlib mail_crypt mail_crypt_acl fts fts_solr notify listescape replication' > /etc/dovecot/mail_plugins_lmtp
fi
chmod 644 /etc/dovecot/mail_plugins /etc/dovecot/mail_plugins_imap /etc/dovecot/mail_plugins_lmtp /templates/quarantine.tpl
@@ -136,36 +128,82 @@
iterate_query = SELECT username FROM mailbox WHERE active = '1' OR active = '2';
EOF
-# Create pass dict for Dovecot
-cat <<EOF > /etc/dovecot/sql/dovecot-dict-sql-passdb.conf
-# Autogenerated by mailcow
-driver = mysql
-connect = "host=/var/run/mysqld/mysqld.sock dbname=${DBNAME} user=${DBUSER} password=${DBPASS}"
-default_pass_scheme = ${MAILCOW_PASS_SCHEME}
-password_query = SELECT password FROM mailbox WHERE active = '1' AND username = '%u' AND domain IN (SELECT domain FROM domain WHERE domain='%d' AND active='1') AND JSON_UNQUOTE(JSON_VALUE(attributes, '$.force_pw_update')) != '1' AND (JSON_UNQUOTE(JSON_VALUE(attributes, '$.%s_access')) = '1' OR ('%s' != 'imap' AND '%s' != 'pop3'))
-EOF
-
-cat <<EOF > /etc/dovecot/lua/app-passdb.lua
+cat <<EOF > /etc/dovecot/lua/passwd-verify.lua
function auth_password_verify(req, pass)
+
if req.domain == nil then
return dovecot.auth.PASSDB_RESULT_USER_UNKNOWN, "No such user"
end
+
if cur == nil then
script_init()
end
- local cur,errorString = con:execute(string.format([[SELECT mailbox, password FROM app_passwd
- WHERE mailbox = '%s'
+
+ if req.user == nil then
+ req.user = ''
+ end
+
+ respbody = {}
+
+ -- check against mailbox passwds
+ local cur,errorString = con:execute(string.format([[SELECT password FROM mailbox
+ WHERE username = '%s'
AND active = '1'
- AND domain IN (SELECT domain FROM domain WHERE domain='%s' AND active='1')]], con:escape(req.user), con:escape(req.domain)))
+ AND domain IN (SELECT domain FROM domain WHERE domain='%s' AND active='1')
+ AND IFNULL(JSON_UNQUOTE(JSON_VALUE(mailbox.attributes, '$.force_pw_update')), 0) != '1'
+ AND IFNULL(JSON_UNQUOTE(JSON_VALUE(attributes, '$.%s_access')), 1) = '1']], con:escape(req.user), con:escape(req.domain), con:escape(req.service)))
local row = cur:fetch ({}, "a")
while row do
if req.password_verify(req, row.password, pass) == 1 then
cur:close()
+ con:execute(string.format([[REPLACE INTO sasl_log (service, app_password, username, real_rip)
+ VALUES ("%s", 0, "%s", "%s")]], con:escape(req.service), con:escape(req.user), con:escape(req.real_rip)))
return dovecot.auth.PASSDB_RESULT_OK, "password=" .. pass
end
row = cur:fetch (row, "a")
end
- return dovecot.auth.PASSDB_RESULT_USER_UNKNOWN, "No such user"
+
+ -- check against app passwds
+ local cur,errorString = con:execute(string.format([[SELECT app_passwd.id, app_passwd.password FROM app_passwd
+ INNER JOIN mailbox ON mailbox.username = app_passwd.mailbox
+ WHERE mailbox = '%s'
+ AND IFNULL(JSON_UNQUOTE(JSON_VALUE(mailbox.attributes, '$.%s_access')), 1) = '1'
+ AND IFNULL(JSON_UNQUOTE(JSON_VALUE(mailbox.attributes, '$.force_pw_update')), 0) != '1'
+ AND app_passwd.active = '1'
+ AND mailbox.active = '1'
+ AND app_passwd.domain IN (SELECT domain FROM domain WHERE domain='%s' AND active='1')]], con:escape(req.user), con:escape(req.service), con:escape(req.domain)))
+ local row = cur:fetch ({}, "a")
+ while row do
+ if req.password_verify(req, row.password, pass) == 1 then
+ cur:close()
+ con:execute(string.format([[REPLACE INTO sasl_log (service, app_password, username, real_rip)
+ VALUES ("%s", %d, "%s", "%s")]], con:escape(req.service), row.id, con:escape(req.user), con:escape(req.real_rip)))
+ return dovecot.auth.PASSDB_RESULT_OK, "password=" .. pass
+ end
+ row = cur:fetch (row, "a")
+ end
+
+ return dovecot.auth.PASSDB_RESULT_PASSWORD_MISMATCH, "Failed to authenticate"
+
+ -- PoC
+ -- local reqbody = string.format([[{
+ -- "success":0,
+ -- "service":"%s",
+ -- "app_password":false,
+ -- "username":"%s",
+ -- "real_rip":"%s"
+ -- }]], con:escape(req.service), con:escape(req.user), con:escape(req.real_rip))
+ -- http.request {
+ -- method = "POST",
+ -- url = "http://nginx:8081/sasl_log.php",
+ -- source = ltn12.source.string(reqbody),
+ -- headers = {
+ -- ["content-type"] = "application/json",
+ -- ["content-length"] = tostring(#reqbody)
+ -- },
+ -- sink = ltn12.sink.table(respbody)
+ -- }
+
end
function auth_passdb_lookup(req)
@@ -174,6 +212,9 @@
function script_init()
mysql = require "luasql.mysql"
+ http = require "socket.http"
+ http.TIMEOUT = 5
+ ltn12 = require "ltn12"
env = mysql.mysql()
con = env:connect("__DBNAME__","__DBUSER__","__DBPASS__","localhost")
return 0
@@ -185,6 +226,12 @@
end
EOF
+# Replace patterns in app-passdb.lua
+sed -i "s/__DBUSER__/${DBUSER}/g" /etc/dovecot/lua/passwd-verify.lua
+sed -i "s/__DBPASS__/${DBPASS}/g" /etc/dovecot/lua/passwd-verify.lua
+sed -i "s/__DBNAME__/${DBNAME}/g" /etc/dovecot/lua/passwd-verify.lua
+
+
# Migrate old sieve_after file
[[ -f /etc/dovecot/sieve_after ]] && mv /etc/dovecot/sieve_after /etc/dovecot/global_sieve_after
# Create global sieve scripts
@@ -199,6 +246,8 @@
# Cleanup random user maildirs
rm -rf /var/vmail/mailcow.local/*
+# Cleanup PIDs
+[[ -f /tmp/quarantine_notify.pid ]] && rm /tmp/quarantine_notify.pid
# create sni configuration
echo "" > /etc/dovecot/sni.conf
@@ -251,31 +300,20 @@
}
EOF
-if [[ "${ALLOW_ADMIN_EMAIL_LOGIN}" =~ ^([yY][eE][sS]|[yY])+$ ]]; then
- # Create random master Password for SOGo 'login as user' via proxy auth
- RAND_PASS=$(cat /dev/urandom | tr -dc 'a-z0-9' | fold -w 32 | head -n 1)
- echo -n ${RAND_PASS} > /etc/phpfpm/sogo-sso.pass
- cat <<EOF > /etc/dovecot/sogo-sso.conf
+# Create random master Password for SOGo SSO
+RAND_PASS=$(cat /dev/urandom | tr -dc 'a-z0-9' | fold -w 32 | head -n 1)
+echo -n ${RAND_PASS} > /etc/phpfpm/sogo-sso.pass
+cat <<EOF > /etc/dovecot/sogo-sso.conf
# Autogenerated by mailcow
passdb {
driver = static
args = allow_real_nets=${IPV4_NETWORK}.248/32 password={plain}${RAND_PASS}
}
EOF
-else
- rm -f /etc/dovecot/sogo-sso.pass
- rm -f /etc/dovecot/sogo-sso.conf
-fi
-# Hard-code env vars to scripts due to cron not passing them to the scripts
-sed -i "s/__DBUSER__/${DBUSER}/g" /usr/local/bin/imapsync_cron.pl /usr/local/bin/quarantine_notify.py /usr/local/bin/clean_q_aged.sh /etc/dovecot/lua/app-passdb.lua
-sed -i "s/__DBPASS__/${DBPASS}/g" /usr/local/bin/imapsync_cron.pl /usr/local/bin/quarantine_notify.py /usr/local/bin/clean_q_aged.sh /etc/dovecot/lua/app-passdb.lua
-sed -i "s/__DBNAME__/${DBNAME}/g" /usr/local/bin/imapsync_cron.pl /usr/local/bin/quarantine_notify.py /usr/local/bin/clean_q_aged.sh /etc/dovecot/lua/app-passdb.lua
-sed -i "s/__MAILCOW_HOSTNAME__/${MAILCOW_HOSTNAME}/g" /usr/local/bin/quarantine_notify.py
-sed -i "s/__LOG_LINES__/${LOG_LINES}/g" /usr/local/bin/trim_logs.sh
if [[ "${MASTER}" =~ ^([nN][oO]|[nN])+$ ]]; then
-# Toggling MASTER will result in a rebuild of containers, so the quota script will be recreated
-cat <<'EOF' > /usr/local/bin/quota_notify.py
+ # Toggling MASTER will result in a rebuild of containers, so the quota script will be recreated
+ cat <<'EOF' > /usr/local/bin/quota_notify.py
#!/usr/bin/python3
import sys
sys.exit()
@@ -299,8 +337,8 @@
# Fix permissions
chown root:root /etc/dovecot/sql/*.conf
-chown root:dovecot /etc/dovecot/sql/dovecot-dict-sql-sieve* /etc/dovecot/sql/dovecot-dict-sql-quota* /etc/dovecot/lua/app-passdb.lua
-chmod 640 /etc/dovecot/sql/*.conf /etc/dovecot/lua/app-passdb.lua
+chown root:dovecot /etc/dovecot/sql/dovecot-dict-sql-sieve* /etc/dovecot/sql/dovecot-dict-sql-quota* /etc/dovecot/lua/passwd-verify.lua
+chmod 640 /etc/dovecot/sql/*.conf /etc/dovecot/lua/passwd-verify.lua
chown -R vmail:vmail /var/vmail/sieve
chown -R vmail:vmail /var/volatile
chown -R vmail:vmail /var/vmail_index
@@ -309,8 +347,7 @@
chown root:tty /dev/console
chmod +x /usr/lib/dovecot/sieve/rspamd-pipe-ham \
/usr/lib/dovecot/sieve/rspamd-pipe-spam \
- /usr/local/bin/imapsync_cron.pl \
- /usr/local/bin/postlogin.sh \
+ /usr/local/bin/imapsync_runner.pl \
/usr/local/bin/imapsync \
/usr/local/bin/trim_logs.sh \
/usr/local/bin/sa-rules.sh \
@@ -320,27 +357,6 @@
/usr/local/bin/quota_notify.py \
/usr/local/bin/repl_health.sh
-if [[ "${MASTER}" =~ ^([yY][eE][sS]|[yY])+$ ]]; then
-# Setup cronjobs
-echo '* * * * * nobody /usr/local/bin/imapsync_cron.pl 2>&1 | /usr/bin/logger' > /etc/cron.d/imapsync
-#echo '30 3 * * * vmail /usr/local/bin/doveadm quota recalc -A' > /etc/cron.d/dovecot-sync
-echo '* * * * * vmail /usr/local/bin/trim_logs.sh >> /dev/console 2>&1' > /etc/cron.d/trim_logs
-echo '25 * * * * vmail /usr/local/bin/maildir_gc.sh >> /dev/console 2>&1' > /etc/cron.d/maildir_gc
-echo '30 1 * * * root /usr/local/bin/sa-rules.sh >> /dev/console 2>&1' > /etc/cron.d/sa-rules
-echo '0 2 * * * root /usr/bin/curl http://solr:8983/solr/dovecot-fts/update?optimize=true >> /dev/console 2>&1' > /etc/cron.d/solr-optimize
-echo '*/20 * * * * vmail /usr/local/bin/quarantine_notify.py >> /dev/console 2>&1' > /etc/cron.d/quarantine_notify
-echo '15 4 * * * vmail /usr/local/bin/clean_q_aged.sh >> /dev/console 2>&1' > /etc/cron.d/clean_q_aged
-echo '*/5 * * * * vmail /usr/local/bin/repl_health.sh >> /dev/console 2>&1' > /etc/cron.d/repl_health
-else
-echo '25 * * * * vmail /usr/local/bin/maildir_gc.sh >> /dev/console 2>&1' > /etc/cron.d/maildir_gc
-echo '30 1 * * * root /usr/local/bin/sa-rules.sh >> /dev/console 2>&1' > /etc/cron.d/sa-rules
-echo '0 2 * * * root /usr/bin/curl http://solr:8983/solr/dovecot-fts/update?optimize=true >> /dev/console 2>&1' > /etc/cron.d/solr-optimize
-echo '*/5 * * * * vmail /usr/local/bin/repl_health.sh >> /dev/console 2>&1' > /etc/cron.d/repl_health
-fi
-
-# Fix more than 1 hardlink issue
-touch /etc/crontab /etc/cron.*/*
-
# Prepare environment file for cronjobs
printenv | sed 's/^\(.*\)$/export \1/g' > /source_env.sh
@@ -391,6 +407,6 @@
# For some strange, unknown and stupid reason, Dovecot may run into a race condition, when this file is not touched before it is read by dovecot/auth
# May be related to something inside Docker, I seriously don't know
-touch /etc/dovecot/lua/app-passdb.lua
+touch /etc/dovecot/lua/passwd-verify.lua
exec "$@"
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync
index 4c941f4..07cf58e 100755
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync
@@ -1,6 +1,6 @@
#!/usr/bin/env perl
-# $Id: imapsync,v 1.977 2019/12/23 20:18:02 gilles Exp gilles $
+# $Id: imapsync,v 2.148 2021/07/22 14:21:09 gilles Exp gilles $
# structure
# pod documentation
# use pragmas
@@ -25,7 +25,7 @@
=head1 VERSION
-This documentation refers to Imapsync $Revision: 1.977 $
+This documentation refers to Imapsync $Revision: 2.148 $
=head1 USAGE
@@ -47,54 +47,82 @@
Imapsync command is a tool allowing incremental and
recursive imap transfers from one mailbox to another.
If you don't understand the previous sentence, it's normal,
-it's pedantic computer oriented jargon.
+it's pedantic computer-oriented jargon.
All folders are transferred, recursively, meaning
the whole folder hierarchy is taken, all messages in them,
-and all messages flags (\Seen \Answered \Flagged etc.)
+and all message flags (\Seen \Answered \Flagged etc.)
are synced too.
Imapsync reduces the amount of data transferred by not transferring
a given message if it already resides on the destination side.
Messages that are on the destination side but not on the
-source side stay as they are (see the --delete2
-option to have a strict sync).
+source side stay as they are. See the --delete2
+option to have strict sync and delete them.
-How imapsync knows a message is already on both sides?
+How imapsync know a message is already on both sides?
Same specific headers and the transfer is done only once.
By default, the identification headers are
"Message-Id:" and "Received:" lines
-but this choice can be changed with the --useheader option.
+but this choice can be changed with the --useheader option,
+most often a duplicate problem is solved by using
+--useheader "Message-Id"
+
All flags are preserved, unread messages will stay unread,
read ones will stay read, deleted will stay deleted.
+In the IMAP protocol, a deleted message is not really deleted,
+it is marked \Deleted and can be undelete. Real destruction
+comes with the EXPUNGE or UIDEXPUNGE IMAP commands.
You can abort the transfer at any time and restart it later,
imapsync works well with bad connections and interruptions,
by design. On a terminal hit Ctr-c twice within two seconds
-in order to abort the program. Hit Ctr-c just once makes
+to abort the program. Hit Ctr-c just once makes
imapsync reconnect to both imap servers.
+How do you know the sync is finished and well done?
+When imapsync ends by itself it mentions it with lines like those:
+
+ Exiting with return value 0 (EX_OK: successful termination) 0/50 nb_errors/max_errors PID 301
+ Removing pidfile /tmp/imapsync.pid
+ Log file is LOG_imapsync/2020_11_17_15_59_22_761_test1_test2.txt ( to change it, use --logfile filepath ; or use --nolog to turn off logging )
+
+If you don't have those lines it means that either the sync process is still
+running (or eventually hanging indefinitely) or that it ended without
+a whisper, a strong kill -9 on Linux for example.
+
+If you have those final lines then it means the sync process is properly
+finished. It may have encountered problems though.
+
+A good synchronization is mentioned by some lines above the last ones, especially
+those three lines:
+
+ The sync looks good, all 1745 identified messages in host1 are on host2.
+ There is no unidentified message on host1.
+ Detected 0 errors
+
+
A classical scenario is synchronizing a mailbox B from another mailbox A
where you just want to keep a strict copy of A in B. Strict meaning
all messages in A will be in B but no more.
-For this, option --delete2 has to be used, it deletes messages in host2
-folder B that are not in host1 folder A. If you also need to destroy
+For this, option --delete2 can be used, it deletes messages in the host2
+folder B that are not in the host1 folder A. If you also need to destroy
host2 folders that are not in host1 then use --delete2folders. See also
--delete2foldersonly and --delete2foldersbutnot to set up exceptions
-on folders to destroy. INBOX will never be destroy, it's a mandatory
-folder in IMAP.
+on folders to destroy. INBOX will never be destroyed, it's a mandatory
+folder in IMAP so imapsync doesn't even try to remove it.
A different scenario is to delete the messages from the source mailbox
after a successful transfer, it can be a good feature when migrating
mailboxes since messages will be only on one side. The source account
will only have messages that are not on the destination yet, ie,
-messages that arrived after a sync or that failed to be copied.
+messages that arrived after a sync or that failed to be transferred.
In that case, use the --delete1 option. Option --delete1 implies also
-option --expunge1 so all messages marked deleted on host1 will be really
-deleted. In IMAP protocol deleting a message does not really delete it,
+the option --expunge1 so all messages marked deleted on host1 will be
+deleted. In IMAP protocol deleting a message does not delete it,
it marks it with the flag \Deleted, allowing an undelete. Expunging
a folder removes, definitively, all the messages marked as \Deleted
in this folder.
@@ -115,17 +143,18 @@
usage: imapsync [options]
The standard options are the six values forming the credentials.
-Three values on each side are needed in order to log in into the IMAP
-servers. These six values are a host, a username, and a password, two times.
+Three values on each side are needed in order to login into the IMAP
+servers. These six values are a hostname, a username, and a password, two times.
Conventions used in the following descriptions of the options:
str means string
- int means integer
+ int means integer number
+ flo means float number
reg means regular expression
cmd means command
- --dry : Makes imapsync doing nothing for real, just print what
+ --dry : Makes imapsync doing nothing for real; it just print what
would be done without --dry.
=head2 OPTIONS/credentials
@@ -136,18 +165,18 @@
Optional since default ports are the
well known ports imap/143 or imaps/993.
--user1 str : User to login on host1.
- --password1 str : Password for the user1.
+ --password1 str : Password of user1.
--host2 str : "destination" imap server.
--port2 int : Port to connect on host2. Optional
--user2 str : User to login on host2.
- --password2 str : Password for the user2.
+ --password2 str : Password of user2.
--showpasswords : Shows passwords on output instead of "MASKED".
Useful to restart a complete run by just reading
the command line used in the log,
or to debug passwords.
- It's not a secure practice at all.
+ It's not a secure practice at all!
--passfile1 str : Password file for the user1. It must contain the
password on the first line. This option avoids showing
@@ -155,7 +184,10 @@
--passfile2 str : Password file for the user2.
You can also pass the passwords in the environment variables
-IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2
+IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2. If you don't pass
+the user1 password via --password1 nor --passfile1 nor $IMAPSYNC_PASSWORD1
+then imapsync will prompt to enter the password on the terminal.
+Same thing for user2 password.
=head2 OPTIONS/encryption
@@ -180,11 +212,16 @@
--sslargs2 str : Pass any ssl parameter for host2 ssl or tls connection.
See --sslargs1
- --timeout1 int : Connection timeout in seconds for host1.
+ --timeout1 flo : Connection timeout in seconds for host1.
Default is 120 and 0 means no timeout at all.
- --timeout2 int : Connection timeout in seconds for host2.
+ --timeout2 flo : Connection timeout in seconds for host2.
Default is 120 and 0 means no timeout at all.
+ Caveat, under CGI context, you may encounter a timeout
+ from the webserver, killing imapsync and the imap connexions.
+ See the document INSTALL.OnlineUI.txt and search
+ for "Timeout" for how to deal with this issue.
+
=head2 OPTIONS/authentication
@@ -205,6 +242,28 @@
--domain1 str : Domain on host1 (NTLM authentication).
--domain2 str : Domain on host2 (NTLM authentication).
+ --oauthaccesstoken1 str : The access token to authenticate with OAUTH2.
+ It will be combined with the --user1 value to form the
+ string to pass with XOAUTH2 authentication.
+ The password given by --password1 or --passfile1
+ is ignored.
+ Instead of the access token itself, the value can be a
+ file containing the access token on the first line.
+ If the value is a file, imapsync reads its first line
+ and take this line as the access token. The advantage
+ of the file is that if the access token changes then
+ imapsync can read it again when it needs to reconnect
+ during a run.
+
+
+ --oauthaccesstoken2 str : same thing as --oauthaccesstoken1
+
+ --oauthdirect1 str : The direct string to pass with XOAUTH2 authentication.
+ The password given by --password1 or --passfile1 and
+ the user given by --user1 are ignored.
+
+ --oauthdirect2 str : same thing as oauthdirect1
+
=head2 OPTIONS/folders
@@ -241,6 +300,9 @@
--f1f2 str1=str2 : Force folder str1 to be synced to str2,
--f1f2 overrides --automap and --regextrans2.
+ Use several --f1f2 options to map several folders.
+ Option --f1f2 is a one to one only folder mapping,
+ str1 and str2 have to be full path folder names.
--subfolder2 str : Syncs the whole host1 folders hierarchy under the
host2 folder named str.
@@ -285,7 +347,7 @@
--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 for a run, then
+ Then, when happy, remove --dry for a run, then
remove --justfolders for the next ones.
Have in mind that --regextrans2 is applied after
the automatic prefix and separator inversion.
@@ -309,9 +371,11 @@
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.
+ it can be dirname/filename complete path.
+ The default name is imapsync.pid in tmpdir.
+
--pidfilelocking : Abort if pidfile already exists. Useful to avoid
concurrent transfers on the same mailbox.
@@ -329,7 +393,7 @@
where:
2019_12_22_23_57_59_532 is nearly the date of the start
- YYYY_MM_DD_HH_MM_SS_mmm
+ YYYY_MM_DD_HH_MM_SS_mmm
year_month_day_hour_minute_seconde_millisecond
and user1 user2 are the --user1 --user2 values.
@@ -337,18 +401,18 @@
=head2 OPTIONS/messages
--skipmess reg : Skips messages matching the regex.
- Example: 'm/[\x80-ff]/' # to avoid 8bits messages.
+ Example: 'm/[\x80-\xff]/' # to avoid 8bits messages.
--skipmess is applied before --regexmess
--skipmess reg : or this one, etc.
--skipcrossduplicates : Avoid copying messages that are already copied
- in another folder, good from Gmail to X when
- X is not also Gmail.
+ in another folder, good from Gmail to XYZ when
+ XYZ is not also Gmail.
Activated with --gmail1 unless --noskipcrossduplicates
--debugcrossduplicates : Prints which messages (UIDs) are skipped with
- --skipcrossduplicates (and in what other folders
- they are).
+ --skipcrossduplicates and in what other folders
+ they are.
--pipemess cmd : Apply this cmd command to each message content
before the copy.
@@ -364,20 +428,21 @@
--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.
+ Example: 's/\000/ /g' # to replace null characters
+ by spaces.
--regexmess reg : and this one, etc.
=head2 OPTIONS/labels
-Gmail present labels as folders in imap. Imapsync can accelerate the sync
+Gmail present labels as folders in imap. Imapsync can accelerate the sync
by syncing X-GM-LABELS, it will avoid to transfer messages when they are
-already on host2.
+already on host2 in another folder.
--synclabels : Syncs also Gmail labels when a message is copied to host2.
Activated by default with --gmail1 --gmail2 unless
--nosynclabels is added.
-
+
--resynclabels : Resyncs Gmail labels when a message is already on host2.
Activated by default with --gmail1 --gmail2 unless
--noresynclabels is added.
@@ -400,6 +465,9 @@
May be useful when a user has already started to play
with its host2 account.
+ --filterbuggyflags : Filter flags known to be buggy and generators of errors
+ "BAD Invalid system flag" or "NO APPEND Invalid flag list".
+
=head2 OPTIONS/deletions
--delete1 : Deletes messages on host1 server after a successful
@@ -424,16 +492,18 @@
Useful with --delete1 since what remains on host1
is only what failed to be synced.
- --delete2 : Delete messages in host2 that are not in
- host1 server. Useful for backup or pre-sync.
+ --delete2 : Delete messages in the host2 account that are not in
+ the host1 account. Useful for backup or pre-sync.
--delete2 implies --uidexpunge2
- --delete2duplicates : Delete messages in host2 that are duplicates.
+ --delete2duplicates : Deletes messages in host2 that are duplicates in host2.
Works only without --useuid since duplicates are
detected with an header part of each message.
+ NB: --delete2duplicates is far less violent than --delete2
+ since it removes only duplicates.
- --delete2folders : Delete folders in host2 that are not in host1 server.
- For safety, first try it like this (it is safe):
+ --delete2folders : Delete folders in host2 that are not in host1.
+ For safety, first try it like this, it is safe:
--delete2folders --dry --justfolders --nofoldersizes
and see what folders will be deleted.
@@ -455,10 +525,10 @@
If you encounter problems with dates, see also:
https://imapsync.lamiral.info/FAQ.d/FAQ.Dates.txt
- --syncinternaldates : Sets the internal dates on host2 same as host1.
+ --syncinternaldates : Sets the internal dates on host2 as the same as host1.
Turned on by default. Internal date is the date
- a message arrived on a host (Unix mtime).
- --idatefromheader : Sets the internal dates on host2 same as the
+ a message arrived on a host (Unix mtime usually).
+ --idatefromheader : Sets the internal dates on host2 as same as the
ones in "Date:" headers.
@@ -467,6 +537,7 @@
--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
@@ -487,18 +558,30 @@
--search2 str : Same as --search but for selecting host2 messages only.
So --search CRIT equals --search1 CRIT --search2 CRIT
+ --noabletosearch : Makes --minage and --maxage options use the internal
+ dates given by a FETCH imap command instead of the
+ "Date:" header. Internal date is the arrival date
+ in the mailbox.
+ --noabletosearch equals --noabletosearch1 --noabletosearch2
+
+ --noabletosearch1 : Like --noabletosearch but for host1 only.
+ --noabletosearch2 : Like --noabletosearch but for host2 only.
+
--maxlinelength int : skip messages with a line length longer than int bytes.
RFC 2822 says it must be no more than 1000 bytes but
real life servers and email clients do more.
--useheader str : Use this header to compare messages on both sides.
- Ex: Message-ID or Subject or Date.
+ Example: "Message-Id" or "Received" or "Date".
--useheader str and this one, etc.
- --usecache : Use cache to speed up next syncs. Not set by default.
+ --syncduplicates : Sync also duplicates. Off by default.
+
+ --usecache : Use cache to speed up next syncs. Off by default.
--nousecache : Do not use cache. Caveat: --useuid --nousecache creates
duplicates on multiple runs.
+
--useuid : Use UIDs instead of headers as a criterion to recognize
messages. Option --usecache is then implied unless
--nousecache is used.
@@ -516,6 +599,7 @@
--addheader adds a "Message-Id" header,
like "Message-Id: 12345@imapsync", where 12345
is the imap UID of the message on the host1 folder.
+ Useful to sync folders "Sent" or "Draft".
=head2 OPTIONS/debugging
@@ -534,7 +618,7 @@
--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 connection.
- --testslive6 : Run a live test with ks2ipv6.lamiral.info imap server.
+ --testslive6 : Run a live test with ks6ipv6.lamiral.info imap server.
Useful to check the ipv6 connectivity. Needs internet.
@@ -543,8 +627,8 @@
--gmail1 : sets --host1 to Gmail and other options. See FAQ.Gmail.txt
--gmail2 : sets --host2 to Gmail and other options. See FAQ.Gmail.txt
- --office1 : sets --host1 to Office365 and other options. See FAQ.Exchange.txt
- --office2 : sets --host2 to Office365 and other options. See FAQ.Exchange.txt
+ --office1 : sets --host1 to Office365 and other options. See FAQ.Office365.txt
+ --office2 : sets --host2 to Office365 and other options. See FAQ.Office365.txt
--exchange1 : sets options for Exchange. See FAQ.Exchange.txt
--exchange2 : sets options for Exchange. See FAQ.Exchange.txt
@@ -555,13 +639,14 @@
=head2 OPTIONS/behavior
- --maxmessagespersecond int : limits the number of messages transferred per second.
+ --maxmessagespersecond flo : limits the average 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.
+ --maxsleep flo : do not sleep more than int seconds.
On by default, 2 seconds max, like --maxsleep 2
--abort : terminates a previous call still running.
@@ -570,13 +655,13 @@
--exitwhenover int : Stop syncing and exits when int total bytes
transferred is reached.
- --version : Print only software version.
+ --version : Print only the software version.
--noreleasecheck : Do not check for any new imapsync release.
--releasecheck : Check for new imapsync release.
it's an http request to
http://imapsync.lamiral.info/prj/imapsync/VERSION
- --noid : Do not send/receive ID command to imap servers.
+ --noid : Do not send/receive IMAP "ID" command to imap servers.
--justconnect : Just connect to both servers and print useful
information. Need only --host1 and --host2 options.
@@ -609,7 +694,7 @@
=head1 SECURITY
-You can use --passfile1 instead of --password1 to give the
+You can use --passfile1 instead of --password1 to mention the
password since it is safer. With --password1 option, on Linux,
any user on your host can see the password by using the 'ps auxwwww'
command. Using a variable (like IMAPSYNC_PASSWORD1) is also
@@ -625,10 +710,10 @@
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.
+then imapsync goes to encryption with STARTTLS.
If the automatic ssl and the tls detections fail then imapsync will
-not protect against sniffing activities on the network, especially
+not protect against sniffing activities on the network, especially
for passwords.
If you want to force ssl or tls just use --ssl1 --ssl2 or --tls1 --tls2
@@ -641,12 +726,14 @@
Imapsync will exit with a 0 status (return code) if everything went good.
Otherwise, it exits with a non-zero status. That's classical Unix behavior.
Here is the list of the exit code values (an integer between 0 and 255).
+In Bourne Shells, this exit code value can be retrieved within the variable
+value "$?" if you read it just after the imapsync call.
+
The names reflect their meaning:
=for comment
egrep '^Readonly my.*\$EX' imapsync | egrep -o 'EX.*' | sed 's_^_ _'
-
EX_OK => 0 ; #/* successful termination */
EX_USAGE => 64 ; #/* command line usage error */
EX_NOINPUT => 66 ; #/* cannot open input */
@@ -654,6 +741,7 @@
EX_SOFTWARE => 70 ; #/* internal software error */
EXIT_CATCH_ALL => 1 ; # Any other error
EXIT_BY_SIGNAL => 6 ; # Should be 128+n where n is the sig_num
+ EXIT_BY_FILE => 7 ;
EXIT_PID_FILE_ERROR => 8 ;
EXIT_CONNECTION_FAILURE => 10 ;
EXIT_TLS_FAILURE => 12 ;
@@ -661,8 +749,18 @@
EXIT_SUBFOLDER1_NO_EXISTS => 21 ;
EXIT_WITH_ERRORS => 111 ;
EXIT_WITH_ERRORS_MAX => 112 ;
+ EXIT_OVERQUOTA => 113 ;
+ EXIT_ERR_APPEND => 114 ;
+ EXIT_ERR_FETCH => 115 ;
+ EXIT_ERR_CREATE => 116 ;
+ EXIT_ERR_SELECT => 117 ;
+ EXIT_TRANSFER_EXCEEDED => 118 ;
+ EXIT_ERR_APPEND_VIRUS => 119 ;
EXIT_TESTS_FAILED => 254 ; # Like Test::More API
-
+ EXIT_CONNECTION_FAILURE_HOST1 => 101 ;
+ EXIT_CONNECTION_FAILURE_HOST2 => 102 ;
+ EXIT_AUTHENTICATION_FAILURE_USER1 => 161 ;
+ EXIT_AUTHENTICATION_FAILURE_USER2 => 162 ;
=head1 LICENSE AND COPYRIGHT
@@ -688,11 +786,11 @@
Bad feedback is very often welcome.
Gilles LAMIRAL earns his living by writing, installing,
-configuring and teaching free, open and often gratis
+configuring and sometimes 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.
+your servitor, a good way to maintain and support free open public
+software tools over decades.
=head1 BUGS AND LIMITATIONS
@@ -745,8 +843,8 @@
and all Server releases 2000, 2003, 2008 and R2, 2012 and R2, 2016)
as a standalone binary software called imapsync.exe,
usually launched from a batch file in order to avoid always typing
- the options. There is also a 64bit binary called imapsync_64bit.exe
-
+ the options. There is also a 32bit binary called imapsync_32bit.exe
+
Imapsync works under OS X as a standalone binary
software called imapsync_bin_Darwin
@@ -783,8 +881,7 @@
See also https://imapsync.lamiral.info/S/external.shtml
for a better up to date list.
-Last updated and verified on Sun Dec 8, 2019.
-
+List verified on Friday July 1, 2021.
imapsync: https://github.com/imapsync/imapsync (this is an imapsync copy, sometimes delayed, with --noreleasecheck by default since release 1.592, 2014/05/22)
imap_tools: https://web.archive.org/web/20161228145952/http://www.athensfbc.com/imap_tools/. The imap_tools code is now at https://github.com/andrewnimmo/rick-sanders-imap-tools
@@ -792,6 +889,7 @@
Doveadm-Sync: https://wiki2.dovecot.org/Tools/Doveadm/Sync ( Dovecot sync tool )
davmail: http://davmail.sourceforge.net/
offlineimap: http://offlineimap.org/
+ fdm: https://github.com/nicm/fdm
mbsync: http://isync.sourceforge.net/
mailsync: http://mailsync.sourceforge.net/
mailutil: https://www.washington.edu/imap/ part of the UW IMAP toolkit. (well, seems abandoned now)
@@ -813,8 +911,8 @@
imapbackup: https://github.com/rcarmo/imapbackup (A Python script for incremental backups of IMAP mailboxes)
BitRecover email-backup 99 USD, 299 USD https://www.bitrecover.com/email-backup/.
ImportExportTools: https://addons.thunderbird.net/en-us/thunderbird/addon/importexporttools/ ImportExportTools for Mozilla Thunderbird by Paolo Kaosmos. ImportExportTools does not do IMAP.
-
-
+ rximapmail: https://sourceforge.net/projects/rximapmail/
+ CodeTwo: https://www.codetwo.com/ but CodeTwo does imap source to Office365 only.
=head1 HISTORY
@@ -825,7 +923,7 @@
often broken low-bandwidth ISDN link.
I had to verify every mailbox was well transferred, all folders, all messages,
-without wasting bandwidth or creating duplicates upon resyncs. The imapsync
+without wasting bandwidth or creating duplicates upon resyncs. The imapsync
design was made with the beautiful rsync command in mind.
Imapsync started its life as a patch of the copy_folder.pl
@@ -833,7 +931,7 @@
module tarball source (more precisely in the examples/ directory of the
Mail-IMAPClient tarball).
-So many happened since then that I wonder
+So many changes happened since then that I wonder
if it remains any lines of the original
copy_folder.pl in imapsync source code.
@@ -847,9 +945,12 @@
use strict ;
use warnings ;
use Carp ;
+use Cwd ;
use Data::Dumper ;
use Digest::HMAC_SHA1 qw( hmac_sha1 hmac_sha1_hex ) ;
use Digest::MD5 qw( md5 md5_hex md5_base64 ) ;
+use Encode ;
+use Encode::IMAPUTF7 ;
use English qw( -no_match_vars ) ;
use Errno qw(EAGAIN EPIPE ECONNRESET) ;
use Fcntl ;
@@ -866,25 +967,23 @@
use IO::Socket::SSL ;
use IO::Tee ;
use IPC::Open3 'open3' ;
+#use locale ;
use Mail::IMAPClient 3.30 ;
use MIME::Base64 ;
use Pod::Usage qw(pod2usage) ;
-use POSIX qw(uname SIGALRM :sys_wait_h) ;
+use POSIX qw( uname SIGALRM :sys_wait_h ) ;
use Sys::Hostname ;
use Term::ReadKey ;
use Test::More ;
use Time::HiRes qw( time sleep ) ;
use Time::Local ;
use Unicode::String ;
-use Cwd ;
use Readonly ;
use Sys::MemInfo ;
use Regexp::Common ;
use Text::ParseWords ; # for quotewords()
use File::Tail ;
-use Encode ;
-use Encode::IMAPUTF7 ;
local $OUTPUT_AUTOFLUSH = 1 ;
@@ -918,6 +1017,7 @@
# Mine
Readonly my $EXIT_CATCH_ALL => 1 ; # Any other error
Readonly my $EXIT_BY_SIGNAL => 6 ; # Should be 128+n where n is the sig_num
+Readonly my $EXIT_BY_FILE => 7 ;
Readonly my $EXIT_PID_FILE_ERROR => 8 ;
Readonly my $EXIT_CONNECTION_FAILURE => 10 ;
Readonly my $EXIT_TLS_FAILURE => 12 ;
@@ -925,10 +1025,22 @@
Readonly my $EXIT_SUBFOLDER1_NO_EXISTS => 21 ;
Readonly my $EXIT_WITH_ERRORS => 111 ;
Readonly my $EXIT_WITH_ERRORS_MAX => 112 ;
+Readonly my $EXIT_OVERQUOTA => 113 ;
+Readonly my $EXIT_ERR_APPEND => 114 ;
+Readonly my $EXIT_ERR_FETCH => 115 ;
+Readonly my $EXIT_ERR_CREATE => 116 ;
+Readonly my $EXIT_ERR_SELECT => 117 ;
+Readonly my $EXIT_TRANSFER_EXCEEDED => 118 ;
+Readonly my $EXIT_ERR_APPEND_VIRUS => 119 ;
Readonly my $EXIT_TESTS_FAILED => 254 ; # Like Test::More API
+Readonly my $EXIT_CONNECTION_FAILURE_HOST1 => 101 ;
+Readonly my $EXIT_CONNECTION_FAILURE_HOST2 => 102 ;
+Readonly my $EXIT_AUTHENTICATION_FAILURE_USER1 => 161 ;
+Readonly my $EXIT_AUTHENTICATION_FAILURE_USER2 => 162 ;
+
Readonly my %EXIT_TXT => (
$EX_OK => 'EX_OK: successful termination',
@@ -939,6 +1051,7 @@
$EXIT_CATCH_ALL => 'EXIT_CATCH_ALL',
$EXIT_BY_SIGNAL => 'EXIT_BY_SIGNAL',
+ $EXIT_BY_FILE => 'EXIT_BY_FILE',
$EXIT_PID_FILE_ERROR => 'EXIT_PID_FILE_ERROR' ,
$EXIT_CONNECTION_FAILURE => 'EXIT_CONNECTION_FAILURE',
$EXIT_TLS_FAILURE => 'EXIT_TLS_FAILURE',
@@ -946,7 +1059,37 @@
$EXIT_SUBFOLDER1_NO_EXISTS => 'EXIT_SUBFOLDER1_NO_EXISTS',
$EXIT_WITH_ERRORS => 'EXIT_WITH_ERRORS',
$EXIT_WITH_ERRORS_MAX => 'EXIT_WITH_ERRORS_MAX',
+ $EXIT_OVERQUOTA => 'EXIT_OVERQUOTA',
+ $EXIT_ERR_APPEND => 'EXIT_ERR_APPEND',
+ $EXIT_ERR_APPEND_VIRUS => 'EXIT_ERR_APPEND_VIRUS',
+ $EXIT_ERR_FETCH => 'EXIT_ERR_FETCH',
+ $EXIT_ERR_CREATE => 'EXIT_ERR_CREATE',
+ $EXIT_ERR_SELECT => 'EXIT_ERR_SELECT',
$EXIT_TESTS_FAILED => 'EXIT_TESTS_FAILED',
+ $EXIT_TRANSFER_EXCEEDED => 'EXIT_TRANSFER_EXCEEDED',
+ $EXIT_CONNECTION_FAILURE_HOST1 => 'EXIT_CONNECTION_FAILURE_HOST1',
+ $EXIT_CONNECTION_FAILURE_HOST2 => 'EXIT_CONNECTION_FAILURE_HOST2',
+ $EXIT_AUTHENTICATION_FAILURE_USER1 => 'EXIT_AUTHENTICATION_FAILURE_USER1',
+ $EXIT_AUTHENTICATION_FAILURE_USER2 => 'EXIT_AUTHENTICATION_FAILURE_USER2',
+) ;
+
+
+Readonly my %EXIT_VALUE_OF_ERR_TYPE => (
+ ERR_APPEND_SIZE => $EXIT_ERR_APPEND,
+ ERR_OVERQUOTA => $EXIT_OVERQUOTA,
+ ERR_APPEND => $EXIT_ERR_APPEND,
+ ERR_APPEND_VIRUS => $EXIT_ERR_APPEND_VIRUS,
+ ERR_CREATE => $EXIT_ERR_CREATE,
+ ERR_SELECT => $EXIT_ERR_SELECT,
+ ERR_Host1_FETCH => $EXIT_ERR_FETCH,
+ ERR_UNCLASSIFIED => $EXIT_WITH_ERRORS,
+ ERR_NOTHING_REPORTED => $EXIT_WITH_ERRORS,
+ ERR_TRANSFER_EXCEEDED => $EXIT_TRANSFER_EXCEEDED,
+ ERR_CONNECTION_FAILURE_HOST1 => $EXIT_CONNECTION_FAILURE_HOST1,
+ ERR_CONNECTION_FAILURE_HOST2 => $EXIT_CONNECTION_FAILURE_HOST2,
+ ERR_AUTHENTICATION_FAILURE_USER1 => $EXIT_AUTHENTICATION_FAILURE_USER1,
+ ERR_AUTHENTICATION_FAILURE_USER2 => $EXIT_AUTHENTICATION_FAILURE_USER2,
+ ERR_EXIT_TLS_FAILURE => $EXIT_TLS_FAILURE,
) ;
@@ -976,7 +1119,7 @@
Readonly my $TCP_PING_TIMEOUT => 5 ;
Readonly my $DEFAULT_TIMEOUT => 120 ;
Readonly my $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND => 3 ;
-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
@@ -1029,15 +1172,13 @@
# global variables
-# Currently working to finish with only $sync
+# Currently working to finish with only $sync, $acc1, $acc2
# Not finished yet...
my(
- $sync,
- $timestart_str,
- $debugimap, $debugimap1, $debugimap2, $debugcontent, $debugflags,
+ $sync, $acc1, $acc2,
+ $debugcontent, $debugflags,
$debuglist, $debugdev, $debugmaxlinelength, $debugcgi,
- $domain1, $domain2,
@include, @exclude, @folderrec,
@folderfirst, @folderlast,
@@ -1052,46 +1193,39 @@
%h2_folders_from_1_several,
$prefix1, $prefix2,
- @regexmess, @regexflag, @skipmess, @pipemess, $pipemesscheck,
- $flagscase, $filterflags, $syncflagsaftercopy,
+ @regexmess, @skipmess, @pipemess, $pipemesscheck,
+ $syncflagsaftercopy,
$syncinternaldates,
$idatefromheader,
- $syncacls,
- $fastio1, $fastio2,
+
$minsize, $maxage, $minage,
$search,
- $skipheader, @useheader, %useheader,
+ @useheader, %useheader,
$skipsize, $allowsizemismatch, $buffersize,
$authmd5, $authmd51, $authmd52,
$subscribed, $subscribe, $subscribeall,
$help,
- $justbanner,
+
$fast,
$nb_msg_skipped_dry_mode,
- $h1_nb_msg_duplicate,
- $h2_nb_msg_duplicate,
- $h2_nb_msg_noheader,
- $h2_nb_msg_deleted,
+ $h2_nb_msg_noheader,
$h1_bytes_processed,
$h1_nb_msg_end, $h1_bytes_end,
$h2_nb_msg_end, $h2_bytes_end,
- $timeout,
$timestart_int,
$uid1, $uid2,
- $authuser1, $authuser2,
- $proxyauth1, $proxyauth2,
- $authmech1, $authmech2,
+
+
$split1, $split2,
- $reconnectretry1, $reconnectretry2,
- $max_msg_size_in_bytes,
+
$modulesversion,
$delete2folders, $delete2foldersonly, $delete2foldersbutnot,
$usecache, $debugcache, $cacheaftercopy,
@@ -1101,7 +1235,6 @@
$fixInboxINBOX,
$maxlinelength, $maxlinelengthcmd,
$minmaxlinelength,
- $uidnext_default,
$fixcolonbug,
$create_folder_old,
$skipcrossduplicates, $debugcrossduplicates,
@@ -1114,7 +1247,9 @@
$warn_release,
) ;
-single_sync( ) ;
+single_sync( $sync, $acc1, $acc2 );
+
+
sub single_sync
{
@@ -1122,21 +1257,36 @@
# main program
# global variables initialization
-# I'm currently removing all global variables except $sync
-# passing each of them under $sync->{variable_name}
+# I'm currently removing all global variables except $sync $acc1 $acc2
+# passing each of them under
+# $sync->{variable_name}
+# or $acc1->{variable_name}
+# or $acc1->{variable_name}
+
+#
+$acc1 = {} ;
+$acc2 = {} ;
+$sync->{ acc1 } = $acc1 ;
+$sync->{ acc2 } = $acc2 ;
+
+$acc1->{ Side } = 'Host1' ;
+$acc2->{ Side } = 'Host2' ;
$sync->{timestart} = time ; # Is a float because of use Time::HiRres
-$sync->{rcs} = q{$Id: imapsync,v 1.977 2019/12/23 20:18:02 gilles Exp gilles $} ;
+$sync->{rcs} = q{$Id: imapsync,v 2.148 2021/07/22 14:21:09 gilles Exp gilles $} ;
$sync->{ memory_consumption_at_start } = memory_consumption( ) || 0 ;
+
my @loadavg = loadavg( ) ;
-$sync->{cpu_number} = cpu_number( ) ;
-$sync->{loaddelay} = load_and_delay( $sync->{cpu_number}, @loadavg ) ;
-$sync->{loadavg} = join( q{ }, $loadavg[ 0 ] )
+$sync->{ cpu_number } = cpu_number( ) ;
+$sync->{ loaddelay } = load_and_delay( $sync->{ cpu_number }, @loadavg ) ;
+$sync->{ loaddelay } = 0 ;
+
+$sync->{ loadavg } = join( q{ }, $loadavg[ 0 ] )
. " on $sync->{cpu_number} cores and "
. ram_memory_info( ) ;
@@ -1146,10 +1296,13 @@
$sync->{ total_bytes_skipped } = 0 ;
$sync->{ nb_msg_transferred } = 0 ;
$sync->{ nb_msg_skipped } = $nb_msg_skipped_dry_mode = 0 ;
-$sync->{ h1_nb_msg_deleted } = 0 ;
-$h2_nb_msg_deleted = 0 ;
-$h1_nb_msg_duplicate = 0 ;
-$h2_nb_msg_duplicate = 0 ;
+
+$sync->{ acc1 }->{ nb_msg_deleted } = 0 ;
+$sync->{ acc2 }->{ nb_msg_deleted } = 0 ;
+
+$sync->{ acc1 }->{ nb_msg_duplicate } = 0 ;
+$sync->{ acc2 }->{ nb_msg_duplicate } = 0 ;
+
$sync->{ h1_nb_msg_noheader } = 0 ;
$h2_nb_msg_noheader = 0 ;
@@ -1165,8 +1318,8 @@
#$h1_nb_msg_end = $h1_bytes_end = 0 ;
#$h2_nb_msg_end = $h2_bytes_end = 0 ;
-$sync->{nb_errors} = 0;
-$max_msg_size_in_bytes = 0;
+$sync->{ nb_errors } = 0;
+$sync->{ biggest_message_transferred } = 0;
%month_abrev = (
Jan => '00',
@@ -1192,14 +1345,14 @@
# In cgi context, printing must start by the header so we delay other prints by using output() storage
my $options_good = get_options( $sync, @ARGV ) ;
# Is it the first myprint?
-docker_context( $sync ) ;
cgibuildheader( $sync ) ;
+docker_context( $sync ) ;
-myprint( output( $sync ) ) ;
+print_output_if_needed( $sync ) ;
+
+
output_reset_with( $sync ) ;
-# Old place for cgiload( $sync ) ;
-
# don't go on if options are not all known.
if ( ! defined $options_good ) { exit $EX_USAGE ; }
@@ -1214,7 +1367,7 @@
# just the version
if ( $sync->{ version } ) {
myprint( imapsync_version( $sync ), "\n" ) ;
- exit 0 ;
+ return 0 ;
}
#$sync->{debugenv} = 1 ;
@@ -1224,6 +1377,8 @@
# after_get_options call usage and exit if --help or options were not well got
after_get_options( $sync, $options_good ) ;
+#local $ENV{TZ} = 'GMT' if ( under_cgi_context( $sync ) and 'MSWin32' ne $OSNAME ) ;
+#output( $sync, localtime(time) . " " . gmtime(time) . "\n" ) ;
# Under CGI environment, fix caveat emptor potential issues
cgisetcontext( $sync ) ;
@@ -1237,28 +1392,40 @@
$sync->{ tmpdir } ||= File::Spec->tmpdir( ) ;
# Unit tests
-testsexit( $sync ) ;
+my $unittestssuite = unittestssuite( $sync ) ;
+
+
+if ( condition_to_leave_after_tests( $sync ) )
+{
+ return $unittestssuite ;
+}
# init live varaiables
-testslive_init( $sync ) if ( $sync->{testslive} ) ;
-testslive6_init( $sync ) if ( $sync->{testslive6} ) ;
-#
+if ( $sync->{ testslive } )
+{
+ testslive_init( $sync ) ;
+}
-pidfile( $sync ) ;
+if ( $sync->{ testslive6 } )
+{
+ testslive6_init( $sync ) ;
+}
-# old abort place
+define_pidfile( $sync ) ;
+if ( $sync->{ abortbyfile } ) { $sync->{ abort } = 1 ; }
install_signals( $sync ) ;
-$sync->{log} = defined $sync->{log} ? $sync->{log} : 1 ;
-$sync->{errorsdump} = defined $sync->{errorsdump} ? $sync->{errorsdump} : 1 ;
-$sync->{errorsmax} = defined $sync->{errorsmax} ? $sync->{errorsmax} : $ERRORS_MAX ;
+$sync->{ log } = defined $sync->{ log } ? $sync->{ log } : 1 ;
+$sync->{ errorsdump } = defined $sync->{ errorsdump } ? $sync->{ errorsdump } : 1 ;
+$sync->{ errorsmax } = defined $sync->{ errorsmax } ? $sync->{ errorsmax } : $ERRORS_MAX ;
# log and output
binmode STDOUT, ":encoding(UTF-8)" ;
-if ( $sync->{log} ) {
+
+if ( $sync->{ log } ) {
setlogfile( $sync ) ;
teelaunch( $sync ) ;
# now $sync->{tee} is a filehandle to STDOUT and the logfile
@@ -1266,7 +1433,7 @@
#binmode STDERR, ":encoding(UTF-8)" ;
# STDERR goes to the same place: LOG and STDOUT (if logging is on)
-# Useful only for --debugssl
+# Useful only for --debugssl
$sync->{tee} and local *STDERR = *${$sync->{tee}}{IO} ;
@@ -1275,14 +1442,14 @@
$sync->{timebefore} = $sync->{timestart} ;
-$timestart_str = localtime( $sync->{timestart} ) ;
+$sync->{ timestart_str } = localtimez( $sync->{timestart} ) ;
# The prints in the log starts here
myprint( localhost_info( $sync ), "\n" ) ;
-myprint( "Transfer started at $timestart_str\n" ) ;
+myprint( "Transfer started at $sync->{ timestart_str }\n" ) ;
myprint( "PID is $PROCESS_ID my PPID is ", mygetppid( ), "\n" ) ;
-myprint( "Log file is $sync->{logfile} ( to change it, use --logfile path ; or use --nolog to turn off logging )\n" ) if ( $sync->{log} ) ;
+announcelogfile( $sync ) ;
myprint( "Load is " . ( join( q{ }, loadavg( ) ) || 'unknown' ), " on $sync->{cpu_number} cores\n" ) ;
#myprintf( "Memory consumption so far: %.1f MiB\n", memory_consumption( ) / $KIBI / $KIBI ) ;
myprint( 'Current directory is ' . getcwd( ) . "\n" ) ;
@@ -1296,11 +1463,13 @@
$wholeheaderifneeded = defined $wholeheaderifneeded ? $wholeheaderifneeded : 1;
-# Activate --usecache if --useuid is set and no --nousecache
+# Activate --usecache if --useuid is set and there is no --nousecache
$usecache = 1 if ( $useuid and ( ! defined $usecache ) ) ;
$cacheaftercopy = 1 if ( $usecache and ( ! defined $cacheaftercopy ) ) ;
-$sync->{ checkselectable } = defined $sync->{ checkselectable } ? $sync->{ checkselectable } : 1 ;
+
+
+
$sync->{ checkfoldersexist } = defined $sync->{ checkfoldersexist } ? $sync->{ checkfoldersexist } : 1 ;
$checkmessageexists = defined $checkmessageexists ? $checkmessageexists : 0 ;
$sync->{ expungeaftereach } = defined $sync->{ expungeaftereach } ? $sync->{ expungeaftereach } : 1 ;
@@ -1312,6 +1481,7 @@
$checkmessageexists = 0 if ( not $sync->{abletosearch1} ) ;
+$sync->{ trylogin } = defined $sync->{ trylogin } ? $sync->{ trylogin } : 1 ;
$sync->{showpasswords} = defined $sync->{showpasswords} ? $sync->{showpasswords} : 0 ;
$sync->{ fixslash2 } = defined $sync->{ fixslash2 } ? $sync->{ fixslash2 } : 1 ;
$fixInboxINBOX = defined $fixInboxINBOX ? $fixInboxINBOX : 1 ;
@@ -1335,19 +1505,18 @@
do_valid_directory( $sync->{ tmpdir } ) || croak "Error creating tmpdir $sync->{ tmpdir } : $OS_ERROR" ;
-remove_pidfile_not_running( $sync->{pidfile} ) ;
+remove_pidfile_not_running( $sync->{ pidfile } ) ;
# if another imapsync is running then tail -f its logfile and exit
# useful in cgi context
if ( $sync->{ tail } and tail( $sync ) )
{
- $sync->{nb_errors}++ ;
exit_clean( $sync, $EX_OK, "Tail -f finished. Now finishing myself processus $PROCESS_ID\n" ) ;
exit $EX_OK ;
}
if ( ! write_pidfile( $sync ) ) {
- myprint( "Exiting with return value $EXIT_PID_FILE_ERROR ($EXIT_TXT{$EXIT_PID_FILE_ERROR}) $sync->{nb_errors}/$sync->{errorsmax} nb_errors/max_errors\n" ) ;
+ myprint( "Exiting with return value $EXIT_PID_FILE_ERROR ($EXIT_TXT{$EXIT_PID_FILE_ERROR}) $sync->{nb_errors}/$sync->{errorsmax} nb_errors/max_errors PID $PROCESS_ID\n" ) ;
exit $EXIT_PID_FILE_ERROR ;
}
@@ -1357,18 +1526,22 @@
if ( $sync->{ abort } )
{
abort( $sync ) ;
+ # well, the abort job is done, because even when not succeeded
+ # in aborting another run, this run has to end without doing any
+ # thing else
+
+ exit $EX_OK ;
}
# simulong is just a loop printing some lines for xx seconds with option "--simulong xx".
-if ( $sync->{ simulong } )
-{
- simulong( $sync->{ simulong } ) ;
-}
+simulong( $sync ) ;
+
# New place for cgiload 2019_03_03
# because I want to log it
# Can break here if load is too heavy
+# Have in mind the CGI header has already a 503 Service Unavailable
cgiload( $sync ) ;
@@ -1376,20 +1549,28 @@
if ( $usecache and $fixcolonbug ) { tmpdir_fix_colon_bug( $sync ) } ;
-$modulesversion and myprint( "Modules version list:\n", modulesversion(), "( use --no-modulesversion to turn off printing this Perl modules list )\n" ) ;
+$modulesversion and myprint( "Modules version list ( use --no-modulesversion to turn off printing this Perl modules list ):\n", modulesversion(), "\n" ) ;
check_lib_version( $sync ) or
croak "imapsync needs perl lib Mail::IMAPClient release 3.30 or superior.\n";
-exit_clean( $sync, $EX_OK ) if ( $justbanner ) ;
+
+if ( $sync->{ justbanner } )
+{
+ myprint( "Exiting because of --justbanner\n" ) ;
+ exit_clean( $sync, $EX_OK ) ;
+}
# turn on RFC standard flags correction like \SEEN -> \Seen
-$flagscase = defined $flagscase ? $flagscase : 1 ;
+$sync->{ flagscase } = defined $sync->{ flagscase } ? $sync->{ flagscase } : 1 ;
# Use PERMANENTFLAGS if available
-$filterflags = defined $filterflags ? $filterflags : 1 ;
+$sync->{ filterflags } = defined $sync->{ filterflags } ? $sync->{ filterflags } : 1 ;
+
+filterbuggyflags( $sync ) ;
+
# sync flags just after an APPEND, some servers ignore the flags given in the APPEND
# like MailEnable IMAP server.
@@ -1412,13 +1593,18 @@
$split2 ||= $SPLIT ;
#$sync->{host1} || missing_option( $sync, '--host1' ) ;
+$sync->{host1} = sanitize_host( $sync->{host1} ) ;
$sync->{port1} ||= ( $sync->{ssl1} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
#$sync->{host2} || missing_option( $sync, '--host2' ) ;
+$sync->{host2} = sanitize_host( $sync->{host2} ) ;
$sync->{port2} ||= ( $sync->{ssl2} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;
-$debugimap1 = $debugimap2 = 1 if ( $debugimap ) ;
-$sync->{ debug } = 1 if ( $debugimap1 or $debugimap2 ) ;
+
+$acc1->{ debugimap } = $acc2->{ debugimap } = 1 if ( $sync->{ debugimap } ) ;
+# Set on debug mode if one of the imap dialogs are in debug.
+# imap dialog without the debug mode is scary and useless.
+$sync->{ debug } = 1 if ( $acc1->{ debugimap } or $acc2->{ debugimap } ) ;
# By default, don't take size to compare
$skipsize = (defined $skipsize) ? $skipsize : 1;
@@ -1455,6 +1641,7 @@
if ( $sync->{ssl1} ) {
myprint( qq{Host1: SSL default mode is like --sslargs1 "SSL_verify_mode=$SSL_VERIFY_POLICY", meaning for host1 $SSL_VERIFY_STR{$SSL_VERIFY_POLICY}\n} ) ;
myprint( 'Host1: Use --sslargs1 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER( ) . " to have $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER( )} of host1\n" ) ;
+ # $sync->{ acc1 }->{sslargs}->{SSL_verify_mode}
}
if ( $sync->{ssl2} ) {
@@ -1516,8 +1703,11 @@
}
if ( $sync->{ delete1 } and $sync->{ delete2 } ) {
- myprint( "Warning: using --delete1 and --delete2 together is almost always a bad idea, exiting imapsync\n" ) ;
- $sync->{nb_errors}++ ;
+ myprint( "Warning: using --delete1 and --delete2 together is almost always a bad idea. "
+ . "You should probably launch two runs, the first with --delete2 for a strict sync, "
+ . "then the second with --delete1 to remove messages from the source account. "
+ . "Exiting imapsync.\n" ) ;
+ $sync->{ nb_errors }++ ;
exit_clean( $sync, $EX_USAGE ) ;
}
@@ -1540,44 +1730,48 @@
}
if ( defined $authmd51 and $authmd51 ) {
- $authmech1 ||= 'CRAM-MD5';
+ $acc1->{ authmech } ||= 'CRAM-MD5' ;
}
else{
- $authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN';
+ $acc1->{ authmech } ||= $acc1->{ authuser } ? 'PLAIN' : 'LOGIN' ;
}
if ( defined $authmd52 and $authmd52 ) {
- $authmech2 ||= 'CRAM-MD5';
+ $acc2->{ authmech } ||= 'CRAM-MD5';
}
else{
- $authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN';
+ $acc2->{ authmech } ||= $acc2->{ authuser } ? 'PLAIN' : 'LOGIN';
}
-$authmech1 = uc $authmech1;
-$authmech2 = uc $authmech2;
+$acc1->{ authmech } = uc $acc1->{ authmech } ;
+$acc2->{ authmech } = uc $acc2->{ authmech } ;
-if (defined $proxyauth1 && !$authuser1) {
+if ( defined $acc1->{ proxyauth } && !$acc1->{ authuser } )
+{
missing_option( $sync, 'With --proxyauth1, --authuser1' ) ;
}
-if (defined $proxyauth2 && !$authuser2) {
+if ( defined $acc2->{ proxyauth } && !$acc2->{ authuser } )
+{
missing_option( $sync, 'With --proxyauth2, --authuser2' ) ;
}
-#$authuser1 ||= $sync->{user1};
-#$authuser2 ||= $sync->{user2};
+myprint( "Host1: will try to use $acc1->{ authmech } authentication on host1\n") ;
+myprint( "Host2: will try to use $acc2->{ authmech } authentication on host2\n") ;
-myprint( "Host1: will try to use $authmech1 authentication on host1\n") ;
-myprint( "Host2: will try to use $authmech2 authentication on host2\n") ;
+$sync->{ timeout } = defined $sync->{ timeout } ?$sync->{ timeout } : $DEFAULT_TIMEOUT ;
-$timeout = defined $timeout ? $timeout : $DEFAULT_TIMEOUT ;
+$sync->{ acc1 }->{timeout} = defined $sync->{ acc1 }->{timeout} ? $sync->{ acc1 }->{timeout} : $sync->{ timeout } ;
+myprint( "Host1: imap connection timeout is $sync->{ acc1 }->{timeout} seconds\n") ;
+$sync->{ acc2 }->{timeout} = defined $sync->{ acc2 }->{timeout} ? $sync->{ acc2 }->{timeout} : $sync->{ timeout } ;
+myprint( "Host2: imap connection timeout is $sync->{ acc2 }->{timeout} seconds\n" ) ;
-$sync->{h1}->{timeout} = defined $sync->{h1}->{timeout} ? $sync->{h1}->{timeout} : $timeout ;
-myprint( "Host1: imap connection timeout is $sync->{h1}->{timeout} seconds\n") ;
-$sync->{h2}->{timeout} = defined $sync->{h2}->{timeout} ? $sync->{h2}->{timeout} : $timeout ;
-myprint( "Host2: imap connection timeout is $sync->{h2}->{timeout} seconds\n" ) ;
+if ( under_cgi_context( $sync ) )
+{
+ myprint( "Under CGI context, a timeout can occur from the webserver, see https://imapsync.lamiral.info/INSTALL.d/INSTALL.OnlineUI.txt\n" ) ;
+}
-$syncacls = defined $syncacls ? $syncacls : 0 ;
+$sync->{ syncacls } = defined $sync->{ syncacls } ? $sync->{ syncacls } : 0 ;
# No folders sizes if --justfolders, unless really wanted.
if (
@@ -1592,21 +1786,21 @@
$sync->{ foldersizes } = ( defined $sync->{ foldersizes } ) ? $sync->{ foldersizes } : 1 ;
$sync->{ foldersizesatend } = ( defined $sync->{ foldersizesatend } ) ? $sync->{ foldersizesatend } : $sync->{ foldersizes } ;
+$sync->{ checknoabletosearch } = ( defined $sync->{ checknoabletosearch } ) ? $sync->{ checknoabletosearch } : 1 ;
-$fastio1 = defined $fastio1 ? $fastio1 : 0 ;
-$fastio2 = defined $fastio2 ? $fastio2 : 0 ;
-$reconnectretry1 = defined $reconnectretry1 ? $reconnectretry1 : $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
-$reconnectretry2 = defined $reconnectretry2 ? $reconnectretry2 : $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
+$acc1->{ fastio } = defined $acc1->{ fastio } ? $acc1->{ fastio } : 0 ;
+$acc2->{ fastio } = defined $acc2->{ fastio } ? $acc2->{ fastio } : 0 ;
-# Since select_msgs() returns no messages when uidnext does not return something
-# then $uidnext_default is never used. So I have to remove it.
-$uidnext_default = $DEFAULT_UIDNEXT ;
+
+$acc1->{ reconnectretry } = defined $acc1->{ reconnectretry } ? $acc1->{ reconnectretry } : $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
+$acc2->{ reconnectretry } = defined $acc2->{ reconnectretry } ? $acc2->{ reconnectretry } : $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
+
if ( ! @useheader ) { @useheader = qw( Message-Id Received ) ; }
# Make a hash %useheader of each --useheader 'key' in uppercase
-for ( @useheader ) { $useheader{ uc $_ } = undef } ;
+for ( @useheader ) { $sync->{useheader}->{ uc $_ } = undef } ;
#myprint( Data::Dumper->Dump( [ \%useheader ] ) ) ;
#exit ;
@@ -1617,6 +1811,10 @@
get_password1( $sync ) ;
get_password2( $sync ) ;
+# --dry1 make imapsync not fetching messages from host1, it is on when --dry is on.
+# Use --dry --nodry1 to make imapsync fetching messages from host1,
+# It is useful when debugging transformation options like --pipemess or --regexmess
+$sync->{dry1} = defined $sync->{dry1} ? $sync->{dry1} : $sync->{dry} ;
$sync->{dry_message} = q{} ;
if( $sync->{dry} ) {
@@ -1626,7 +1824,8 @@
$sync->{ search1 } ||= $search if ( $search ) ;
$sync->{ search2 } ||= $search if ( $search ) ;
-if ( $disarmreadreceipts ) {
+if ( $disarmreadreceipts )
+{
push @regexmess, q{s{\A((?:[^\n]+\r\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims} ;
}
@@ -1688,9 +1887,9 @@
myprint( "Ok with each --skipmess\n" ) ;
}
-if ( @regexflag ) {
+if ( $sync->{ regexflag } ) {
myprint( "Checking each --regexflag command with an space string.\n" ) ;
- my $string = flags_regex( q{ } ) ;
+ my $string = regexflags( $sync, q{ } ) ;
# string undef means one of the eval regex was bad.
if ( not ( defined $string ) ) {
$sync->{nb_errors}++ ;
@@ -1701,33 +1900,26 @@
myprint( "Ok with each --regexflag\n" ) ;
}
-$sync->{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->{imap1} = login_imap( $sync->{host1}, $sync->{port1}, $sync->{user1}, $sync->{password1},
+ $sync->{ssl1}, $sync->{tls1},
+ $uid1, $split1, $sync->{ acc1 }, $sync ) ;
-$sync->{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 ) ;
+$sync->{imap2} = login_imap( $sync->{host2}, $sync->{port2}, $sync->{user2}, $sync->{password2},
+ $sync->{ssl2}, $sync->{tls2},
+ $uid2, $split2, $sync->{ acc2 }, $sync ) ;
-$sync->{ debug } and myprint( 'Host1 Buffer I/O: ', $sync->{imap1}->Buffer(), "\n" ) ;
-$sync->{ debug } and myprint( 'Host2 Buffer I/O: ', $sync->{imap2}->Buffer(), "\n" ) ;
+$sync->{ debug } and $sync->{imap1} and myprint( 'Host1 Buffer I/O: ', $sync->{imap1}->Buffer(), "\n" ) ;
+$sync->{ debug } and $sync->{imap2} and myprint( 'Host2 Buffer I/O: ', $sync->{imap2}->Buffer(), "\n" ) ;
-if ( ! $sync->{imap1}->IsAuthenticated( ) )
+if ( ! $sync->{imap1} || ! $sync->{imap2} )
{
- $sync->{nb_errors}++ ;
- exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Not authenticated on host1\n" ) ;
+ exit_most_errors( $sync ) ;
}
+
+
myprint( "Host1: state Authenticated\n" ) ;
-
-if ( ! $sync->{imap2}->IsAuthenticated( ) )
-{
- $sync->{nb_errors}++ ;
- exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Not authenticated on host2\n" ) ;
-}
myprint( "Host2: state Authenticated\n" ) ;
myprint( 'Host1 capability once authenticated: ', join(q{ }, @{ $sync->{imap1}->capability() || [] }), "\n" ) ;
@@ -1886,29 +2078,17 @@
myprint( "Host1: Not checking that wanted folders exist. Remove --nocheckfoldersexist to get this check.\n" ) ;
}
+setcheckselectable( $sync ) ;
-if ( $sync->{ checkselectable } ) {
- my @h1_folders_wanted_selectable ;
- myprint( "Host1: Checking wanted folders are selectable. Use --nocheckselectable to avoid this check.\n" ) ;
- foreach my $folder ( @{ $sync->{h1_folders_wanted} } ) {
- ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "Checking $folder is selectable on host1\n" ) ;
- # It does an imap command LIST "" $folder and then search for no \Noselect
- if ( ! $sync->{imap1}->selectable( $folder ) ) {
- myprint( "Host1: warning! ignoring folder $folder because it is not selectable\n" ) ;
- }else{
- push @h1_folders_wanted_selectable, $folder ;
- }
- }
- @{ $sync->{h1_folders_wanted} } = @h1_folders_wanted_selectable ;
- ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( 'Host1: checking folders took ', timenext( $sync ), " s\n" ) ;
-}else{
- myprint( "Host1: Not checking that wanted folders are selectable. Remove --nocheckselectable to get this check.\n" ) ;
-}
+checkselectable( $sync ) ;
-# Old place of private_folders_separators_and_prefixes( ) call.
-#private_folders_separators_and_prefixes( ) ;
+# Bugfix OpenFind folders named like "kk \*123" are in fact "kk *123" (no \)
+#foreach my $folder ( @{ $sync->{ h1_folders_wanted } } )
+#{
+# $folder =~ s{ \\\*}{ *}g ;
+#}
# this hack is because LWP post does not pass well a hash in the $form parameter
@@ -2021,6 +2201,25 @@
myprint( "Host1: will not syncing empty folders on host1. Use --noskipemptyfolders to create them anyway on host2\n") ;
}
+if ( $sync->{ checknoabletosearch } )
+{
+ myprint( "Checking SEARCH ALL works on both accounts. To avoid that check, use --nochecknoabletosearch\n" ) ;
+ my $check1 = checknoabletosearch( $sync, $sync->{ imap1 }, 'INBOX', 'Host1' ) ;
+ my $check2 = checknoabletosearch( $sync, $sync->{ imap2 }, 'INBOX', 'Host2' ) ;
+ if ( $check1 or $check2 )
+ {
+ myprint( "At least one account can not SEARCH ALL. So acting like --noabletosearch\n" ) ;
+ $sync->{abletosearch} = 0 ;
+ $sync->{abletosearch1} = 0 ;
+ $sync->{abletosearch2} = 0 ;
+ }
+ else
+ {
+ myprint( "Good! SEARCH ALL works on both accounts.\n" ) ;
+ }
+}
+
+
if ( $sync->{ foldersizes } ) {
@@ -2035,7 +2234,7 @@
exit_clean( $sync, $EX_OK, "Exiting because of --justfoldersizes\n" ) ;
}
-$sync->{stats} = 1 ;
+$sync->{can_do_stats} = 1 ;
if ( $sync->{ delete1emptyfolders } ) {
delete1emptyfolders( $sync ) ;
@@ -2060,6 +2259,7 @@
{
$sync->{ h1_current_folder } = $h1_fold ;
eta_print( $sync ) ;
+ abortifneeded( $sync ) ;
if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
my $h2_fold = imap2_folder_name( $sync, $h1_fold ) ;
@@ -2075,10 +2275,15 @@
debugsleep( $sync ) ;
- my $h1_fold_nb_messages = count_from_select( $sync->{imap1}->History ) ;
- myprint( "Host1: folder [$h1_fold] has $h1_fold_nb_messages messages in total (mentioned by SELECT)\n" ) ;
+ my $h1_msgs_all_hash_ref ;
+ my @h1_msgs ;
+ my $h1_msgs_nb ;
+ my $h1_msgs_nb_from_select ;
- if ( $sync->{ skipemptyfolders } and 0 == $h1_fold_nb_messages ) {
+ $h1_msgs_nb_from_select = count_from_select( $sync->{imap1}->History ) ;
+ myprint( "Host1: folder [$h1_fold] has $h1_msgs_nb_from_select messages in total (mentioned by SELECT)\n" ) ;
+
+ if ( $sync->{ skipemptyfolders } and 0 == $h1_msgs_nb_from_select ) {
myprint( "Host1: skipping empty host1 folder [$h1_fold]\n" ) ;
next FOLDER ;
}
@@ -2087,22 +2292,32 @@
# Thanks jh1995
# Goal: do not create folder if --search or --max/minage return 0 message.
# even if there are messages by SELECT (no not real empty, empty for the user point of vue).
- if ( $sync->{ skipemptyfolders } )
+ if ( $sync->{ skipemptyfolders } or $sync->{ dry } )
{
- my $h1_msgs_all_hash_ref_tmp = { } ;
- my @h1_msgs_tmp = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref_tmp, $sync->{ search1 }, $h1_fold ) ;
- my $h1_fold_nb_messages_tmp = scalar( @h1_msgs_tmp ) ;
- if ( 0 == $h1_fold_nb_messages_tmp ) {
+ $h1_msgs_all_hash_ref = { } ;
+ @h1_msgs = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref, $sync->{ search1 }, $sync->{abletosearch1}, $h1_fold ) ;
+
+ $h1_msgs_nb = scalar( @h1_msgs ) ;
+ if ( 0 == $h1_msgs_nb and $sync->{ skipemptyfolders } ) {
myprint( "Host1: skipping empty host1 folder [$h1_fold] (0 message found by SEARCH)\n" ) ;
next FOLDER ;
}
}
if ( ! exists $h2_folders_all{ $h2_fold } ) {
- create_folder( $sync, $sync->{imap2}, $h2_fold, $h1_fold ) or next FOLDER ;
+ # In --dry mode I could count the messages to be transfered instead of 0
+ # Messages transferred : 0 (could be 0 without dry mode)
+ if ( ! create_folder( $sync, $sync->{imap2}, $h2_fold, $h1_fold ) )
+ {
+ if ( $sync->{ dry } )
+ {
+ $nb_msg_skipped_dry_mode += $h1_msgs_nb ;
+ }
+ next FOLDER ;
+ }
}
- acls_sync( $h1_fold, $h2_fold ) ;
+ acls_sync( $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)
@@ -2138,13 +2353,18 @@
if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
- my $h1_msgs_all_hash_ref = { } ;
- my @h1_msgs = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref, $sync->{ search1 }, $sync->{abletosearch1}, $h1_fold );
+
+ if ( ! defined $h1_msgs_nb )
+ {
+ $h1_msgs_all_hash_ref = { } ;
+ @h1_msgs = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref, $sync->{ search1 }, $sync->{abletosearch1}, $h1_fold );
+ $h1_msgs_nb = scalar @h1_msgs ;
+ }else{
+ # select_msgs already done.
+ }
if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
- my $h1_msgs_nb = scalar @h1_msgs ;
-
myprint( "Host1: folder [$h1_fold] considering $h1_msgs_nb messages\n" ) ;
( $sync->{ debug } or $debuglist ) and myprint( "Host1: folder [$h1_fold] considering $h1_msgs_nb messages, LIST gives: @h1_msgs\n" ) ;
$sync->{ debug } and myprint( "Host1: selecting messages of folder [$h1_fold] took ", timenext( $sync ), " s\n" ) ;
@@ -2188,7 +2408,7 @@
@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 @h2_msgs_in_cache = sort { $a <=> $b } keys %{ $cache_2_1_ref } ;
my ( %h1_msgs_not_in_cache, %h2_msgs_not_in_cache ) ;
%h1_msgs_not_in_cache = %h1_msgs ;
@@ -2196,9 +2416,9 @@
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 ;
+ my @h1_msgs_not_in_cache = sort { $a <=> $b } 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_not_in_cache = sort { $a <=> $b } keys %h2_msgs_not_in_cache ;
my @h2_msgs_delete2_not_in_cache = () ;
%h1_msgs_copy_by_uid = ( ) ;
@@ -2233,8 +2453,7 @@
}
else
{
- my $uidnext = $sync->{imap1}->uidnext( $h1_fold ) || $uidnext_default ;
- my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+ my $fetch_hash_uids = $fetch_hash_set || "1:*" ;
$h1_fir_ref = $sync->{imap1}->fetch_hash( $fetch_hash_uids, @h1_common_fetch_param, $h1_fir_ref )
if ( @h1_msgs ) ;
}
@@ -2260,22 +2479,30 @@
$sync->{ nb_msg_skipped } += 1 ;
$sync->{ h1_nb_msg_noheader } +=1 ;
$sync->{ h1_nb_msg_processed } +=1 ;
- } elsif(0 == $rc)
+ } elsif( 0 == $rc )
{
# duplicate
push @h1_msgs_duplicate, $m;
# duplicate, same id same size?
my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
- $sync->{ nb_msg_skipped } += 1;
- $h1_nb_msg_duplicate += 1;
- $sync->{ h1_nb_msg_processed } +=1 ;
+
+ $sync->{ acc1 }->{ nb_msg_duplicate } += 1;
+ if ( ! $sync->{ syncduplicates } ) {
+ $sync->{ nb_msg_skipped } += 1 ;
+ $sync->{ h1_nb_msg_processed } +=1 ;
+ }
}
}
+
+
my $h1_msgs_duplicate_nb = scalar @h1_msgs_duplicate ;
myprint( "Host1: folder [$h1_fold] selected $h1_msgs_nb messages, duplicates $h1_msgs_duplicate_nb\n" ) ;
$sync->{ debug } and myprint( 'Host1: whole time parsing headers took ', timenext( $sync ), " s\n" ) ;
+
+
+
# Getting headers and metada can be so long that host2 might be disconnected here
if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
@@ -2296,8 +2523,7 @@
if ( $sync->{abletosearch2} and scalar( @h2_msgs ) ) {
$h2_fir_ref = $sync->{imap2}->fetch_hash( \@h2_msgs, @h2_common_fetch_param, $h2_fir_ref) ;
}else{
- my $uidnext = $sync->{imap2}->uidnext( $h2_fold ) || $uidnext_default ;
- my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+ my $fetch_hash_uids = $fetch_hash_set || "1:*" ;
$h2_fir_ref = $sync->{imap2}->fetch_hash( $fetch_hash_uids, @h2_common_fetch_param, $h2_fir_ref )
if ( @h2_msgs ) ;
}
@@ -2313,7 +2539,7 @@
$h2_nb_msg_noheader += 1 ;
} elsif( 0 == $rc ) {
# duplicate
- $h2_nb_msg_duplicate += 1 ;
+ $sync->{ acc2 }->{ nb_msg_duplicate } += 1 ;
push @h2_msgs_duplicate, $m ;
}
}
@@ -2353,9 +2579,9 @@
foreach my $h2_msg ( @h2_msgs_duplicate ) {
myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $sync->{dry_message}\n" ) ;
push @h2_expunge, $h2_msg if $sync->{ uidexpunge2 } ;
- if ( ! $sync->{dry} ) {
- $sync->{imap2}->delete_message( $h2_msg ) ;
- $h2_nb_msg_deleted += 1 ;
+ if ( ! $sync->{ dry } ) {
+ $sync->{ imap2 }->delete_message( $h2_msg ) ;
+ $sync->{ acc2 }->{ nb_msg_deleted } += 1 ;
}
}
my $cnt = scalar @h2_expunge ;
@@ -2381,9 +2607,9 @@
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 $sync->{ uidexpunge2 };
- if ( ! ( $sync->{dry} or $isdel ) ) {
- $sync->{imap2}->delete_message($h2_msg);
- $h2_nb_msg_deleted += 1;
+ if ( ! ( $sync->{ dry } or $isdel ) ) {
+ $sync->{ imap2 }->delete_message( $h2_msg );
+ $sync->{ acc2 }->{ nb_msg_deleted } += 1;
}
}
}
@@ -2391,8 +2617,8 @@
myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $sync->{dry_message}\n" ) ;
push @h2_expunge, $h2_msg if $sync->{ uidexpunge2 };
if ( ! $sync->{dry} ) {
- $sync->{imap2}->delete_message($h2_msg);
- $h2_nb_msg_deleted += 1;
+ $sync->{ imap2 }->delete_message( $h2_msg );
+ $sync->{ acc2 }->{ nb_msg_deleted } += 1;
}
}
my $cnt = scalar @h2_expunge ;
@@ -2445,9 +2671,9 @@
}else{
myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted $sync->{dry_message}\n" ) ;
push @h2_expunge, $h2_msg if $sync->{ uidexpunge2 } ;
- if ( ! $sync->{dry} ) {
- $sync->{imap2}->delete_message( $h2_msg ) ;
- $h2_nb_msg_deleted += 1 ;
+ if ( ! $sync->{ dry} ) {
+ $sync->{ imap2 }->delete_message( $h2_msg ) ;
+ $sync->{ acc2 }->{ nb_msg_deleted } += 1 ;
}
}
}
@@ -2475,6 +2701,7 @@
my @h1_msgs_to_delete ;
MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) {
+ abortifneeded( $sync ) ;
if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
#myprint( "h1_nb_msg_processed: $sync->{ h1_nb_msg_processed }\n" ) ;
@@ -2510,7 +2737,7 @@
}
if ( total_bytes_max_reached( $sync ) ) {
- # a bug when using --delete1 --noexpungeaftereach
+ # Still a bug when using --delete1 --noexpungeaftereach
# same thing below on all total_bytes_max_reached!
last FOLDER ;
}
@@ -2558,7 +2785,7 @@
}
}
- if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
+ if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
if ( $sync->{ delete1 } ) {
push @h1_msgs_to_delete, $h1_msg ;
@@ -2566,6 +2793,7 @@
}
# END MESS: loop
+ # @h1_msgs_in_cache are already synced too.
delete_message_on_host1( $sync, $h1_fold, $sync->{ expunge1 }, @h1_msgs_to_delete, @h1_msgs_in_cache ) ;
if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
@@ -2595,6 +2823,7 @@
# MESS_BY_UID:
foreach my $h1_msg ( sort { $a <=> $b } keys %h1_msgs_copy_by_uid )
{
+ abortifneeded( $sync ) ;
$sync->{ debug } and myprint( "Copy by uid $h1_fold/$h1_msg\n" ) ;
if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }
@@ -2638,18 +2867,30 @@
foldersizesatend( $sync ) ;
}
+#$sync->{imap1}->State( 0 ); # Unconnected
if ( ! lost_connection( $sync, $sync->{imap1}, "for host1 [$sync->{host1}]" ) ) { $sync->{imap1}->logout( ) ; }
if ( ! lost_connection( $sync, $sync->{imap2}, "for host2 [$sync->{host2}]" ) ) { $sync->{imap2}->logout( ) ; }
-stats( $sync ) ;
-myprint( errorsdump( $sync->{nb_errors}, errors_log( $sync ) ) ) if ( $sync->{errorsdump} ) ;
-tests_live_result( $sync->{nb_errors} ) if ( $sync->{testslive} or $sync->{testslive6} ) ;
+do_and_print_stats( $sync ) ;
+
+
+if ( $sync->{errorsdump} and $sync->{nb_errors} )
+{
+ myprint( errors_listing( $sync ) ) ;
+}
+
+
+if ( $sync->{testslive} or $sync->{testslive6} )
+{
+ tests_live_result( $sync->{nb_errors} ) ;
+}
if ( $sync->{nb_errors} )
{
- exit_clean( $sync, $EXIT_WITH_ERRORS ) ;
+ my $exit_value = $EXIT_VALUE_OF_ERR_TYPE{ $sync->{most_common_error} } || $EXIT_CATCH_ALL ;
+ exit_clean( $sync, $exit_value ) ;
}
else
{
@@ -2768,9 +3009,56 @@
return $mysync->{ output } ;
}
-sub pidfile
+
+sub tests_print_output_if_needed
{
- my $mysync = shift ;
+ note( 'Entering tests_print_output_if_needed()' ) ;
+
+ is( undef, print_output_if_needed( ), 'print_output_if_needed: no args => undef' ) ;
+ my $mysync = { } ;
+ is( q{}, print_output_if_needed( $mysync ), 'print_output_if_needed: undef => undef' ) ;
+
+ output( $mysync, "Hello\n" ) ;
+ is( "Hello\n", print_output_if_needed( $mysync ), 'print_output_if_needed: Hello => Hello' ) ;
+
+ $mysync->{ dockercontext } = 1 ;
+ is( "Hello\n", print_output_if_needed( $mysync ), 'print_output_if_needed: dockercontext + Hello => Hello' ) ;
+
+ $mysync->{ version } = 1 ;
+ is( q{}, print_output_if_needed( $mysync ), 'print_output_if_needed: dockercontext + Hello + --version => ""' ) ;
+
+ $mysync->{ dockercontext } = 0 ;
+ is( "Hello\n", print_output_if_needed( $mysync ), 'print_output_if_needed: Hello + --version => Hello' ) ;
+
+ note( 'Leaving tests_print_output_if_needed()' ) ;
+ return ;
+}
+
+
+sub print_output_if_needed
+{
+
+ my $mysync = shift @ARG ;
+ if ( ! defined $mysync ) { return ; }
+ my $output = output( $mysync ) ;
+
+ if ( $mysync->{ version } && under_docker_context( $mysync ) )
+ {
+ return q{} ;
+ }
+ else
+ {
+ myprint( $output ) ;
+ return $output ;
+ }
+
+}
+
+
+
+sub define_pidfile
+{
+ my $mysync = shift @ARG ;
$mysync->{ pidfilelocking } = defined $mysync->{ pidfilelocking } ? $mysync->{ pidfilelocking } : 0 ;
@@ -2795,9 +3083,26 @@
}
$mysync->{ pidfile } = defined $mysync->{ pidfile } ? $mysync-> { pidfile } : $mysync->{ tmpdir } . "/$pidfile_basename" ;
+ $mysync->{ abortfile } = abortfile( $mysync, $PROCESS_ID ) ;
return ;
}
+sub abortfile
+{
+ my $mysync = shift @ARG ;
+ my $pid = shift @ARG ;
+
+ my $abortfile ;
+ if ( $mysync->{ abort } )
+ {
+ $abortfile = $mysync->{ pidfile } . "abort$pid" ;
+ }
+ else
+ {
+ $abortfile = $mysync->{ pidfile } . "abort$PROCESS_ID" ;
+ }
+ return $abortfile ;
+}
sub tests_kill_zero
{
@@ -2975,7 +3280,7 @@
my $pidtokill = shift ;
if ( ! $pidtokill ) {
- myprint( "No process to abort.\n" ) ;
+ myprint( "No process to kill.\n" ) ;
return ;
}
@@ -2989,7 +3294,7 @@
if ( kill( 'ZERO', $pidtokill ) or ( 'MSWin32' eq $OSNAME ) ) {
myprint( "Sending signal QUIT to PID $pidtokill \n" ) ;
kill 'QUIT', $pidtokill ;
- sleep 2 ;
+ sleep 3 ;
waitpid( $pidtokill, WNOHANG) ;
}else{
myprint( "Can not send signal kill ZERO to PID $pidtokill.\n" ) ;
@@ -3023,7 +3328,7 @@
sub tests_abort
{
note( 'Entering tests_abort()' ) ;
-
+ # Well, the abort behavior is tested by test.sh
is( undef, abort( ), 'abort: no args => undef' ) ;
note( 'Leaving tests_abort()' ) ;
return ;
@@ -3036,31 +3341,87 @@
{
my $mysync = shift @ARG ;
+ myprint( "In abort\n" ) ;
if ( not $mysync ) { return ; }
if ( ! -r $mysync->{pidfile} ) {
- myprint( "Can not read pidfile $mysync->{pidfile}. Exiting.\n" ) ;
- exit $EX_OK ;
+ myprint( "In abort: Can not read pidfile $mysync->{pidfile}\n" ) ;
+ return ;
}
my $pidtokill = firstline( $mysync->{pidfile} ) ;
if ( ! $pidtokill ) {
- myprint( "No process to abort. Exiting.\n" ) ;
- exit $EX_OK ;
+ myprint( "In abort: No process to abort in $mysync->{pidfile}\n" ) ;
+ return ;
}
- killpid( $pidtokill ) ;
+ if ( ! match_a_pid_number( $pidtokill ) )
+ {
+ myprint( "In abort: pid $pidtokill in $mysync->{pidfile} is not a pid number\n" ) ;
+ return ;
+ }
- # well, the abort job is done anyway, because even when not succeeded
- # in aborting another run, this run has to end without doing any
- # thing else
- exit $EX_OK ;
+ if ( $mysync->{abortbyfile} )
+ {
+ abortbyfile( $mysync, $pidtokill ) ;
+ }
+ else
+ {
+ killpid( $pidtokill ) ;
+ }
+ return ;
+}
+
+sub abortbyfile
+{
+ my $mysync = shift @ARG ;
+ my $pidtokill = shift @ARG ;
+
+ my $abortfile = abortfile( $mysync, $pidtokill ) ;
+ myprint( "touching $abortfile\n" ) ;
+ touch( $abortfile ) ;
+ return ;
+}
+
+
+sub tests_under_docker_context
+{
+ note( 'Entering tests_under_docker_context()' ) ;
+
+ is( undef, under_docker_context( ), 'under_docker_context: no args => undef' ) ;
+
+ my $mysync = { } ;
+ $mysync->{ dockercontext } = 1 ;
+ is( 1, under_docker_context( $mysync ), 'under_docker_context: --dockercontext => 1' ) ;
+ $mysync->{ dockercontext } = 0 ;
+ is( 0, under_docker_context( $mysync ), 'under_docker_context: --nodockercontext => 0' ) ;
+
+ $mysync = { } ;
+ # Is not it a stupid test?
+ if ( under_docker_context( $mysync ) )
+ {
+ is( 1, under_docker_context( $mysync ), 'under_docker_context: docker context => 1' ) ;
+ }
+ else
+ {
+ is( 0, under_docker_context( $mysync ), 'under_docker_context: not docker context => 0' ) ;
+ }
+
+ note( 'Leaving tests_under_docker_context()' ) ;
+ return ;
}
sub under_docker_context
{
my $mysync = shift ;
+
+ if ( ! defined $mysync ) { return ; }
+
+ if ( defined $mysync->{ dockercontext } )
+ {
+ return( $mysync->{ dockercontext } ) ;
+ }
if ( -e '/.dockerenv' )
{
@@ -3075,27 +3436,35 @@
}
-sub docker_context
+sub docker_context
{
- my $mysync = shift ;
-
- #-e '/.dockerenv' || return ;
+ my $mysync = shift ;
if ( ! under_docker_context( $mysync ) )
{
return ;
}
- $mysync->{ debug } and myprint( "Docker context detected with /.dockerenv\n" ) ;
- # No pidfile
- $mysync->{pidfile} = q{} ;
- # No log
- $mysync->{log} = 0 ;
- # In case
- $mysync->{ debug } and myprint( "Changing current directory to /var/tmp/\n" ) ;
- chdir '/var/tmp/' ;
+ output( $mysync, "Docker context detected with the file /.dockerenv\n" ) ;
+ # No pidfile by default
+
+ $mysync->{ pidfile } = defined( $mysync->{ pidfile } ) ? $mysync->{ pidfile } : q{} ;
+ # No log by default
+ if ( defined( $mysync->{ log } ) )
+ {
+ output( $mysync, "Logging in Docker context. Be sure you added access to it with a mount or similar. See https://docs.docker.com/storage/volumes/\n" ) ;
+ }
+ else
+ {
+ output( $mysync, "No log by default in Docker context. Use --log to trigger logging to the logfile.\n" ) ;
+ $mysync->{ log } = 0 ;
+ }
- return ;
+ # In case something is written relatively to .
+ output( $mysync, "Changing current directory to /var/tmp/\n" ) ;
+ chdir '/var/tmp/' ;
+
+ return ;
}
sub cgibegin
@@ -3151,7 +3520,7 @@
return ;
}
-sub cgibuildheader
+sub cgibuildheader
{
my $mysync = shift ;
if ( ! under_cgi_context( $mysync ) ) { return ; }
@@ -3166,7 +3535,7 @@
my $httpheader ;
if ( $mysync->{ abort } ) {
$httpheader = $mysync->{cgi}->header(
- -type => 'text/plain',
+ -type => 'text/plain; charset=UTF-8',
-status => '200 OK to abort syncing IMAP boxes' . ". Here is " . hostname(),
) ;
}elsif( $mysync->{ loaddelay } ) {
@@ -3174,7 +3543,7 @@
# 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',
+ -type => 'text/plain; charset=UTF-8',
-status => '503 Service Unavailable' . ". Be back in $mysync->{ loaddelay } min. Load on " . hostname() . " is $mysync->{ loadavg }",
) ;
}else{
@@ -3306,40 +3675,56 @@
return ;
}
-sub cgisetcontext
+sub buggyflagsregex
{
- my $mysync = shift ;
- if ( ! under_cgi_context( $mysync ) ) { return ; }
+ # From /X analyse
+ # cut -d: -f1 Error_112_all_syncs.txt | xargs egrep -oih 'Invalid system flag [^( ]+' | sort | uniq -c | sort -g
+ my @buggyflagsregex = ( 's/\\\\RECEIPTCHECKED|\\\\Indexed|\\\\X-EON-HAS-ATTACHMENT|\\\\UNSEEN|\\\\ATTACHED|\\\\X-HAS-ATTACH|\\\\FORWARDED|\\\\FORWARD|\\\\X-FORWARDED|\\\\\$FORWARDED|\\\\PRIORITY|\\\\READRCPT//g' ) ;
+ return( @buggyflagsregex ) ;
+}
- output( $mysync, "Under cgi context\n" ) ;
- set_umask( $mysync ) ;
+sub cgisetcontext
+{
+ my $mysync = shift ;
+ if ( ! under_cgi_context( $mysync ) ) { return ; }
+
+ output( $mysync, "Under cgi context\n" ) ;
+
+
+ set_umask( $mysync ) ;
# Remove all content in unsafe evaled options
@{ $mysync->{ regextrans2 } } = ( ) ;
- @regexflag = ( ) ;
+
+ @{ $mysync->{ regexflag } } = buggyflagsregex( ) ;
+
@regexmess = ( ) ;
@skipmess = ( ) ;
@pipemess = ( ) ;
$delete2foldersonly = undef ;
$delete2foldersbutnot = undef ;
- $maxlinelengthcmd = undef ;
+ $maxlinelengthcmd = undef ;
- # Set safe default values (I hope...)
+ # Set safe default values (I hope...)
#$mysync->{pidfile} = 'imapsync.pid' ;
- $mysync->{pidfilelocking} = 1 ;
- $mysync->{errorsmax} = $ERRORS_MAX_CGI ;
- $modulesversion = 0 ;
- $mysync->{releasecheck} = defined $mysync->{releasecheck} ? $mysync->{releasecheck} : 1 ;
- $usecache = 0 ;
- $mysync->{showpasswords} = 0 ;
- $debugimap1 = $debugimap2 = $debugimap = 0 ;
- $reconnectretry1 = $reconnectretry2 = $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
- $pipemesscheck = 0 ;
+ $mysync->{ pidfilelocking } = 1 ;
+ $mysync->{ errorsmax } = $ERRORS_MAX_CGI ;
+ $modulesversion = 0 ;
+ $mysync->{ releasecheck } = defined $mysync->{ releasecheck } ? $mysync->{ releasecheck } : 1 ;
+ $usecache = 0 ;
+ $mysync->{ showpasswords } = 0 ;
+ $mysync->{ acc1 }->{ debugimap } = 0 ;
+ $mysync->{ acc2 }->{ debugimap } = 0 ;
- $mysync->{hashfile} = $CGI_HASHFILE ;
- my $hashsynclocal = hashsynclocal( $mysync ) || die "Can not get hashsynclocal. Exiting\n" ;
+ $mysync->{ acc1 }->{ reconnectretry } = $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
+ $mysync->{ acc2 }->{ reconnectretry } = $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
+
+ $pipemesscheck = 0 ;
+
+ $mysync->{ hashfile } = $CGI_HASHFILE ;
+ my $hashsynclocal = hashsynclocal( $mysync ) || die "Can not get hashsynclocal. Exiting\n" ;
if ( $ENV{ 'NET_SERVER_SOFTWARE' } and ( $ENV{ 'NET_SERVER_SOFTWARE' } =~ /Net::Server::HTTP/ ) )
{
@@ -3352,7 +3737,8 @@
}
-d $cgidir or mkpath $cgidir or die "Can not create $cgidir: $OS_ERROR\n" ;
$mysync->{ tmpdir } = $cgidir ;
-
+ $mysync->{ logdir } = '' ;
+
chdir $cgidir or die "Can not cd to $cgidir: $OS_ERROR\n" ;
cgioutputenvcontext( $mysync ) ;
$mysync->{ debug } and output( $mysync, 'Current directory is ' . getcwd( ) . "\n" ) ;
@@ -3368,11 +3754,16 @@
$mysync->{ tail } = defined $mysync->{ tail } ? $mysync->{ tail } : 1 ;
# not sure it's for good
- @useheader = qw( Message-Id ) ;
+ @useheader = qw( Message-Id Received ) ;
# addheader on by default
$mysync->{ addheader } = defined $mysync->{ addheader } ? $mysync->{ addheader } : 1 ;
+
+ # sync duplicates by default in cgi context
+ $mysync->{ syncduplicates } = defined $mysync->{ syncduplicates } ? $mysync->{ syncduplicates } : 1 ;
+ # log the logfile name by default in cgi context
+ $mysync->{ loglogfile } = defined $mysync->{ loglogfile } ? $mysync->{ loglogfile } : 1 ;
return ;
}
@@ -3389,6 +3780,100 @@
return ;
}
+sub announcelogfile
+{
+ my $mysync = shift ;
+
+ if ( $mysync->{ log } )
+ {
+ myprint( "Log file is $mysync->{ logfile } ( to change it, use --logfile path ; or use --nolog to turn off logging )\n" ) ;
+ loglogfile( $mysync ) ;
+ }
+ else
+ {
+ myprint( "No log file because of option --nolog\n" ) ;
+ }
+ return ;
+}
+
+
+sub loglogfile
+{
+ my $mysync = shift ;
+ if ( ! $mysync->{ loglogfile } ) { return ; }
+ if ( ! $mysync->{ log } ) { return ; }
+
+ my $cwd = getcwd( ) ;
+ my $absolutelogfilepath ;
+ # Fixme: add case when the logfile name is already absolute
+ $absolutelogfilepath = "$cwd/$mysync->{ logfile }" ;
+ my $loglogfilename = '../list_all_logs_auto.txt' ;
+ myprint( "Writing log file name $absolutelogfilepath to $loglogfilename\n" ) ;
+ if ( open( my $fh, '>>', $loglogfilename ) )
+ {
+ print $fh "$absolutelogfilepath\n" ;
+ close $fh ;
+ }
+ else
+ {
+ myprint( "Could not open loglogfile $loglogfilename $!\n" ) ;
+ }
+ return ;
+}
+
+
+sub checkselectable
+{
+ my $mysync = shift ;
+
+ if ( $mysync->{ checkselectable } ) {
+ my @h1_folders_wanted_selectable ;
+ myprint( "Host1: Checking wanted folders are selectable. Use --nocheckselectable to avoid this check.\n" ) ;
+ foreach my $folder ( @{ $mysync->{ h1_folders_wanted } } )
+ {
+ ( $mysync->{ debug } or $mysync->{ debugfolders } ) and myprint( "Checking $folder is selectable on host1\n" ) ;
+ # It does an imap command LIST "" $folder and then search for no \Noselect
+ if ( ! $mysync->{ imap1 }->selectable( $folder ) )
+ {
+ myprint( "Host1: warning! ignoring folder $folder because it is not selectable\n" ) ;
+ }else
+ {
+ push @h1_folders_wanted_selectable, $folder ;
+ }
+ }
+ @{ $mysync->{ h1_folders_wanted } } = @h1_folders_wanted_selectable ;
+ ( $mysync->{ debug } or $mysync->{ debugfolders } )
+ and myprint( 'Host1: checking folders took ', timenext( $mysync ), " s\n" ) ;
+ }
+ else
+ {
+ myprint( "Host1: Not checking that wanted folders are selectable. Use --checkselectable to force this check.\n" ) ;
+ }
+ return ;
+}
+
+sub setcheckselectable
+{
+ my $mysync = shift ;
+
+ my $h1_folders_wanted_nb = scalar @{ $mysync->{ h1_folders_wanted } } ;
+ # 152 because 98% of host1 accounts have less than 152 folders on /X service.
+ # command to get this value:
+ # datamash_file_op_index G_Host1_Nb_folders.txt perc:98 4 %16.1f
+ if ( ! defined $mysync->{ checkselectable } )
+ {
+ if ( 152 >= $h1_folders_wanted_nb )
+ {
+ $mysync->{ checkselectable } = 1 ;
+ }else{
+ myprint( "Host1: Not checking that $h1_folders_wanted_nb wanted folders are selectable. Use --checkselectable to force this check.\n" ) ;
+ $mysync->{ checkselectable } = 0 ;
+ }
+ }
+ return ;
+}
+
+
sub debugsleep
{
@@ -3416,7 +3901,6 @@
# Globals:
-# $uidnext_default
# $fetch_hash_set
#
sub foldersize
@@ -3450,6 +3934,7 @@
my $biggest_in_folder = 0 ;
@{ $hash_ref }{ @msgs } = ( undef ) if @msgs ;
+
my $stot = 0 ;
if ( $imap->IsUnconnected( ) )
@@ -3467,8 +3952,7 @@
}
else
{
- my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
- my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+ my $fetch_hash_uids = $fetch_hash_set || "1:*" ;
if ( ! $imap->fetch_hash( $fetch_hash_uids, 'RFC822.SIZE', $hash_ref ) ) {
my $error = "$side failure with fetch_hash: $EVAL_ERROR\n" ;
errors_incr( $mysync, $error ) ;
@@ -3477,8 +3961,11 @@
}
for ( keys %{ $hash_ref } ) {
my $size = $hash_ref->{ $_ }->{ 'RFC822.SIZE' } ;
- $stot += $size ;
- $biggest_in_folder = max( $biggest_in_folder, $size ) ;
+ if ( defined $size )
+ {
+ $stot += $size ;
+ $biggest_in_folder = max( $biggest_in_folder, $size ) ;
+ }
}
}
return( $stot, $nb_msgs, $biggest_in_folder ) ;
@@ -3717,6 +4204,66 @@
return $x + $y ;
}
+sub tests_checknoabletosearch
+{
+ note( 'Entering checknoabletosearch()' ) ;
+
+ is( undef, checknoabletosearch( ), 'checknoabletosearch: no args => undef' ) ;
+
+ note( 'Leaving checknoabletosearch()' ) ;
+ return ;
+}
+
+
+
+
+sub checknoabletosearch
+{
+ # call example: checknoabletosearch( $sync, $sync->{ imap1 }, 'INBOX', 'Host1' ) ;
+ # output:
+ # * undef if something is not ok to decide
+ # * 1 if SEARCH ALL failed
+
+ my( $mysync, $imap, $folder, $HostX ) = @ARG ;
+
+ if ( ! all_defined( $mysync, $imap, $folder, $HostX ) )
+ {
+ return ;
+ }
+
+ myprint( "$HostX: checking if SEARCH ALL works on $folder\n" ) ;
+ if ( ! select_folder( $mysync, $imap, $folder, $HostX ) )
+ {
+ myprint( "$HostX: can not SELECT folder [$folder]\n" ) ;
+ return ;
+ }
+ my $count_from_select = count_from_select( $imap->History ) ;
+ myprint( "$HostX: folder [$folder] has $count_from_select messages mentioned by SELECT\n" ) ;
+
+ my $msgs_all = $imap->messages( ) ;
+ if ( ! $msgs_all )
+ {
+ myprint( "$HostX: can not SEARCH ALL folder [$folder]\n" ) ;
+ myprint( "$HostX: ", $imap->LastError(), "\n" ) ;
+ return 1 ;
+ }
+
+ my $count_from_search_all = scalar( @{ $msgs_all } ) ;
+ myprint( "$HostX: folder [$folder] has $count_from_search_all messages found by SEARCH ALL\n" ) ;
+
+ if ( $count_from_select == $count_from_search_all )
+ {
+ myprint( "$HostX: folder [$folder] has the same messages count ($count_from_select) by SELECT and SEARCH ALL\n" ) ;
+ }
+ else
+ {
+ myprint( "$HostX: Warning, folder [$folder] has not the same count by SELECT ($count_from_select) and SEARCH ALL ($count_from_search_all)\n" ) ;
+ return 1 ;
+ }
+
+ return ;
+}
+
sub foldersizes_diff_list
{
@@ -3864,7 +4411,7 @@
return ;
}
- my $h2_bytes_limit = $mysync->{h2}->{quota_limit_bytes} || 0 ;
+ my $h2_bytes_limit = $mysync->{ acc2 }->{quota_limit_bytes} || 0 ;
if ( $h2_bytes_limit and ( $h2_bytes_limit < $mysync->{ h1_bytes_start } ) )
{
my $quota_percent = mysprintf( '%.0f', $NUMBER_100 * $mysync->{ h1_bytes_start } / $h2_bytes_limit ) ;
@@ -3906,7 +4453,7 @@
return ;
}
- my $h2_bytes_limit = $mysync->{h2}->{quota_limit_bytes} || 0 ;
+ my $h2_bytes_limit = $mysync->{ acc2 }->{quota_limit_bytes} || 0 ;
if ( $h2_bytes_limit and ( $h2_bytes_limit < $mysync->{ h1_bytes_start } ) )
{
my $quota_percent = mysprintf( '%.0f', $NUMBER_100 * $mysync->{ h1_bytes_start } / $h2_bytes_limit ) ;
@@ -3917,15 +4464,51 @@
}
+sub tests_total_bytes_max_reached
+{
+ note( 'Entering tests_total_bytes_max_reached()' ) ;
+
+ is( undef, total_bytes_max_reached( ), 'total_bytes_max_reached: no args => undef' ) ;
+
+ my $mysync = {} ;
+ is( undef, total_bytes_max_reached( $mysync ), 'total_bytes_max_reached: no exitwhenover => undef' ) ;
+
+ $mysync->{ exitwhenover } = 300 ;
+ is( undef, total_bytes_max_reached( $mysync ), 'total_bytes_max_reached: exitwhenover 300 but no total_bytes_transferred => undef' ) ;
+
+ $mysync->{ total_bytes_transferred } = 200 ;
+ is( undef, total_bytes_max_reached( $mysync ), 'total_bytes_max_reached: exitwhenover 300 but total_bytes_transferred 200 => undef' ) ;
+
+ $mysync->{ total_bytes_transferred } = 400 ;
+ is( 1, total_bytes_max_reached( $mysync ), 'total_bytes_max_reached: exitwhenover 300 but total_bytes_transferred 400 => 1' ) ;
+
+
+
+ note( 'Leaving tests_total_bytes_max_reached()' ) ;
+ return ;
+}
+
+
sub total_bytes_max_reached
{
my $mysync = shift ;
- if ( ! $mysync->{ exitwhenover } ) {
- return( 0 ) ;
+ if ( ! defined $mysync ) { return ; }
+
+ if ( ! $mysync->{ exitwhenover } )
+ {
+ return ;
}
- if ( $mysync->{ total_bytes_transferred } >= $mysync->{ exitwhenover } ) {
- myprint( "Maximum bytes transferred reached, $mysync->{total_bytes_transferred} >= $mysync->{ exitwhenover }, ending sync\n" ) ;
+
+ if ( ! $mysync->{ total_bytes_transferred } )
+ {
+ return ;
+ }
+
+ if ( $mysync->{ total_bytes_transferred } >= $mysync->{ exitwhenover } )
+ {
+ my $error = "Maximum bytes transferred reached, $mysync->{total_bytes_transferred} >= $mysync->{ exitwhenover }, ending sync\n" ;
+ errors_incr( $mysync, $error ) ;
return( 1 ) ;
}
return ;
@@ -4166,7 +4749,7 @@
#myprint( Data::Dumper->Dump( [ \$myimap ] ) ) ;
my $appendlimit = capability_of( $myimap, 'APPENDLIMIT' ) ;
#myprint( "has_capability APPENDLIMIT $appendlimit\n" ) ;
- if ( is_an_integer( $appendlimit ) )
+ if ( is_integer( $appendlimit ) )
{
return $appendlimit ;
}
@@ -4291,8 +4874,6 @@
# Now --truncmess stuff
-
-
note( 'Leaving tests_maxsize_setting()' ) ;
return ;
@@ -4432,20 +5013,70 @@
sub tests_hashsync
{
- note( 'Entering tests_hashsync()' ) ;
+ note( 'Entering tests_hashsync()' ) ;
+
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hashsync( ), 'hashsync: no args' ) ;
+
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hashsync( {}, q{} ), 'hashsync: empty args' ) ;
+ my $mysync ;
+ $mysync->{ host1 } = 'zzz' ;
+ is( 'e86a28a3611c1e7bbaf8057cd00ae122781a11fe', hashsync( $mysync, q{} ), 'hashsync: host1 zzz => ' ) ;
+ is( '6a7b451ac99eab1531ad8e6cd544b32420c552ac', hashsync( $mysync, q{A} ), 'hashsync: host1 zzz => ' ) ;
+ $mysync->{ host2 } = 'zzz' ;
+ is( '15959573e4a86763253a7aedb1a2b0c60d133dc2', hashsync( $mysync, q{} ), 'hashsync: + host2 zzz => ' ) ;
+ is( 'b8d4ab541b209c75928528020ca28ee43488bd8f', hashsync( $mysync, 'A' ), 'hashsync: + hashkey A => ' ) ;
+
+ $mysync = undef ;
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hashsync( $mysync, q{} ), 'hashsync: undef $mysync' ) ;
+ $mysync->{ password1 } = 'abcd' ;
+ is( 'afa29ab8534495251ac8346a985717c54bc49c26', hashsync( $mysync, q{} ), 'hashsync: password1: abcd' ) ;
+
+ # A user reported a massive failure on /X (Thomas V. 21/04/2020 Ã 21:41 Subject: Error)
+ # "Wide character in subroutine entry at /usr/local/lib/perl5/site_perl/Digest/HMAC.pm"
+ # I can reproduce it now
- 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 => ' ) ;
+ # The eval is there to avoid a complete crash
+ # this one is fatal so it is commented
+ # is( 'f1a3f3dac3f137fd658027c11678b895f773ce55', 1 / 0 , 'hashsync: 1 / 0 fatal' ) ;
- note( 'Leaving tests_hashsync()' ) ;
- return ;
+ my $eval ;
+ # this one is not fatal
+ is( undef, $eval = eval { 1 / 0 } , 'hashsync: 1/0 not fatal' ) ;
+ # this one neither
+ $mysync->{ password1 } = 'Ö' ;
+ is( 'f1a3f3dac3f137fd658027c11678b895f773ce55', $eval = eval { hashsync( $mysync, q{} ) } , 'hashsync: password1: Ö with eval' ) ;
+
+ $mysync->{ password1 } = 'Ö' ;
+ is( 'f1a3f3dac3f137fd658027c11678b895f773ce55', hashsync( $mysync, q{} ), 'hashsync: password1: Ö without eval' ) ;
+
+ $mysync->{ password1 } = qq{\x{00D6}} ;
+ is( 'bb5bfb461e79ecd3dbc6ade2aabb52d22fa8be1a', $eval = eval { hashsync( $mysync, q{} ) }, 'hashsync: password1: \x{00D6}' ) ; #
+
+ print qq{1 00D6:Ö\n} ;
+ print encode_utf8( qq{2 00D6:Ö\n} ) ;
+ print qq{3 00D6:\x{00D6}\n} ;
+ print encode_utf8( qq{4 00D6:\x{00D6}\n} ) ;
+
+
+ print qq{5 6536:收\n} ;
+ print encode_utf8( qq{6 6536:收\n} ) ;
+ # the next one prints "Wide character in print at ./imapsync line xxxx"
+ print qq{7 6536:\x{6536}\n} ;
+ print encode_utf8( qq{8 6536:\x{6536}\n} ) ;
+
+ $mysync->{ password1 } = qq{收} ;
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', hashsync( $mysync, q{} ), 'hashsync: password1: 收' ) ;
+
+ $mysync->{ password1 } = qq{\x{6536}} ;
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', $eval = eval{ hashsync( $mysync, q{} ) }, 'hashsync: password1: \x{6536} with eval' ) ;
+
+ # No side effect.
+ $mysync->{ password1 } = 'abcd' ;
+ is( 'afa29ab8534495251ac8346a985717c54bc49c26', hashsync( $mysync, q{} ), 'hashsync: password1: abcd again' ) ;
+
+ note( 'Leaving tests_hashsync()' ) ;
+ return ;
}
sub hashsync
@@ -4461,12 +5092,119 @@
$mysync->{ user2 } || q{},
$mysync->{ password2 } || q{},
) ;
- my $hashsync = hmac_sha1_hex( $mystring, $hashkey ) ;
+ #my $hashsync = hmac_sha1_hex( $mystring, $hashkey ) ;
+ my $hashsync = hmac_sha1_hex_robust( $mystring, $hashkey ) ;
#myprint( "$hashsync\n" ) ;
return( $hashsync ) ;
}
+sub tests_hmac_sha1_hex
+{
+ note( 'Entering tests_hmac_sha1_hex()' ) ;
+
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex( ), 'hmac_sha1_hex: no args => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex( '' ), 'hmac_sha1_hex: empty string => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex( '', '' ), 'hmac_sha1_hex: empty strings => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex( '', '', 'caca' ), 'hmac_sha1_hex: empty strings + caca => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+
+ # Good
+ is( 'f1a3f3dac3f137fd658027c11678b895f773ce55', hmac_sha1_hex( 'Ö' ), 'hmac_sha1_hex: Ö => f1a3f3dac3f137fd658027c11678b895f773ce55' ) ;
+ is( 'f1a3f3dac3f137fd658027c11678b895f773ce55', hmac_sha1_hex( encode_utf8(qq{\x{00D6}}) ), 'hmac_sha1_hex: encode_utf8 \x{00D6} => f1a3f3dac3f137fd658027c11678b895f773ce55' ) ;
+ # Bad
+ is( 'fe8dc3b9ba3e8850bb4a7b070b2279e911003af2', hmac_sha1_hex( encode_utf8( 'Ö' ) ), 'hmac_sha1_hex: encode_utf8 Ö => fe8dc3b9ba3e8850bb4a7b070b2279e911003af2' ) ;
+ is( 'bb5bfb461e79ecd3dbc6ade2aabb52d22fa8be1a', hmac_sha1_hex( qq{\x{00D6}} ), 'hmac_sha1_hex: qq{\x{00D6}} => bb5bfb461e79ecd3dbc6ade2aabb52d22fa8be1a' ) ;
+
+ # Good
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex( 'A' ), 'hmac_sha1_hex: A => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex( encode_utf8(qq{\x{0041}}) ), 'hmac_sha1_hex: encode_utf8 \x{0041} => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex( encode_utf8( 'A' ) ), 'hmac_sha1_hex: encode_utf8 A => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex( qq{\x{0041}} ), 'hmac_sha1_hex: \x{0041} => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+
+ # Good
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex( 'A', 'B' ), 'hmac_sha1_hex: A B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex( encode_utf8(qq{\x{0041}}), 'B' ), 'hmac_sha1_hex: encode_utf8 \x{0041} B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex( encode_utf8( 'A' ), 'B' ), 'hmac_sha1_hex: encode_utf8 A B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex( qq{\x{0041}}, 'B' ), 'hmac_sha1_hex: \x{0041} B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+
+ # http://unicode.scarfboy.com/?s=U%2B6536
+ # Good
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', hmac_sha1_hex( '收' ), 'hmac_sha1_hex: 收 => 4199f02773d1cd5599b1a8f2d024bdceb8b48e0b' ) ;
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', hmac_sha1_hex( encode_utf8(qq{\x{6536}}) ), 'hmac_sha1_hex: encode_utf8 \x{6536} => 4199f02773d1cd5599b1a8f2d024bdceb8b48e0b' ) ;
+ # Bad
+ is( 'e82217119628ad03e659cc89671d05ea4cee7238', hmac_sha1_hex( encode_utf8( '收' ) ), 'hmac_sha1_hex: encode_utf8 收 => e82217119628ad03e659cc89671d05ea4cee7238' ) ;
+ # Very very bad, perl dies...
+ #is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', hmac_sha1_hex( qq{\x{6536}} ), 'hmac_sha1_hex: \x{6536} => 4199f02773d1cd5599b1a8f2d024bdceb8b48e0b' ) ;
+ # Ok but well, bad indeed
+ is( undef, my $eval = eval{ hmac_sha1_hex( qq{\x{6536}} ) }, 'hmac_sha1_hex: \x{6536} => undef' ) ;
+
+
+ note( 'Leaving tests_hmac_sha1_hex()' ) ;
+ return ;
+}
+
+sub tests_hmac_sha1_hex_robust
+{
+ note( 'Entering tests_hmac_sha1_hex_robust()' ) ;
+
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex_robust( ), 'hmac_sha1_hex_robust: no args => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex_robust( '' ), 'hmac_sha1_hex_robust: empty string => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex_robust( '', '' ), 'hmac_sha1_hex_robust: empty strings => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+ is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hmac_sha1_hex_robust( '', '', 'caca' ), 'hmac_sha1_hex_robust: empty strings + caca => fbdb1d1b18aa6c08324b7d64b71fb76370690e1d' ) ;
+
+ # Good
+ is( 'f1a3f3dac3f137fd658027c11678b895f773ce55', hmac_sha1_hex_robust( 'Ö' ), 'hmac_sha1_hex_robust: Ö => f1a3f3dac3f137fd658027c11678b895f773ce55' ) ;
+ is( 'f1a3f3dac3f137fd658027c11678b895f773ce55', hmac_sha1_hex_robust( encode_utf8(qq{\x{00D6}}) ), 'hmac_sha1_hex_robust: encode_utf8 \x{00D6} => f1a3f3dac3f137fd658027c11678b895f773ce55' ) ;
+ # Bad
+ is( 'fe8dc3b9ba3e8850bb4a7b070b2279e911003af2', hmac_sha1_hex_robust( encode_utf8( 'Ö' ) ), 'hmac_sha1_hex_robust: encode_utf8 Ö => fe8dc3b9ba3e8850bb4a7b070b2279e911003af2' ) ;
+ is( 'bb5bfb461e79ecd3dbc6ade2aabb52d22fa8be1a', hmac_sha1_hex_robust( qq{\x{00D6}} ), 'hmac_sha1_hex_robust: qq{\x{00D6}} => bb5bfb461e79ecd3dbc6ade2aabb52d22fa8be1a' ) ;
+
+ # Good
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex_robust( 'A' ), 'hmac_sha1_hex_robust: A => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex_robust( encode_utf8(qq{\x{0041}}) ), 'hmac_sha1_hex_robust: encode_utf8 \x{0041} => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex_robust( encode_utf8( 'A' ) ), 'hmac_sha1_hex_robust: encode_utf8 A => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+ is( 'a6fda2a6acdd74630b20aac0c68716048ecd0333', hmac_sha1_hex_robust( qq{\x{0041}} ), 'hmac_sha1_hex_robust: \x{0041} => a6fda2a6acdd74630b20aac0c68716048ecd0333' ) ;
+
+ # Good
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex_robust( 'A', 'B' ), 'hmac_sha1_hex_robust: A B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex_robust( encode_utf8(qq{\x{0041}}), 'B' ), 'hmac_sha1_hex_robust: encode_utf8 \x{0041} B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex_robust( encode_utf8( 'A' ), 'B' ), 'hmac_sha1_hex_robust: encode_utf8 A B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+ is( '36c54f255b575a2db58921d116b37c8af94c08cd', hmac_sha1_hex_robust( qq{\x{0041}}, 'B' ), 'hmac_sha1_hex_robust: \x{0041} B => 36c54f255b575a2db58921d116b37c8af94c08cd' ) ;
+
+ # http://unicode.scarfboy.com/?s=U%2B6536
+ # Good
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', hmac_sha1_hex_robust( '收' ), 'hmac_sha1_hex_robust: 收 => 4199f02773d1cd5599b1a8f2d024bdceb8b48e0b' ) ;
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', hmac_sha1_hex_robust( encode_utf8(qq{\x{6536}}) ), 'hmac_sha1_hex_robust: encode_utf8 \x{6536} => 4199f02773d1cd5599b1a8f2d024bdceb8b48e0b' ) ;
+ # Bad
+ is( 'e82217119628ad03e659cc89671d05ea4cee7238', hmac_sha1_hex_robust( encode_utf8( '收' ) ), 'hmac_sha1_hex_robust: encode_utf8 收 => e82217119628ad03e659cc89671d05ea4cee7238' ) ;
+ # Good
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', hmac_sha1_hex_robust( qq{\x{6536}} ), 'hmac_sha1_hex_robust: \x{6536} => 4199f02773d1cd5599b1a8f2d024bdceb8b48e0b' ) ;
+ # Good again
+ is( '4199f02773d1cd5599b1a8f2d024bdceb8b48e0b', my $eval = eval{ hmac_sha1_hex_robust( qq{\x{6536}} ) }, 'hmac_sha1_hex_robust: \x{6536} => undef' ) ;
+
+ note( 'Leaving tests_hmac_sha1_hex_robust()' ) ;
+ return ;
+}
+
+
+sub hmac_sha1_hex_robust
+{
+ my $string = shift ;
+ my $val ;
+ if ( defined( $val = eval{ hmac_sha1_hex( $string, @ARG ) } ) )
+ {
+ return $val ;
+ }
+ elsif( defined( $val = eval{ hmac_sha1_hex( encode_utf8( $string ), @ARG ) } ) )
+ {
+ return $val ;
+ }
+ else
+ {
+ return ;
+ }
+}
+
sub tests_createhashfileifneeded
{
note( 'Entering tests_createhashfileifneeded()' ) ;
@@ -4588,7 +5326,7 @@
vendor => 'Gilles LAMIRAL',
'support-url' => 'https://imapsync.lamiral.info/',
# Example of date-time: 19-Sep-2015 08:56:07
- date => date_from_rcs( q{$Date: 2019/12/23 20:18:02 $ } ),
+ date => date_from_rcs( q{$Date: 2021/07/22 14:21:09 $ } ),
} ;
my $imapsync_id_github = {
@@ -4597,7 +5335,7 @@
os => $OSNAME,
vendor => 'github',
'support-url' => 'https://github.com/imapsync/imapsync',
- date => date_from_rcs( q{$Date: 2019/12/23 20:18:02 $ } ),
+ date => date_from_rcs( q{$Date: 2021/07/22 14:21:09 $ } ),
} ;
$imapsync_id = $imapsync_id_lamiral ;
@@ -5003,12 +5741,16 @@
$mysync->{errorsmax} ||= $ERRORS_MAX ;
if ( $mysync->{nb_errors} >= $mysync->{errorsmax} ) {
myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to any value, for example 100 with --errorsmax 100 ). Exiting.\n" ) ;
+ my $most_common_error = errorsanalyse( errors_log( $mysync ) ) ;
if ( $mysync->{errorsdump} ) {
- myprint( errorsdump( $mysync->{nb_errors}, errors_log( $mysync ) ) ) ;
+ myprint( errorsdump( errors_log( $mysync ) ) ) ;
+ myprint( "The most frequent error is $most_common_error\n" ) ;
# again since errorsdump( ) can be very verbose and masquerade previous warning
myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to any value, for example 100 with --errorsmax 100 ). Exiting.\n" ) ;
}
- exit_clean( $mysync, $EXIT_WITH_ERRORS_MAX ) ;
+ my $exit_value = $EXIT_VALUE_OF_ERR_TYPE{ $most_common_error } || $EXIT_CATCH_ALL ;
+ #exit_clean( $mysync, $EXIT_WITH_ERRORS_MAX ) ;
+ exit_clean( $mysync, $exit_value ) ;
}
return ;
}
@@ -5048,14 +5790,288 @@
}
+sub tests_error_type
+{
+ note( 'Entering tests_error_type()' ) ;
+
+ is( 'ERR_NOTHING_REPORTED', error_type( ), 'error_type: no args => ERR_NOTHING_REPORTED' ) ;
+ is( 'ERR_NOTHING_REPORTED', error_type( '' ), 'error_type: empty string => ERR_NOTHING_REPORTED' ) ;
+
+ is( 'ERR_UNCLASSIFIED', error_type( 'ERR_UNCLASSIFIED' ), 'error_type: ERR_UNCLASSIFIED => ERR_UNCLASSIFIED' ) ;
+ is( 'ERR_UNCLASSIFIED', error_type( 'aie' ), 'error_type: aie => ERR_UNCLASSIFIED' ) ;
+ is( 'ERR_UNCLASSIFIED', error_type( 'ouille' ), 'error_type: ouille => ERR_UNCLASSIFIED' ) ;
+
+ is( 'ERR_Host1_FETCH', error_type( 'Message xxx could not be fetched: blabla' ),
+ 'error_type: could not be fetched => ERR_Host1_FETCH'
+ ) ;
+
+ is( 'ERR_APPEND_SIZE',
+ error_type( 'could not append message xxx: BAD maximum message size exceeded' ),
+ 'error_type: could not append message xxx: BAD maximum message size exceeded => ERR_APPEND_SIZE'
+ ) ;
+
+ is( 'ERR_OVERQUOTA',
+ error_type( 'Quota limit will be exceeded' ),
+ 'error_type: Quota limit will be exceeded => ERR_OVERQUOTA'
+ ) ;
+
+ is( 'ERR_APPEND', error_type( 'could not append' ), 'error_type: could not append => ERR_APPEND' ) ;
+
+ is( 'ERR_CREATE',
+ error_type( 'Could not create folder' ),
+ 'error_type: Could not create folder => ERR_CREATE'
+ ) ;
+
+ is( 'ERR_SELECT',
+ error_type( 'Could not select: blabla' ),
+ 'error_type: Could not select: blabla => ERR_SELECT'
+ ) ;
+
+
+ #
+ #Maximum bytes transferred reached, 423 >= 100, ending sync
+ is( 'ERR_TRANSFER_EXCEEDED',
+ error_type( 'Maximum bytes transferred reached, blabla' ),
+ 'error_type: Maximum bytes transferred reached, blabla => ERR_TRANSFER_EXCEEDED'
+ ) ;
+
+ #
+ is( 'ERR_CONNECTION_FAILURE_HOST1',
+ error_type( 'Host1 failure: can not open imap connection on host1 [badhostkaka] with user [tata]: Unable to connect to badhostkaka: Invalid argument' ),
+ 'error_type: can not open imap connection on host1 => ERR_CONNECTION_FAILURE_HOST1'
+ ) ;
+
+ is( 'ERR_CONNECTION_FAILURE_HOST2',
+ error_type( 'Host2 failure: can not open imap connection on host2 [badhostkiki] with user [titi]: Unable to connect to badhostkiki: Invalid argument' ),
+ 'error_type: can not open imap connection on host2 => ERR_CONNECTION_FAILURE_HOST2'
+ ) ;
+
+ is( 'ERR_APPEND_VIRUS',
+ error_type( 'could not append ( Subject:[For Your Consideration], Date:["29-Nov-2016 03:21:10 -0800"], Size:[5505], Flags:[\Seen] ) to folder INBOX: 275 NO Message refused because it contains a virus' ),
+ 'error_type: could not append ... virus => ERR_APPEND_VIRUS'
+ ) ;
+
+ note( 'Leaving tests_error_type()' ) ;
+ return ;
+}
+
+
+
+# Could be implemented with https://metacpan.org/pod/Tie::RegexpHash
+# with just a hash of error regexes as keys and types as values.
+
+sub error_type
+{
+ my $error = shift ;
+
+ if ( ! defined $error ) { return 'ERR_NOTHING_REPORTED' ; }
+ if ( ! $error ) { return 'ERR_NOTHING_REPORTED' ; }
+
+ #
+ if ( $error =~ m{Host1 failure: Error login on} ) { return 'ERR_AUTHENTICATION_FAILURE_USER1' } ;
+ if ( $error =~ m{Host2 failure: Error login on} ) { return 'ERR_AUTHENTICATION_FAILURE_USER2' } ;
+
+ if ( $error =~ m{Host. failure: Can not go to tls encryption on host.} ) { return 'ERR_EXIT_TLS_FAILURE' } ;
+ #
+
+ if ( $error =~ m{could not be fetched:} ) { return 'ERR_Host1_FETCH' } ;
+
+ # could not append .*BAD maximum message size exceeded
+ # could not append.*Maximum size of appendable message has been exceeded
+ if ( $error =~ m{could not append .*BAD maximum message size exceeded} )
+ { return 'ERR_APPEND_SIZE' ; } ;
+
+ if ( $error =~ m{could not append.*Maximum size of appendable message has been exceeded} )
+ { return 'ERR_APPEND_SIZE' ; } ;
+
+ # Could not create folder *[OVERQUOTA] Not enough disk quota
+ # could not append .*[OVERQUOTA] Not enough disk quota
+ # could not append .*[OVERQUOTA] Mailbox is full / Blocks limit exceeded / Inode limit exceeded
+ if ( $error =~ m{OVERQUOTA} ) { return 'ERR_OVERQUOTA' ; } ;
+ if ( $error =~ m{Quota limit will be exceeded} ) { return 'ERR_OVERQUOTA' ; } ;
+ if ( $error =~ m{full: it is time to find a bigger place} ) { return 'ERR_OVERQUOTA' ; } ;
+
+ # could not append ... to folder INBOX: 276 NO Message refused because it contains a virus
+ if ( $error =~ m{could not append.*virus} )
+ { return 'ERR_APPEND_VIRUS' ; } ;
+
+ # could not append .*Write failed 'Broken pipe'
+ # could not append .*timeout waiting .* for data from server
+ # could not append .*BAD Invalid Arguments: Unable to parse message
+ # could not append .*BAD Command Argument Error. 11
+ # could not append .*NO header limit reached
+ if ( $error =~ m{could not append} ) { return 'ERR_APPEND' ; } ;
+
+ # Could not create folder .*Invalid mailbox name
+ if ( $error =~ m{Could not create folder} ) { return 'ERR_CREATE' ; } ;
+
+
+ # Could not select:.*NO [NOPERM] Permission denied
+ # Could not select:.*NO Mailbox doesn't exist
+ # Could not select:.*NO [SERVERBUG] Internal error occurred.
+ # Could not select:.*[CANNOT] Mailbox isn't a valid mbox file
+ if ( $error =~ m{Could not select:} ) { return 'ERR_SELECT' ; } ;
+
+ #Maximum bytes transferred reached, 423 >= 100, ending sync
+ if ( $error =~ m{Maximum bytes transferred reached} ) { return 'ERR_TRANSFER_EXCEEDED' ; } ;
+
+ if ( $error =~ m{can not open imap connection on host1} ) { return 'ERR_CONNECTION_FAILURE_HOST1' ; } ;
+ if ( $error =~ m{can not open imap connection on host2} ) { return 'ERR_CONNECTION_FAILURE_HOST2' ; } ;
+
+ # Default is ERR_UNCLASSIFIED
+ return 'ERR_UNCLASSIFIED' ;
+
+}
+
+sub tests_errorclassify
+{
+ note( 'Entering tests_errorclassify()' ) ;
+
+ is( undef, errorclassify( ), 'errorclassify: no args => undef' ) ;
+
+ is_deeply( { 'ERR_UNCLASSIFIED' => 1 }, errorclassify( 'aie' ), 'errorclassify: aie => { ERR_UNCLASSIFIED => 1 }' ) ;
+ is_deeply( { 'ERR_UNCLASSIFIED' => 2 }, errorclassify( 'aie', 'ouille' ), 'errorclassify: aie ouille => { ERR_UNCLASSIFIED => 2 }' ) ;
+ is_deeply( { 'ERR_UNCLASSIFIED' => 2, 'ERR_NOTHING_REPORTED' => 1 }, errorclassify( 'aie', 'ouille', '' ), 'errorclassify: aie ouille "" => { ERR_UNCLASSIFIED => 2 }' ) ;
+ is_deeply( { 'ERR_UNCLASSIFIED' => 3 }, errorclassify( 'aie', 'ouille', 'aie' ), 'errorclassify: aie ouille aie => { ERR_UNCLASSIFIED => 3 }' ) ;
+ is_deeply( { 'ERR_UNCLASSIFIED' => 1, 'ERR_OVERQUOTA' => 2 }, errorclassify( 'aie', 'OVERQUOTA pipi', 'OVERQUOTA caca' ), 'errorclassify: aie OVERQUOTA OVERQUOTA' ) ;
+ is_deeply( { 'ERR_NOTHING_REPORTED' => 1 }, errorclassify( '' ), 'errorclassify: "" => { ERR_NOTHING_REPORTED => 1 }' ) ;
+ is_deeply( { 'ERR_NOTHING_REPORTED' => 2 }, errorclassify( '', '' ), 'errorclassify: "", "" => { ERR_NOTHING_REPORTED => 1 }' ) ;
+
+ note( 'Leaving tests_errorclassify()' ) ;
+ return ;
+}
+
+
+
+sub errorclassify
+{
+ my @errors = @ARG ;
+
+ if ( ! @errors ) { return ; } ;
+
+ my $error_type_count = { } ;
+ foreach my $error ( @errors )
+ {
+ my $error_type = error_type( $error ) ;
+ $error_type_count->{ $error_type }++ ;
+ }
+
+ return $error_type_count ;
+}
+
+sub tests_most_common_error
+{
+ note( 'Entering tests_most_common_error()' ) ;
+
+ is( 'ERR_NOTHING_REPORTED', most_common_error( ), 'most_common_error: no args => ERR_NOTHING_REPORTED' ) ;
+ is( 'ERR_NOTHING_REPORTED', most_common_error( {} ), 'most_common_error: empty hash ref => ERR_NOTHING_REPORTED' ) ;
+ is( 'ERR_NOTHING_REPORTED', most_common_error( 'blabla' ), 'most_common_error: not a hash ref => ERR_NOTHING_REPORTED' ) ;
+
+ is( 'ERR_FOO', most_common_error( { ERR_FOO => 1 } ), 'most_common_error: { ERR_FOO => 1 } => ERR_FOO' ) ;
+ is( 'ERR_BAR', most_common_error( { ERR_FOO => 1, ERR_BAR => 2 } ), 'most_common_error: { ERR_FOO => 1, ERR_BAR => 2 } => ERR_BAR' ) ;
+ is( 'ERR_FOO', most_common_error( { ERR_FOO => 2, ERR_BAR => 1 } ), 'most_common_error: { ERR_FOO => 2, ERR_BAR => 1 } => ERR_FOO' ) ;
+ # exaequo => first lexical wins. ERR_BAR <= ERR_FOO
+ is( 'ERR_BAR', most_common_error( { ERR_FOO => 2, ERR_BAR => 2 } ), 'most_common_error: { ERR_FOO => 2, ERR_BAR => 2 } => ERR_BAR' ) ;
+
+ is( 'A', most_common_error( { A => 5, B => 5, C => 5 } ), 'most_common_error: { A => 5, B => 5, C => 5 } => A' ) ;
+ is( 'B', most_common_error( { A => 5, B => 6, C => 6 } ), 'most_common_error: { A => 5, B => 6, C => 6 } => B' ) ;
+ is( 'C', most_common_error( { A => 5, B => 5, C => 7 } ), 'most_common_error: { A => 5, B => 5, C => 7 } => C' ) ;
+ is( 'C', most_common_error( { A => 5, B => 6, C => 7 } ), 'most_common_error: { A => 5, B => 5, C => 7 } => C' ) ;
+
+ note( 'Leaving tests_most_common_error()' ) ;
+ return ;
+}
+
+
+
+sub most_common_error
+{
+ my $errors_counted_ref = shift ;
+
+ if ( ! defined $errors_counted_ref ) { return 'ERR_NOTHING_REPORTED' ; }
+
+ if ( 'HASH' ne ref $errors_counted_ref ) { return 'ERR_NOTHING_REPORTED' ; }
+
+ # empty hash
+ if ( !%{ $errors_counted_ref } ) { return 'ERR_NOTHING_REPORTED' ; }
+
+ # non empty hash
+ my $most_common_error = ( sort
+ {
+ $errors_counted_ref->{$b} <=> $errors_counted_ref->{$a}
+ || $a cmp $b
+ } keys %{$errors_counted_ref} )[0] ;
+
+ return $most_common_error ;
+
+}
+
+
+
+sub tests_errorsanalyse
+{
+ note( 'Entering tests_errorsanalyse()' ) ;
+
+ is( 'ERR_NOTHING_REPORTED', errorsanalyse( ), 'errorsanalyse: no args => ERR_NOTHING_REPORTED' ) ;
+ is( 'ERR_NOTHING_REPORTED', errorsanalyse( ( ) ), 'errorsanalyse: empty list => ERR_NOTHING_REPORTED' ) ;
+ is( 'ERR_UNCLASSIFIED', errorsanalyse( 'aie' ), 'errorsanalyse: aie => ERR_UNCLASSIFIED' ) ;
+
+ # in case of equality, empty wins
+ is( 'ERR_NOTHING_REPORTED', errorsanalyse( 'aie', '' ), 'errorsanalyse: aie => ERR_UNCLASSIFIED' ) ;
+ is( 'ERR_NOTHING_REPORTED', errorsanalyse( '', 'aie' ), 'errorsanalyse: aie => ERR_UNCLASSIFIED' ) ;
+
+
+ is( 'ERR_UNCLASSIFIED', errorsanalyse( 'aie', 'ouille' ), 'errorsanalyse: aie, ouille => ERR_UNCLASSIFIED' ) ;
+ is( 'ERR_UNCLASSIFIED', errorsanalyse( 'aie', 'ouille', '' ), 'errorsanalyse: aie, ouille, "" => ERR_UNCLASSIFIED' ) ;
+ is( 'ERR_UNCLASSIFIED', errorsanalyse( '', 'aie', 'ouille' ), 'errorsanalyse: aie, ouille, "" => ERR_UNCLASSIFIED' ) ;
+
+ is( 'ERR_NOTHING_REPORTED', errorsanalyse( '' ), 'errorsanalyse: "" => ERR_NOTHING_REPORTED' ) ;
+ is( 'ERR_NOTHING_REPORTED', errorsanalyse( ( '' ) ), 'errorsanalyse: ( "" ) => ERR_NOTHING_REPORTED' ) ;
+ is( 'ERR_NOTHING_REPORTED', errorsanalyse( ( '', '' ) ), 'errorsanalyse: ( "", "" ) => ERR_NOTHING_REPORTED' ) ;
+
+ note( 'Leaving tests_errorsanalyse()' ) ;
+ return ;
+}
+
+
+
+sub errorsanalyse
+{
+ my @errors = @ARG ;
+ my $errors_types_counted = errorclassify( @errors ) ;
+
+ my $most_common_error = most_common_error( $errors_types_counted ) ;
+
+ return $most_common_error ;
+}
+
+
+
+sub tests_errorsdump
+{
+ note( 'Entering tests_errorsdump()' ) ;
+
+ is( undef, errorsdump( ), 'errorsdump: no args => undef' ) ;
+ is( undef, errorsdump( ( ) ), 'errorsdump: empty list => undef' ) ;
+ is( "Err 1/1: ", errorsdump( '' ), 'errorsdump: one empty string => "Err 1/1: "' ) ;
+ is( "Err 1/1: aieaieaie", errorsdump( 'aieaieaie' ), 'errorsdump: aieaieaie => "Err 1/1: aieaieaie"' ) ;
+ is( "Err 1/2: Aie Err 2/2: Ouille", errorsdump( 'Aie ', 'Ouille' ), 'errorsdump: Aie Ouille => "Err 1/2: Aie Err 2/2: Ouille"' ) ;
+ note( 'Leaving tests_errorsdump()' ) ;
+ return ;
+}
+
+
sub errorsdump
{
- my( $nb_errors, @errors_log ) = @ARG ;
+ if ( ! @ARG ) { return ; }
+
+ my @errors_log = @ARG ;
+ my $nb_errors = @errors_log ;
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 ) {
+ foreach my $error ( @errors_log )
+ {
$error_num++ ;
$errors_list .= "Err $error_num/$nb_errors: $error" ;
}
@@ -5064,9 +6080,26 @@
}
+
+sub errors_listing
+{
+ my $mysync = shift ;
+ $mysync->{most_common_error} = errorsanalyse( errors_log( $sync ) ) ;
+
+ my $errors_listing = join( '',
+ "++++ Listing $mysync->{nb_errors} errors encountered during the sync ( avoid this listing with --noerrorsdump ).\n",
+ errorsdump( errors_log( $mysync ) ),
+ "The most frequent error is $mysync->{most_common_error}\n",
+ ) ;
+ return $errors_listing ;
+}
+
+
+
+
sub tests_live_result
{
- note( 'Entering tests_live_result()' ) ;
+ note( 'Entering tests_live_result()' ) ;
my $nb_errors = shift ;
if ( $nb_errors ) {
@@ -5074,7 +6107,7 @@
} else {
myprint( "Live tests ended successfully\n" ) ;
}
- note( 'Leaving tests_live_result()' ) ;
+ note( 'Leaving tests_live_result()' ) ;
return ;
}
@@ -5140,7 +6173,7 @@
( $mysync->{ debug } or $debugflags ) and
myprint( "Host1: flags init msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 msg $h2_fold/$h2_msg flags( $h2_flags )\n" ) ;
- $h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;
+ $h1_flags = flags_for_host2( $mysync, $h1_flags, $permanentflags2 ) ;
$h2_flags = flagscase( $h2_flags ) ;
@@ -5195,7 +6228,8 @@
if ( $imap->IsUnconnected( ) ) {
$mysync->{nb_errors}++ ;
my $lcomm = $imap->LastIMAPCommand || q{} ;
- my $einfo = $imap->LastError || @{$imap->History}[$LAST] || q{} ;
+
+ my $einfo = imap_last_error( $imap ) ;
# if string is long try reduce to a more reasonable size
$lcomm = _filter( $mysync, $lcomm ) ;
@@ -5209,6 +6243,14 @@
}
}
+sub imap_last_error
+{
+ my $imap = shift ;
+ my $einfo = $imap->LastError || @{$imap->History}[$LAST] || q{} ;
+ chomp( $einfo ) ;
+ return( $einfo ) ;
+}
+
sub tests_max
{
note( 'Entering tests_max()' ) ;
@@ -5569,10 +6611,10 @@
my $mysync = shift ;
- $mysync->{password1}
+ $mysync->{ password1 }
|| $mysync->{ passfile1 }
- || 'PREAUTH' eq $authmech1
- || 'EXTERNAL' eq $authmech1
+ || 'PREAUTH' eq $mysync->{ acc1 }->{ authmech }
+ || 'EXTERNAL' eq $mysync->{ acc1 }->{ authmech }
|| $ENV{IMAPSYNC_PASSWORD1}
|| do
{
@@ -5583,8 +6625,8 @@
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
- my $user = $authuser1 || $mysync->{user1} ;
- my $host = $mysync->{host1} ;
+ my $user = $mysync->{ acc1 }->{ authuser } || $mysync->{ user1 } ;
+ my $host = $mysync->{ host1 } ;
my $prompt = "What's the password for $user" . ' at ' . "$host? (not visible while you type, then enter RETURN) " ;
$mysync->{password1} = ask_for_password( $prompt ) ;
} ;
@@ -5613,8 +6655,8 @@
$mysync->{password2}
|| $mysync->{ passfile2 }
- || 'PREAUTH' eq $authmech2
- || 'EXTERNAL' eq $authmech2
+ || 'PREAUTH' eq $mysync->{ acc2 }->{ authmech }
+ || 'EXTERNAL' eq $mysync->{ acc2 }->{ authmech }
|| $ENV{IMAPSYNC_PASSWORD2}
|| do
{
@@ -5625,8 +6667,8 @@
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
- my $user = $authuser2 || $mysync->{user2} ;
- my $host = $mysync->{host2} ;
+ my $user = $mysync->{ acc2 }->{ authuser } || $mysync->{ user2 } ;
+ my $host = $mysync->{ host2 } ;
my $prompt = "What's the password for $user" . ' at ' . "$host? (not visible while you type, then enter RETURN) " ;
$mysync->{password2} = ask_for_password( $prompt ) ;
} ;
@@ -5656,9 +6698,15 @@
{
my $mysync = shift or return ;
$mysync->{pidfile} or return ;
+
if ( -e $mysync->{pidfile} ) {
+ myprint( "Removing pidfile $mysync->{pidfile}\n" ) ;
unlink $mysync->{pidfile} ;
}
+ if ( -e $mysync->{abortfile} ) {
+ myprint( "Removing pidfile $mysync->{abortfile}\n" ) ;
+ unlink $mysync->{abortfile} ;
+ }
return ;
}
@@ -5679,14 +6727,28 @@
if ( $mysync->{log} ) {
myprint( "Log file is $mysync->{logfile} ( to change it, use --logfile filepath ; or use --nolog to turn off logging )\n" ) ;
}
+ else
+ {
+ myprint( "No log file because of option --nolog\n" ) ;
+ }
+
if ( $mysync->{log} and $mysync->{logfile_handle} ) {
- #myprint( "Closing $mysync->{ logfile }\n" ) ;
- close $mysync->{logfile_handle} ;
+ #print( "Closing $mysync->{ logfile }\n" ) ;
+ teefinish( $mysync ) ;
}
return ;
}
+sub exit_most_errors
+{
+ my $mysync = shift @ARG ;
+
+ myprint( errors_listing( $mysync ) ) ;
+ my $exit_value = $EXIT_VALUE_OF_ERR_TYPE{ $mysync->{most_common_error} } || $EXIT_CATCH_ALL ;
+ exit_clean( $mysync, $exit_value ) ;
+ return ;
+}
sub exit_clean
{
@@ -5697,7 +6759,7 @@
{
myprint( @messages ) ;
}
- myprint( "Exiting with return value $status ($EXIT_TXT{$status}) $mysync->{nb_errors}/$mysync->{errorsmax} nb_errors/max_errors\n" ) ;
+ myprint( "Exiting with return value $status ($EXIT_TXT{$status}) $mysync->{nb_errors}/$mysync->{errorsmax} nb_errors/max_errors PID $PROCESS_ID\n" ) ;
cleanup_before_exit( $mysync ) ;
exit $status ;
@@ -5721,11 +6783,12 @@
my $sigcounter = ++$mysync->{ sigcounter }{ $signame } ;
myprint( "\nGot a signal $signame (my PID is $PROCESS_ID my PPID is ", getppid( ),
"). Received $sigcounter $signame signals so far. Thanks!\n" ) ;
- stats( $mysync ) ;
+ do_and_print_stats( $mysync ) ;
return ;
}
+
sub catch_exit
{
my $mysync = shift ;
@@ -5733,22 +6796,26 @@
if ( $signame ) {
myprint( "\nGot a signal $signame (my PID is $PROCESS_ID my PPID is ", getppid( ),
"). Asked to terminate\n" ) ;
- if ( $mysync->{stats} ) {
- myprint( "Here are the final stats of this sync not completely finished so far\n" ) ;
- stats( $mysync ) ;
+ if ( $mysync->{can_do_stats} ) {
+ do_and_print_stats( $mysync ) ;
myprint( "Ended by a signal $signame (my PID is $PROCESS_ID my PPID is ",
getppid( ), "). I am asked to terminate immediately.\n" ) ;
- myprint( "You should resynchronize those accounts by running a sync again,\n",
- "since some messages and entire folders might still be missing on host2.\n" ) ;
}
+ myprint( "You should resynchronize those accounts by running a sync again,\n",
+ "since some messages and entire folders might still be missing on host2.\n"
+ ) ;
## no critic (RequireLocalizedPunctuationVars)
+ # Well, restore default action does not work well
$SIG{ $signame } = 'DEFAULT'; # restore default action
+ #$SIG{ 'TERM' } = 'DEFAULT'; # restore default action
# kill myself with $signame
# https://www.cons.org/cracauer/sigint.html
myprint( "Killing myself with signal $signame\n" ) ;
- cleanup_before_exit( $mysync ) ;
+ #cleanup_before_exit( $mysync ) ;
kill( $signame, $PROCESS_ID ) ;
- sleep 1 ;
+ #kill( 'TERM', $PROCESS_ID ) ;
+ #sleep 1 ;
+ #while ( 1 ) { } ;
$mysync->{nb_errors}++ ;
exit_clean( $mysync, $EXIT_BY_SIGNAL,
"Still there after killing myself with signal $signame...\n"
@@ -5861,6 +6928,7 @@
# --sigignore can override sigexit, sigreconnect and sigprint (for the same signals only)
sig_install( $mysync, 'catch_ignore', @{ $mysync->{ sigignore } } ) ;
+ # remove/add sleeping mechanism when receiving USR1 signal (except on Win32)
sig_install_toggle_sleep( $mysync ) ;
}
@@ -5955,10 +7023,6 @@
}
-
-# $sync->{id} = defined $sync->{id} ? $sync->{id} : 1 ;
-# imap_id_stuff( $sync ) ;
-
sub justconnect
{
my $mysync = shift ;
@@ -5974,10 +7038,11 @@
{
myprint( "Host1: Will just connect to $mysync->{host1} without login\n" ) ;
$mysync->{imap1} = connect_imap(
- $mysync->{host1}, $mysync->{port1}, $debugimap1,
- $mysync->{ssl1}, $mysync->{tls1}, 'Host1',
- $mysync->{h1}->{timeout}, $mysync->{h1} ) ;
- imap_id( $mysync, $mysync->{imap1}, 'Host1' ) ;
+ $mysync->{host1}, $mysync->{port1},
+ $mysync->{ssl1}, $mysync->{tls1},
+ $mysync->{ acc1 } ) ;
+
+ imap_id( $mysync, $mysync->{imap1}, $mysync->{ acc1 }->{ Side } ) ;
$mysync->{imap1}->logout( ) ;
return $mysync->{host1} ;
}
@@ -5992,10 +7057,11 @@
{
myprint( "Host2: Will just connect to $mysync->{host2} without login\n" ) ;
$mysync->{imap2} = connect_imap(
- $mysync->{host2}, $mysync->{port2}, $debugimap2,
- $mysync->{ssl2}, $mysync->{tls2}, 'Host2',
- $mysync->{h2}->{timeout}, $mysync->{h2} ) ;
- imap_id( $mysync, $mysync->{imap2}, 'Host2' ) ;
+ $mysync->{host2}, $mysync->{port2},
+ $mysync->{ssl2}, $mysync->{tls2},
+ $mysync->{ acc2 } ) ;
+
+ imap_id( $mysync, $mysync->{imap2}, $mysync->{ acc2 }->{ Side } ) ;
$mysync->{imap2}->logout( ) ;
return $mysync->{host2} ;
}
@@ -6006,9 +7072,18 @@
sub skip_macosx
{
#return ;
- return( 'macosx.polarhome.com' eq hostname() ) ;
+ # hostname used to be macosx.polarhome.com
+ return( 'macosx' eq hostname( ) && ( 'darwin' eq $OSNAME ) ) ;
}
+sub skip_macosx_binary
+{
+ #return ;
+ return( skip_macosx( ) && ( $PROGRAM_NAME =~ m{imapsync_bin_Darwin} ) ) ;
+}
+
+
+
sub tests_mailimapclient_connect
{
note( 'Entering tests_mailimapclient_connect()' ) ;
@@ -6026,7 +7101,7 @@
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( 3 )' ) ;
+ is( 10, $imap->Timeout( 10 ), 'mailimapclient_connect ipv4: setting Timeout( 10 )' ) ;
like( ref( $imap->connect( ) ), qr/IO::Socket::INET|IO::Socket::IP/, 'mailimapclient_connect ipv4: connect to test.lamiral.info' ) ;
like( $imap->logout( ), qr/Mail::IMAPClient/, 'mailimapclient_connect ipv4: logout' ) ;
is( undef, undef $imap, 'mailimapclient_connect ipv4: free variable' ) ;
@@ -6042,11 +7117,10 @@
is( undef, undef $imap, 'mailimapclient_connect ipv4 + ssl: free variable' ) ;
# ipv6 + ssl
- # Fails often on ks2ipv6.lamiral.info
-
+
ok( $imap = Mail::IMAPClient->new( ), 'mailimapclient_connect ipv6 + ssl: new' ) ;
is( 'petiteipv6.lamiral.info', $imap->Server( 'petiteipv6.lamiral.info' ), 'mailimapclient_connect ipv6 + ssl: setting Server petiteipv6.lamiral.info' ) ;
- is( 3, $imap->Timeout( 3 ), 'mailimapclient_connect ipv4: setting Timout( 3 )' ) ;
+ is( 10, $imap->Timeout( 10 ), 'mailimapclient_connect ipv6: setting Timeout( 10 )' ) ;
ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE, SSL_cipher_list => 'DEFAULT:!DH' ] ), 'mailimapclient_connect ipv6 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ;
is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv6 + ssl: setting Port( 993 )' ) ;
SKIP: {
@@ -6062,9 +7136,9 @@
{
skip( 'Tests avoided on CUILLERE/pcHPDV7-HP/macosx.polarhome.com/docker cannot do ipv6', 4 ) ;
}
-
+
is( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4 + ssl: setting Debug( 1 )' ) ;
-
+
# It sounds stupid but it avoids failures on the next test about $imap->connect
is( '2a01:e34:ecde:70d0:223:54ff:fec2:36d7', resolv( 'petiteipv6.lamiral.info' ), 'resolv: petiteipv6.lamiral.info => 2001:41d0:8:bebd::1' ) ;
@@ -6089,7 +7163,7 @@
# ipv6
ok( $imap = Mail::IMAPClient->new( ), 'mailimapclient_connect_bug ipv6: new' ) ;
- is( 'ks2ipv6.lamiral.info', $imap->Server( 'ks2ipv6.lamiral.info' ), 'mailimapclient_connect_bug ipv6: setting Server(ks2ipv6.lamiral.info)' ) ;
+ is( 'ks6ipv6.lamiral.info', $imap->Server( 'ks6ipv6.lamiral.info' ), 'mailimapclient_connect_bug ipv6: setting Server(ks6ipv6.lamiral.info)' ) ;
is( 143, $imap->Port( 143 ), 'mailimapclient_connect_bug ipv6: setting Port( 993 )' ) ;
SKIP: {
@@ -6105,7 +7179,7 @@
{
skip( 'Tests avoided on CUILLERE/pcHPDV7-HP/macosx.polarhome.com/docker cannot do ipv6', 1 ) ;
}
- like( ref( $imap->connect( ) ), qr/IO::Socket::INET/, 'mailimapclient_connect_bug ipv6: connect to ks2ipv6.lamiral.info' )
+ like( ref( $imap->connect( ) ), qr/IO::Socket::INET/, 'mailimapclient_connect_bug ipv6: connect to ks6ipv6.lamiral.info' )
or diag( 'mailimapclient_connect_bug ipv6: ', $imap->LastError( ), $!, ) ;
}
#is( $imap->logout( ), undef, 'mailimapclient_connect_bug ipv6: logout in ssl causes failure' ) ;
@@ -6140,12 +7214,12 @@
}
$socket = IO::Socket::INET6->new(
- PeerAddr => 'ks2ipv6.lamiral.info',
+ PeerAddr => 'ks6ipv6.lamiral.info',
PeerPort => 143,
) ;
- ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 143 IO::Socket::INET6' ) ;
+ ok( $imap = connect_socket( $socket ), 'connect_socket: ks6ipv6.lamiral.info port 143 IO::Socket::INET6' ) ;
#$imap->Debug( 1 ) ;
# myprint( $imap->capability( ) ) ;
if ( $imap ) {
@@ -6154,13 +7228,13 @@
$IO::Socket::SSL::DEBUG = 4 ;
$socket = IO::Socket::SSL->new(
- PeerHost => 'ks2ipv6.lamiral.info',
+ PeerHost => 'ks6ipv6.lamiral.info',
PeerPort => 993,
SSL_verify_mode => SSL_VERIFY_NONE,
SSL_cipher_list => 'DEFAULT:!DH',
) ;
# myprint( $socket ) ;
- ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 993 IO::Socket::SSL' ) ;
+ ok( $imap = connect_socket( $socket ), 'connect_socket: ks6ipv6.lamiral.info port 993 IO::Socket::SSL' ) ;
#$imap->Debug( 1 ) ;
# myprint( $imap->capability( ) ) ;
# $socket->close( ) ;
@@ -6216,10 +7290,10 @@
skip( 'Tests avoided on CUILLERE or pcHPDV7-HP or Mac or docker: cannot do ipv6', 0 ) ;
}
# fed up with this one
- #like( probe_imapssl( 'ks2ipv6.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: ks2ipv6.lamiral.info matches "* OK"' ) ;
+ #like( probe_imapssl( 'ks6ipv6.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: ks6ipv6.lamiral.info matches "* OK"' ) ;
} ;
-
+
# It sounds stupid but it avoids failures on the next test about $imap->connect
ok( resolv( 'imap.gmail.com' ), 'resolv: imap.gmail.com => something' ) ;
like( probe_imapssl( 'imap.gmail.com' ), qr/^\* OK/, 'probe_imapssl: imap.gmail.com matches "* OK"' ) ;
@@ -6257,193 +7331,604 @@
sub connect_imap
{
- my( $host, $port, $mydebugimap, $ssl, $tls, $Side, $mytimeout, $h ) = @_ ;
+ my( $host, $port, $ssl, $tls, $acc ) = @_ ;
my $imap = Mail::IMAPClient->new( ) ;
-
- if ( $ssl ) { set_ssl( $imap, $h ) }
+
+ if ( $ssl ) { set_ssl( $imap, $acc ) }
$imap->Server( $host ) ;
$imap->Port( $port ) ;
- $imap->Debug( $mydebugimap ) ;
- $imap->Timeout( $mytimeout ) ;
+ $imap->Debug( $acc->{ debugimap } ) ;
+ $imap->Timeout( $acc->{ timeout } ) ;
- my $side = lc $Side ;
- myprint( "$Side: connecting on $side [$host] port [$port]\n" ) ;
+ my $side = lc $acc->{ Side } ;
+
+ myprint( "$acc->{ Side }: connecting on $side [$host] port [$port]\n" ) ;
if ( ! $imap->connect( ) )
{
$sync->{nb_errors}++ ;
exit_clean( $sync, $EXIT_CONNECTION_FAILURE,
- "$Side: Can not open imap connection on [$host]: ",
+ "$acc->{ Side }: Can not open imap connection on [$host]: ",
$imap->LastError,
" $OS_ERROR\n"
) ;
}
- myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n" ) ;
+ myprint( "$acc->{ Side } IP address: ", $imap->Socket->peerhost(), "\n" ) ;
my $banner = $imap->Results()->[0] ;
- myprint( "$Side banner: $banner" ) ;
- myprint( "$Side capability: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;
+ myprint( "$acc->{ Side } banner: $banner" ) ;
+ myprint( "$acc->{ Side } capability: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;
if ( $tls ) {
- set_tls( $imap, $h ) ;
+ set_tls( $imap, $acc ) ;
if ( ! $imap->starttls( ) )
{
$sync->{nb_errors}++ ;
exit_clean( $sync, $EXIT_TLS_FAILURE,
- "$Side: Can not go to tls encryption on $side [$host]:",
+ "$acc->{ Side }: Can not go to tls encryption on $side [$host]:",
$imap->LastError, "\n"
) ;
}
- myprint( "$Side: Socket successfuly converted to SSL\n" ) ;
+ myprint( "$acc->{ Side }: Socket successfully converted to SSL\n" ) ;
}
return( $imap ) ;
}
+
+sub tests_login_imap
+{
+ note( 'Entering tests_login_imap()' ) ;
+
+ is( undef, login_imap( ), 'login_imap: no args => undef' ) ;
+
+ SKIP: {
+ if ( skip_macosx_binary( ) )
+ {
+ skip( 'Tests avoided only on binary on host polarhome macosx, no clue "ssl3_get_server_certificate:certificate verify failed"', 11 ) ;
+ }
+ else{
+
+ my $myimap ;
+ my $acc = {} ;
+ $acc->{ Side } = 'HostK' ;
+ $acc->{ authmech } = 'LOGIN' ;
+ #$IO::Socket::SSL::DEBUG = 4 ;
+ # Each month (trimester?):
+ # echo | openssl s_client -crlf -connect test1.lamiral.info:993
+ # ...
+ # certificate has expired
+ # Fix:
+ # ssh root@test1.lamiral.info 'apt update && apt upgrade && /etc/init.d/dovecot restart'
+ ok(
+ $myimap = login_imap( 'test1.lamiral.info', 993, 'test1', 'secret1',
+ 1, undef,
+ 1, 100, $acc, {},
+ ), 'login_imap: test1.lamiral.info test1 ssl' ) ;
+ ok( defined( $myimap ) && $myimap->IsAuthenticated( ), 'login_imap: test1.lamiral.info test1 ssl IsAuthenticated' ) ;
+
+ ok(
+ $myimap = login_imap( 'test1.lamiral.info', 143, 'test1', 'secret1',
+ 0, undef,
+ 1, 100, $acc, {},
+ ), 'login_imap: test1.lamiral.info test1 tls' ) ;
+ ok( $myimap && $myimap->IsAuthenticated( ), 'login_imap: test1.lamiral.info test1 tls IsAuthenticated' ) ;
+
+ #$IO::Socket::SSL::DEBUG = 4 ;
+ $acc->{sslargs} = { SSL_version => 'SSLv2' } ;
+ # SSLv2 not supported
+ is(
+ undef, $myimap = login_imap( 'test1.lamiral.info', 143, 'test1', 'secret1',
+ 0, undef,
+ 1, 100, $acc, {},
+ ), 'login_imap: test1.lamiral.info test1 tls SSLv2 not supported' ) ;
+#SSL_verify_mode => 1
+#SSL_version => 'TLSv1_1'
+
+
+
+ # I have left ? exit_clean to be replaced by errors_incr( $mysync, 'error message' )
+ # 1 in login_imap()
+
+
+ my $mysync = {} ;
+ $acc = {} ;
+ $acc->{ Side } = 'Host2' ;
+ $acc->{ authmech } = 'LOGIN' ;
+ is(
+ undef, login_imap( 'noresol.lamiral.info', 143, 'test1', 'secret1',
+ 0, undef,
+ 1, 100, $acc, $mysync,
+ ), 'login_imap: noresol.lamiral.info undef' ) ;
+
+ is( 'ERR_CONNECTION_FAILURE_HOST2', errorsanalyse( errors_log( $mysync ) ), 'login_imap: Host2 noresol.lamiral.info => ERR_CONNECTION_FAILURE_HOST2' ) ;
+
+ # authentication failure for user2
+ $mysync = {} ;
+ is(
+ undef, login_imap( 'test1.lamiral.info', 143, 'test1', 'Ce crétin',
+ 0, undef,
+ 1, 100, $acc, $mysync,
+ ), 'login_imap: user2 bad passord => undef' ) ;
+
+ is( 'ERR_AUTHENTICATION_FAILURE_USER2', errorsanalyse( errors_log( $mysync ) ), 'login_imap: Host2 bad password => ERR_AUTHENTICATION_FAILURE_USER2' ) ;
+
+ # authentication failure for user1
+ $mysync = {} ;
+ $acc = {} ;
+ $acc->{ Side } = 'Host1' ;
+ $acc->{ authmech } = 'LOGIN' ;
+ is(
+ undef, login_imap( 'test1.lamiral.info', 143, 'test1', 'Ce crétin',
+ 0, undef,
+ 1, 100, $acc, $mysync,
+ ), 'login_imap: user1 bad passord => undef' ) ;
+
+ is( 'ERR_AUTHENTICATION_FAILURE_USER1', errorsanalyse( errors_log( $mysync ) ), 'login_imap: Host1 bad password => ERR_AUTHENTICATION_FAILURE_USER1' ) ;
+
+ }
+ }
+
+ note( 'Leaving tests_login_imap()' ) ;
+ return ;
+}
+
+sub oauthgenerateaccess
+{
+ if ( "petite" eq hostname() )
+ {
+ myprint( "oauthgenerateaccess\n" ) ;
+ my @output = backtick( 'cd oauth2 && pwd && ./generate_gmail_token imapsync.gl0@gmail.com' ) ;
+ myprint( @output ) ;
+ }
+ return ;
+}
+
+sub tests_login_imap_oauth
+{
+ note( 'Entering tests_login_imap_oauth()' ) ;
+
+ oauthgenerateaccess() ;
+
+ SKIP: {
+ if ( skip_macosx_binary( ) )
+ {
+ skip( 'Tests avoided only on binary on host polarhome macosx, no clue "ssl3_get_server_certificate:certificate verify failed"', 6 ) ;
+ }
+ else
+ {
+
+ my $mysync ;
+ my $acc ;
+ # oauthdirect authentication failure for user2
+ $mysync = {} ;
+ $acc = {} ;
+ $acc->{ oauthdirect } = 'caca2' ;
+ $acc->{ debugimap } = 1 ;
+ $mysync->{ showpasswords } = 1 ;
+ $acc->{ Side } = 'Host2' ;
+ $acc->{ authmech } = 'QQQ' ;
+ is(
+ undef, login_imap( 'imap.gmail.com', 993, 'test1', 'Ce crétin',
+ 1, undef,
+ 1, 100, $acc, $mysync,
+ ), 'login_imap: user2 bad oauthdirect => undef' ) ;
+
+ is( 'ERR_AUTHENTICATION_FAILURE_USER2', errorsanalyse( errors_log( $mysync ) ), 'login_imap: Host2 bad oauthdirect => ERR_AUTHENTICATION_FAILURE_USER2' ) ;
+
+ # oauthdirect authentication failure for user1
+ $mysync = {} ;
+ $acc = {} ;
+ $acc->{ Side } = 'Host1' ;
+ $acc->{ oauthdirect } = 'caca1' ;
+ $acc->{ debugimap } = 1 ;
+ $mysync->{ showpasswords } = 1 ;
+ $acc->{ authmech } = 'QQQ' ;
+ is(
+ undef, login_imap( 'imap.gmail.com', 993, 'test1', 'Ce crétin',
+ 1, undef,
+ 1, 100, $acc, $mysync,
+ ), 'login_imap: user1 bad oauthdirect => undef' ) ;
+
+ is( 'ERR_AUTHENTICATION_FAILURE_USER1', errorsanalyse( errors_log( $mysync ) ), 'login_imap: Host1 bad oauthdirect => ERR_AUTHENTICATION_FAILURE_USER1' ) ;
+
+ # oauthdirect authentication failure for user1
+ $mysync = {} ;
+ $acc = {} ;
+ $acc->{ Side } = 'Host1' ;
+ $acc->{ oauthdirect } = '' ;
+ $acc->{ debugimap } = 1 ;
+ $mysync->{ showpasswords } = 1 ;
+ $acc->{ authmech } = 'QQQ' ;
+ is(
+ undef, login_imap( 'imap.gmail.com', 993, 'test1', 'Ce crétin',
+ 1, undef,
+ 1, 100, $acc, $mysync,
+ ), 'login_imap: user1 bad oauthdirect => undef' ) ;
+
+ is( 'ERR_AUTHENTICATION_FAILURE_USER1', errorsanalyse( errors_log( $mysync ) ), 'login_imap: Host1 no oauthdirect value => ERR_AUTHENTICATION_FAILURE_USER1' ) ;
+
+ }
+ }
+
+ # oauthdirect authentication success for user1
+ SKIP: {
+ if ( ! -r 'oauth2/D_oauth2_oauthdirect_imapsync.gl0@gmail.com.txt' )
+ {
+ skip( 'oauthdirect: no oauthdirect file', 2 ) ;
+ }
+ my $myimap ;
+ my $mysync = {} ;
+ my $acc = {} ;
+ $acc->{ Side } = 'Host1' ;
+ $acc->{ oauthdirect } = 'oauth2/D_oauth2_oauthdirect_imapsync.gl0@gmail.com.txt' ;
+ $acc->{ debugimap } = 1 ;
+ $mysync->{ showpasswords } = 1 ;
+ $acc->{ authmech } = 'QQQ' ;
+ isa_ok(
+ $myimap = login_imap( 'imap.gmail.com', 993, 'user_useless', 'password_useless',
+ 1, undef,
+ 1, 100, $acc, $mysync,
+ ), 'Mail::IMAPClient', 'login_imap: user1 good oauthdirect => Mail::IMAPClient' ) ;
+
+ ok( defined( $myimap ) && $myimap->IsAuthenticated( ), 'login_imap: gmail oauth2 IsAuthenticated' ) ;
+ }
+
+ # oauthaccesstoken authentication success for user1
+ SKIP: {
+ if ( ! -r 'oauth2/D_oauth2_access_token_imapsync.gl0@gmail.com.txt' )
+ {
+ skip( 'oauthaccesstoken: no access_token file', 2 ) ;
+ }
+ my $myimap ;
+ my $mysync = {} ;
+ my $acc = {} ;
+ $acc->{ Side } = 'Host1' ;
+ $acc->{ oauthaccesstoken } = 'oauth2/D_oauth2_access_token_imapsync.gl0@gmail.com.txt' ;
+ $acc->{ debugimap } = 1 ;
+ $mysync->{ showpasswords } = 1 ;
+ $acc->{ authmech } = 'QQQ' ;
+ isa_ok(
+ $myimap = login_imap( 'imap.gmail.com', 993, 'imapsync.gl0@gmail.com', 'password_useless',
+ 1, undef,
+ 1, 100, $acc, $mysync,
+ ), 'Mail::IMAPClient', 'login_imap: user1 good oauthaccesstoken => Mail::IMAPClient' ) ;
+
+ ok( defined( $myimap ) && $myimap->IsAuthenticated( ), 'login_imap: gmail oauth2 oauthaccesstoken IsAuthenticated' ) ;
+
+ }
+
+
+ note( 'Leaving tests_login_imap_oauth()' ) ;
+ return ;
+}
+
+
+
sub login_imap
{
-
my @allargs = @_ ;
my(
- $host, $port, $user, $domain, $password,
- $mydebugimap, $mytimeout, $fastio,
- $ssl, $tls, $authmech, $authuser, $reconnectretry,
- $proxyauth, $uid, $split, $Side, $h, $mysync ) = @allargs ;
+ $host, $port, $user, $password,
+ $ssl, $tls,
+ $uid, $split, $acc, $mysync ) = @allargs ;
- my $side = lc $Side ;
- myprint( "$Side: connecting and login on $side [$host] port [$port] with user [$user]\n" ) ;
+ if ( ! all_defined( $host, $port, $user, $acc->{ Side } ) )
+ {
+ return ;
+ }
+
+ my $side = lc $acc->{ Side } ;
+ myprint( "$acc->{ Side }: connecting and login on $side [$host] port [$port] with user [$user]\n" ) ;
my $imap = init_imap( @allargs ) ;
if ( ! $imap->connect() )
{
- $mysync->{nb_errors}++ ;
- exit_clean( $mysync, $EXIT_CONNECTION_FAILURE,
- "$Side failure: can not open imap connection on $side [$host] with user [$user]: ",
- $imap->LastError . " $OS_ERROR\n"
- ) ;
+ my $error = "$acc->{ Side } failure: can not open imap connection on $side [$host] with user [$user]: "
+ . $imap->LastError . " $OS_ERROR\n" ;
+ errors_incr( $mysync, $error ) ;
+ return ;
}
- myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n" ) ;
+ myprint( "$acc->{ Side } IP address: ", $imap->Socket->peerhost(), "\n" ) ;
my $banner = $imap->Results()->[0] ;
- myprint( "$Side banner: $banner" ) ;
- myprint( "$Side capability before authentication: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;
+ myprint( "$acc->{ Side } banner: $banner" ) ;
+ myprint( "$acc->{ 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" ) ;
+ myprint( "$acc->{ Side }: going to ssl because STARTTLS is in CAPABILITY. Use --notls1 or --notls2 to avoid that behavior\n" ) ;
$tls = 1 ;
}
- if ( $authmech eq 'PREAUTH' ) {
+
+ #myprint( Data::Dumper->Dump( [ @allargs ] ) ) ;
+ if ( $tls ) {
+ set_tls( $imap, $acc ) ;
+
+ if ( ! $imap->starttls( ) )
+ {
+ my $error = "$acc->{ Side } failure: Can not go to tls encryption on $side [$host]: "
+ . $imap->LastError . "\n" ;
+
+ errors_incr( $mysync, $error ) ;
+ return ;
+ }
+ myprint( "$acc->{ Side }: Socket successfully converted to SSL\n" ) ;
+ }
+
+ if ( $acc->{ authmech } eq 'PREAUTH' ) {
if ( $imap->IsAuthenticated( ) ) {
$imap->Socket ;
- myprintf("%s: Assuming PREAUTH for %s\n", $Side, $imap->Server ) ;
+ myprintf("%s: Assuming PREAUTH for %s\n", $acc->{ Side }, $imap->Server ) ;
}else{
$mysync->{nb_errors}++ ;
exit_clean(
$mysync, $EXIT_AUTHENTICATION_FAILURE,
- "$Side failure: error login on $side [$host] with user [$user] auth [PREAUTH]\n"
+ "$acc->{ Side } failure: error login on $side [$host] with user [$user] auth [PREAUTH]\n"
) ;
}
}
- if ( $tls ) {
- set_tls( $imap, $h ) ;
- if ( ! $imap->starttls( ) )
- {
- $mysync->{nb_errors}++ ;
- exit_clean( $mysync, $EXIT_TLS_FAILURE,
- "$Side failure: Can not go to tls encryption on $side [$host]:",
- $imap->LastError, "\n"
- ) ;
- }
- myprint( "$Side: Socket successfuly converted to SSL\n" ) ;
+
+
+ if ( authenticate_imap( $imap, @allargs ) )
+ {
+ myprint( "$acc->{ Side }: success login on [$host] with user [$user] auth [$acc->{ authmech }] or [LOGIN]\n" ) ;
+ return( $imap ) ;
}
-
- authenticate_imap( $imap, @allargs ) ;
-
- myprint( "$Side: success login on [$host] with user [$user] auth [$authmech]\n" ) ;
- return( $imap ) ;
+ else
+ {
+ # The errors are already printed
+ myprint( "$acc->{ Side }: failed login on [$host] with user [$user] auth [$acc->{ authmech }]\n" ) ;
+ return ;
+ }
}
+
+sub init_imap
+{
+ my(
+ $host, $port, $user, $password,
+ $ssl, $tls,
+ $uid, $split, $acc, $mysync ) = @_ ;
+
+ my ( $imap ) ;
+
+ $imap = Mail::IMAPClient->new() ;
+
+ if ( $mysync->{ tee } )
+ {
+ # Well, it does not change anything, does it?
+ # It does when suppressing the hack with *STDERR
+ $imap->Debug_fh( $mysync->{ tee } ) ;
+ }
+
+ if ( $ssl ) { set_ssl( $imap, $acc ) }
+ 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( $acc->{ fastio } ) ;
+ $imap->Buffer( $buffersize || $DEFAULT_BUFFER_SIZE ) ;
+ $imap->Uid( $uid ) ;
+
+
+ $imap->Peek( 1 ) ;
+ $imap->Debug( $acc->{ debugimap } ) ;
+ if ( $mysync->{ showpasswords } ) {
+ $imap->Showcredentials( 1 ) ;
+ }
+
+ defined $acc->{ timeout } and $imap->Timeout( $acc->{ timeout } ) ;
+
+ if ( defined $acc->{ reconnectretry } )
+ {
+ $imap->Reconnectretry( $acc->{ reconnectretry } ) ;
+ }
+ $imap->{IMAPSYNC_RECONNECT_COUNT} = 0 ;
+ $imap->Ignoresizeerrors( $allowsizemismatch ) ;
+ $split and $imap->Maxcommandlength( $SPLIT_FACTOR * $split ) ;
+
+
+ return( $imap ) ;
+
+}
+
sub authenticate_imap
{
my( $imap,
- $host, $port, $user, $domain, $password,
- $mydebugimap, $mytimeout, $fastio,
- $ssl, $tls, $authmech, $authuser, $reconnectretry,
- $proxyauth, $uid, $split, $Side, $h, $mysync ) = @_ ;
+ $host, $port, $user, $password,
+ $ssl, $tls,
+ $uid, $split, $acc, $mysync ) = @_ ;
- check_capability( $imap, $authmech, $Side ) ;
+ check_capability( $imap, $acc->{ authmech }, $acc->{ Side } ) ;
$imap->User( $user ) ;
- $imap->Domain( $domain ) if ( defined $domain ) ;
- $imap->Authuser( $authuser ) ;
+
+ if ( defined $acc->{ domain } )
+ {
+ $imap->Domain( $acc->{ domain } ) ;
+ $mysync->{ debug } and myprint( "Domain: $acc->{ domain }\n" ) ;
+ }
+
+ $imap->Authuser( $acc->{ authuser } ) ;
$imap->Password( $password ) ;
- if ( 'X-MASTERAUTH' eq $authmech )
+ if ( 'X-MASTERAUTH' eq $acc->{ authmech } )
{
xmasterauth( $imap ) ;
- return ;
+ return 1 ;
}
- if ( $proxyauth ) {
+
+ if ( defined $acc->{ oauthdirect } )
+ {
+ $acc->{ authmech } = 'XOAUTH2 direct' ;
+ return( oauthdirect( $mysync, $acc, $imap, $host, $user ) ) ;
+ }
+
+
+ if ( defined $acc->{ oauthaccesstoken } )
+ {
+ $acc->{ authmech } = 'XOAUTH2 accesstoken' ;
+ return( oauthaccesstoken( $mysync, $acc, $imap, $host, $user ) ) ;
+ }
+
+
+
+
+ if ( $acc->{ proxyauth } ) {
$imap->Authmechanism(q{}) ;
- $imap->User( $authuser ) ;
+ $imap->User( $acc->{ authuser } ) ;
} else {
- $imap->Authmechanism( $authmech ) unless ( $authmech eq 'LOGIN' or $authmech eq 'PREAUTH' ) ;
+ $imap->Authmechanism( $acc->{ authmech } ) unless ( $acc->{ authmech } eq 'LOGIN' or $acc->{ authmech } eq 'PREAUTH' ) ;
}
- $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(\&xoauth2) if ( 'XOAUTH2' eq $acc->{ authmech } ) ;
+ $imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $acc->{ authmech } ) or ( 'EXTERNAL' eq $acc->{ authmech } ) ) ;
- 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 ) {
- $authuser ||= "" ;
- myprint( "$Side info: authmech [$authmech] user [$user] authuser [$authuser] IsUnconnected [", $imap->IsUnconnected( ), "]\n" ) ;
- $mysync->{nb_errors}++ ;
- exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, $error ) ;
+ unless ( $acc->{ authmech } eq 'PREAUTH' or $imap->login( ) ) {
+ my $info = "$acc->{ Side } failure: Error login on [$host] with user [$user] auth" ;
+ my $einfo = imap_last_error( $imap ) ;
+ my $error = "$info [$acc->{ authmech }]: $einfo\n" ;
+
+
+ if ( ( $acc->{ authmech } eq 'LOGIN' ) or $imap->IsUnconnected( ) or $acc->{ authuser } ) {
+ $acc->{ authuser } ||= "" ;
+ myprint( "$acc->{ Side } info: authmech [$acc->{ authmech }] user [$user] authuser [$acc->{ authuser }] IsUnconnected [", $imap->IsUnconnected( ), "]\n" ) ;
+ errors_incr( $mysync, $error ) ;
+ return ;
}else{
- myprint( $error ) ;
+ errors_incr( $mysync, $error ) ;
}
+
# It is not secure to try plain text LOGIN when another authmech failed
- # but I do it.
- # I shell remove this code one day.
- myprint( "$Side info: trying LOGIN Auth mechanism on [$host] with user [$user]\n" ) ;
- $imap->Authmechanism(q{}) ;
- if ( ! $imap->login( ) )
+ # but I do it anyway. This behavior is optional as option --notrylogin will skip it.
+ if ( $mysync->{ trylogin } )
{
- $mysync->{nb_errors}++ ;
- exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE,
- "$info [LOGIN]: ",
- $imap->LastError, "\n"
- ) ;
+ myprint( "$acc->{ Side } info: trying LOGIN Auth mechanism on [$host] with user [$user]. Use option --notrylogin to avoid this second chance to login via LOGIN auth\n" ) ;
+ $imap->Authmechanism(q{}) ;
+ if ( ! $imap->login( ) )
+ {
+ failure_login( $mysync, $acc, 'LOGIN', $imap, $host, $user ) ;
+ return ;
+ }
+ else
+ {
+ myprint( "$acc->{ Side }: success login on [$host] with user [$user] auth [LOGIN] after [$acc->{ authmech }] failure\n" ) ;
+ }
+ }
+ else
+ {
+ myprint( "$acc->{ Side } info: not trying LOGIN Auth mechanism on [$host] with user [$user]. Use option --trylogin to have this second chance to login via LOGIN auth\n" ) ;
+ return ;
}
}
- if ( $proxyauth ) {
+ if ( $acc->{ proxyauth } ) {
if ( ! $imap->proxyauth( $user ) ) {
- my $info = "$Side failure: Error doing proxyauth as user [$user] on [$host] using proxy-login as [$authuser]" ;
- my $einfo = $imap->LastError || @{$imap->History}[$LAST] ;
- chomp $einfo ;
- $mysync->{nb_errors}++ ;
- exit_clean( $mysync,
- $EXIT_AUTHENTICATION_FAILURE,
- "$info: $einfo\n"
- ) ;
+ failure_proxyauth( $mysync, $acc, $acc->{ authmech }, $imap, $host, $user ) ;
+ return ;
}
}
+ return 1;
+}
+
+
+sub failure_login
+{
+ my( $mysync, $acc, $authmech, $imap, $host, $user ) = @ARG ;
+ my $info = "$acc->{ Side } failure: Error login on [$host] with user [$user] auth" ;
+ my $einfo = imap_last_error( $imap ) ;
+ my $error = "$info [$authmech]: $einfo\n" ;
+ errors_incr( $mysync, $error ) ;
return ;
}
+# failure_login and failure_proxyauth function are similar but
+# variable $error so no factoring
+sub failure_proxyauth
+{
+ my( $mysync, $acc, $authmech, $imap, $host, $user ) = @ARG ;
+ my $info = "$acc->{ Side } failure: Error login on [$host] with user [$user] auth" ;
+ my $einfo = imap_last_error( $imap ) ;
+ my $error = "$info [$authmech] using proxy-login as [$acc->{ authuser }]: $einfo\n" ;
+ errors_incr( $mysync, $error ) ;
+ return ;
+}
+
+
+
+
+sub oauthdirect
+{
+ my( $mysync, $acc, $imap, $host, $user ) = @_ ;
+
+ my $oauthdirect_str ;
+ if ( -f -r $acc->{ oauthdirect } )
+ {
+ $oauthdirect_str = firstline( $acc->{ oauthdirect } ) ;
+ }
+ else
+ {
+ $oauthdirect_str = $acc->{ oauthdirect } || 'Please define oauthdirect value' ;
+ }
+ if ( $imap->authenticate('XOAUTH2', sub { return $oauthdirect_str } ) )
+ {
+ return 1 ;
+ }
+ else
+ {
+ failure_login( $mysync, $acc, $acc->{ authmech }, $imap, $host, $user ) ;
+ return ;
+ }
+ return ;
+}
+
+
+
+
+sub oauthaccesstoken
+{
+ my( $mysync, $acc, $imap, $host, $user ) = @_ ;
+
+ my $oauthaccesstoken_str ;
+ if ( -f -r $acc->{ oauthaccesstoken } )
+ {
+ $oauthaccesstoken_str = firstline( $acc->{ oauthaccesstoken } ) ;
+ }
+ else
+ {
+ $oauthaccesstoken_str = $acc->{ oauthaccesstoken } || 'Please define oauthaccesstoken value' ;
+ }
+
+ my $oauth_string = "user=" . $user . "\x01auth=Bearer ". $oauthaccesstoken_str . "\x01\x01" ;
+ #myprint "oauth_string: $oauth_string\n" ;
+
+ my $oauth_string_base64 = encode_base64( $oauth_string , '' ) ;
+ #myprint "oauth_string_base64: $oauth_string_base64\n" ;
+
+ my $oauthdirect_str = $oauth_string_base64 ;
+
+ if ( $imap->authenticate('XOAUTH2', sub { return $oauthdirect_str } ) )
+ {
+ return 1 ;
+ }
+ else
+ {
+ failure_login( $mysync, $acc, $acc->{ authmech }, $imap, $host, $user ) ;
+ return ;
+ }
+ return ;
+}
+
+
+
+
sub check_capability
{
@@ -6479,12 +7964,12 @@
sub set_ssl
{
- my ( $imap, $h ) = @_ ;
+ my ( $imap, $acc ) = @_ ;
# 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_hash = $acc->{sslargs} ;
my $sslargs_default = {
SSL_verify_mode => $SSL_VERIFY_POLICY,
@@ -6509,14 +7994,15 @@
sub set_tls
{
- my ( $imap, $h ) = @_ ;
+ my ( $imap, $acc ) = @_ ;
- my $sslargs_hash = $h->{sslargs} ;
+ my $sslargs_hash = $acc->{sslargs} ;
my $sslargs_default = {
SSL_verify_mode => $SSL_VERIFY_POLICY,
- SSL_cipher_list => 'DEFAULT:!DH',
+ SSL_cipher_list => 'DEFAULT:!DH',
} ;
+ #myprint( Data::Dumper->Dump( [ $acc, $sslargs_hash, $sslargs_default ] ) ) ;
# initiate with default values
my %sslargs_mix = %{ $sslargs_default } ;
@@ -6535,53 +8021,6 @@
-
-sub init_imap
-{
- my(
- $host, $port, $user, $domain, $password,
- $mydebugimap, $mytimeout, $fastio,
- $ssl, $tls, $authmech, $authuser, $reconnectretry,
- $proxyauth, $uid, $split, $Side, $h, $mysync ) = @_ ;
-
- my ( $imap ) ;
-
- $imap = Mail::IMAPClient->new() ;
-
- if ( $mysync->{ tee } )
- {
- # Well, it does not change anything, does it?
- # It does when suppressing the hack with *STDERR
- $imap->Debug_fh( $mysync->{ tee } ) ;
- }
-
- if ( $ssl ) { set_ssl( $imap, $h ) }
- if ( $tls ) { } # can not do set_tls() here because connect() will directly do a STARTTLS
- $imap->Clear(1);
- $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);
- 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 ) ;
-
-}
-
sub plainauth
{
my $code = shift;
@@ -6714,80 +8153,6 @@
-# xoauth() thanks to Eduardo Bortoluzzi Junior
-sub xoauth
-{
- require URI::Escape ;
- require Data::Uniqid ;
-
- my $code = shift;
- my $imap = shift;
-
- # The base information needed to construct the OAUTH authentication
- my $method = 'GET' ;
- my $url = mysprintf( 'https://mail.google.com/mail/b/%s/imap/', $imap->User ) ;
- my $urlparm = mysprintf( 'xoauth_requestor_id=%s', URI::Escape::uri_escape( $imap->User ) ) ;
-
- # For Google Apps, the consumer key is the primary domain
- # TODO: create a command line argument to define the consumer key
- my @user_parts = split /@/x, $imap->User ;
- $sync->{ debug } and myprint( "XOAUTH: consumer key: $user_parts[1]\n" ) ;
-
- # All the parameters needed to be signed on the XOAUTH
- my %hash = ();
- $hash { 'xoauth_requestor_id' } = URI::Escape::uri_escape($imap->User);
- $hash { 'oauth_consumer_key' } = $user_parts[1];
- $hash { 'oauth_nonce' } = md5_hex(Data::Uniqid::uniqid(rand(), 1==1));
- $hash { 'oauth_signature_method' } = 'HMAC-SHA1';
- $hash { 'oauth_timestamp' } = time ;
- $hash { 'oauth_version' } = '1.0';
-
- # Base will hold the string to be signed
- my $base = "$method&" . URI::Escape::uri_escape( $url ) . q{&} ;
-
- # The parameters must be in dictionary order before signing
- my $baseparms = q{} ;
- foreach my $key ( sort keys %hash ) {
- if ( length( $baseparms ) > 0 ) {
- $baseparms .= q{&} ;
- }
-
- $baseparms .= "$key=$hash{$key}" ;
- }
-
- $base .= URI::Escape::uri_escape($baseparms);
- $sync->{ debug } and myprint( "XOAUTH: base request to sign: $base\n" ) ;
- # Sign it with the consumer secret, informed on the command line (password)
- my $digest = hmac_sha1( $base, URI::Escape::uri_escape( $imap->Password ) . q{&} ) ;
-
- # The parameters signed become a parameter and...
- $hash { 'oauth_signature' } = URI::Escape::uri_escape( substr encode_base64( $digest ), 0, $MINUS_ONE ) ;
-
- # ... we don't need the requestor_id anymore.
- delete $hash{'xoauth_requestor_id'} ;
-
- # Create the final authentication string
- my $string = $method . q{ } . $url . q{?} . $urlparm .q{ } ;
-
- # All the parameters must be sorted
- $baseparms = q{};
- foreach my $key (sort keys %hash) {
- if(length($baseparms)>0) {
- $baseparms .= q{,} ;
- }
-
- $baseparms .= "$key=\"$hash{$key}\"";
- }
-
- $string .= $baseparms;
-
- $sync->{ debug } and myprint( "XOAUTH: authentication string: $string\n" ) ;
-
- # It must be base64 encoded
- return encode_base64("$string", q{});
-}
-
-
sub xmasterauth
{
# This is Kerio auth admin
@@ -6839,29 +8204,6 @@
}
-sub tests_do_valid_directory
-{
- note( 'Entering tests_do_valid_directory()' ) ;
-
- Readonly my $NB_UNIX_tests_do_valid_directory => 2 ;
- 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' ) ;
- }
- Readonly my $NB_UNIX_tests_do_valid_directory_non_root => 2 ;
- SKIP: {
- skip( 'Tests only for Unix', $NB_UNIX_tests_do_valid_directory_non_root ) if ( 'MSWin32' eq $OSNAME or '0' eq $EFFECTIVE_USER_ID ) ;
- 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 banner_imapsync
{
@@ -6870,8 +8212,8 @@
my $banner_imapsync = join q{},
q{$RCSfile: imapsync,v $ },
- q{$Revision: 1.977 $ },
- q{$Date: 2019/12/23 20:18:02 $ },
+ q{$Revision: 2.148 $ },
+ q{$Date: 2021/07/22 14:21:09 $ },
"\n",
"Command line used, run by $EXECUTABLE_NAME:\n",
"$PROGRAM_NAME ", command_line_nopassword( $mysync, @argv ), "\n" ;
@@ -6879,6 +8221,29 @@
return( $banner_imapsync ) ;
}
+sub tests_do_valid_directory
+{
+ note( 'Entering tests_do_valid_directory()' ) ;
+
+ is( 1, do_valid_directory( '.'), 'do_valid_directory: . good' ) ;
+ is( 1, do_valid_directory( './W/tmp/tests/valid/sub'), 'do_valid_directory: ./W/tmp/tests/valid/sub good' ) ;
+
+ Readonly my $NB_UNIX_tests_do_valid_directory_non_root => 2 ;
+ diag( "OSNAME=$OSNAME EFFECTIVE_USER_ID=$EFFECTIVE_USER_ID" ) ;
+
+ SKIP: {
+ skip( 'Tests only for non roor user', $NB_UNIX_tests_do_valid_directory_non_root ) if ( '0' eq $EFFECTIVE_USER_ID ) ;
+ diag( 'The "Error / is not writable" is on purpose' ) ;
+ ok( 0 == do_valid_directory( '/'), 'do_valid_directory: / bad' ) ;
+ diag( 'The "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 do_valid_directory
{
my $dir = shift @ARG ;
@@ -6898,7 +8263,7 @@
return( 0 ) ;
}
# Trying to create it
- myprint( "Creating directory $dir\n" ) ;
+ myprint( "Creating directory $dir (current directory is " . getcwd( ) . ")\n" ) ;
if ( ! eval { mkpath( $dir ) } ) {
myprint( "$EVAL_ERROR" ) if ( $EVAL_ERROR ) ;
}
@@ -6924,11 +8289,14 @@
is( 1, match_a_pid_number( 99999 ), 'match_a_pid_number: 99999 => 1' ) ;
is( 1, match_a_pid_number( -99999 ), 'match_a_pid_number: -99999 => 1' ) ;
is( undef, match_a_pid_number( 0 ), 'match_a_pid_number: 0 => undef' ) ;
- is( undef, match_a_pid_number( 100000 ), 'match_a_pid_number: 100000 => undef' ) ;
- is( undef, match_a_pid_number( 123456 ), 'match_a_pid_number: 123456 => undef' ) ;
+ is( 1, match_a_pid_number( 100000 ), 'match_a_pid_number: 100000 => 1' ) ;
+ is( 1, match_a_pid_number( 123456 ), 'match_a_pid_number: 123456 => 1' ) ;
is( undef, match_a_pid_number( '-0' ), 'match_a_pid_number: "-0" => undef' ) ;
- is( undef, match_a_pid_number( -100000 ), 'match_a_pid_number: -100000 => undef' ) ;
- is( undef, match_a_pid_number( -123456 ), 'match_a_pid_number: -123456 => undef' ) ;
+ is( 1, match_a_pid_number( -100000 ), 'match_a_pid_number: -100000 => 1' ) ;
+ is( 1, match_a_pid_number( -123456 ), 'match_a_pid_number: -123456 => 1' ) ;
+ is( 1, match_a_pid_number( 2**22 ), 'match_a_pid_number: 2**22 => 1' ) ;
+ is( undef, match_a_pid_number( 2**22 + 1 ), 'match_a_pid_number: 2**22 + 1 => undef' ) ;
+ is( undef, match_a_pid_number( 4194304 + 1 ), 'match_a_pid_number: 2**22 + 1 = 4194305 => undef' ) ;
note( 'Leaving tests_match_a_pid_number()' ) ;
return ;
@@ -6944,7 +8312,7 @@
# can be negative on Windows
#if ( 0 > $pid ) { return ; }
#if ( 65535 < $pid ) { return ; }
- if ( 99999 < abs( $pid ) ) { return ; }
+ if ( 2**22 < abs( $pid ) ) { return ; }
if ( 0 == abs( $pid ) ) { return ; }
return 1 ;
}
@@ -6974,13 +8342,20 @@
{
#
my $pid_filename = shift @ARG ;
-
+
+ #myprint( "In remove_pidfile_not_running $pid_filename\n" ) ;
if ( ! $pid_filename ) { myprint( "No variable pid_filename\n" ) ; return } ;
- if ( ! -e $pid_filename ) { myprint( "File $pid_filename does not exist\n" ) ; return } ;
+ if ( ! -e $pid_filename )
+ {
+ myprint( "File $pid_filename does not exist\n" ) ;
+ return ;
+ }
+ #myprint( "Still In remove_pidfile_not_running $pid_filename\n" ) ;
+
if ( ! -f $pid_filename ) { myprint( "File $pid_filename is not a file\n" ) ; return } ;
my $pid = firstline( $pid_filename ) ;
- if ( ! match_a_pid_number( $pid ) ) { myprint( "pid $pid in $pid_filename is not a number\n" ) ; return } ;
+ if ( ! match_a_pid_number( $pid ) ) { myprint( "In remove_pidfile_not_running: pid $pid in $pid_filename is not a pid number\n" ) ; return } ;
# can't kill myself => do nothing
if ( ! kill 'ZERO', $PROCESS_ID ) { myprint( "Can not kill ZERO myself $PROCESS_ID\n" ) ; return } ;
@@ -7061,6 +8436,8 @@
if ( ! $lock ) { return ; }
if ( ! $tail ) { return ; }
+ if ( ! -e $pidfile ) { return ; }
+
my $pidtotail = firstline( $pidfile ) ;
if ( ! $pidtotail ) { return ; }
@@ -7173,13 +8550,14 @@
{
# returns undef if something is considered fatal
# returns 1 otherwise
-
+
+ #myprint( "In write_pidfile\n" ) ;
if ( ! @ARG ) { return 1 ; }
my $mysync = shift @ARG ;
- # Do not write the pid file if this process goal is to abort the process designed by the pid file
- if ( $mysync->{abort} ) { return 1 ; }
+ # Do not write the pid file if the current process goal is to abort the process designed by the pid file
+ if ( $mysync->{ abort } ) { return 1 ; }
#
my $pid_filename = $mysync->{ pidfile } ;
@@ -7384,6 +8762,9 @@
is( '[&ZTZO9nux-] = [收件箱]', jux_utf8( '&ZTZO9nux-'), 'jux_utf8: => [&ZTZO9nux-] = [收件箱]' ) ;
#
+ #
+ is( '[!Old Emails]', jux_utf8( '!Old Emails'), 'jux_utf8: !Old Emails => [!Old Emails]' ) ;
+ is( '[2006 Budget & Fcst]', jux_utf8( '2006 Budget & Fcst'), 'jux_utf8: 2006 Budget & Fcst => [2006 Budget & Fcst]' ) ;
note( 'Leaving tests_jux_utf8()' ) ;
return ;
}
@@ -7530,6 +8911,7 @@
if ( $create_folder_old ) {
return( create_folder_old( $mysync, $myimap2 , $h2_fold , $h1_fold ) ) ;
}
+
myprint( "Creating folder [$h2_fold] on host2\n" ) ;
if ( ( 'INBOX' eq uc $h2_fold )
and ( $myimap2->exists( $h2_fold ) ) ) {
@@ -7577,6 +8959,7 @@
if ( ! $mysync->{ 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" ) ;
+ # The messages that could be transferred are counted and the number is given at the end.
}
return( 0 ) ;
}
@@ -7639,7 +9022,7 @@
{
my @requested_folders_sorted = () ;
- #myprint "folderfirst: @folderfirst\n" ;
+ $sync->{ debug } and myprint "folderfirst: @folderfirst\n" ;
my @folderfirst_requested = remove_from_requested_folders( @folderfirst ) ;
#myprint "folderfirst_requested: @folderfirst_requested\n" ;
@@ -7648,7 +9031,7 @@
my @middle = sort keys %requested_folder ;
@requested_folders_sorted = ( @folderfirst_requested, @middle, @folderlast_requested ) ;
- #myprint "requested_folders_sorted: @requested_folders_sorted\n" ;
+ $sync->{ debug } and myprint "requested_folders_sorted: @requested_folders_sorted\n" ;
add_to_requested_folders( @requested_folders_sorted ) ;
return( @requested_folders_sorted ) ;
@@ -7707,7 +9090,7 @@
is_deeply( [ 'F1', 'F2' ], [ remove_from_requested_folders( 'F1', 'F2' ) ], 'remove_from_requested_folders: remove F1 F2 among F1 F2 F3 => F1 F2' ) ;
is_deeply( { 'F3' => 1 }, { %requested_folder }, 'remove_from_requested_folders: remove F1 F2 among F1 F2 F3 => %requested_folder F3' ) ;
-
+ undef %requested_folder ;
note( 'Leaving tests_remove_from_requested_folders()' ) ;
return ;
@@ -7784,13 +9167,13 @@
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( 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( $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]' ) ;
@@ -8015,6 +9398,7 @@
return( $listing ) ;
}
+# Globals are $sync @h1_folders_all @h2_folders_all $prefix1 $prefix2
sub private_folders_separators_and_prefixes
{
# what are the private folders separators and prefixes for each server ?
@@ -8121,8 +9505,32 @@
}
}
+sub tests_sanitize_host
+{
+ note( 'Entering tests_sanitize_host()' ) ;
+
+ is( undef, sanitize_host( ), 'sanitize_host: no args => undef' ) ;
+ is( '', sanitize_host( '' ), 'sanitize_host: empty => empty' ) ;
+ is( 'imap.example.org', sanitize_host( 'imap.example.org' ), 'sanitize_host: imap.example.org => imap.example.org' ) ;
+ is( 'imap.example.org', sanitize_host( ' imap.example.org' ), 'sanitize_host: imap.example.org 1 => imap.example.org' ) ;
+ is( 'imap.example.org', sanitize_host( 'imap.example.org ' ), 'sanitize_host: imap.example.org 2 => imap.example.org' ) ;
+ is( 'imap.example.org', sanitize_host( 'imap.exam ple.org' ), 'sanitize_host: imap.example.org 3 => imap.example.org' ) ;
+ is( 'imap.example.org', sanitize_host( ' imap.exam ple.org ' ), 'sanitize_host: imap.example.org 4 => imap.example.org' ) ;
+ is( 'imap.example.org', sanitize_host( 'imap.exa/mple.org/' ), 'sanitize_host: imap.example.org/ => imap.example.org' ) ;
+
+ note( 'Leaving tests_sanitize_host()' ) ;
+ return ;
+}
+sub sanitize_host
+{
+ my $host = shift ;
+ if ( ! defined $host ) { return ; }
+
+ $host =~ tr{ /}{}d ;
+ return $host ;
+}
sub tests_add_subfolder1_to_folderrec
@@ -8707,86 +10115,89 @@
-sub tests_flags_regex
+sub tests_regexflags
{
- note( 'Entering tests_flags_regex()' ) ;
+ note( 'Entering tests_regexflags()' ) ;
- 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} ) ;
+ my $mysync = {} ;
+
+ ok( q{} eq regexflags( $mysync, q{} ), 'regexflags, null string q{}' ) ;
+ ok( q{\Seen NonJunk $Spam} eq regexflags( $mysync, q{\Seen NonJunk $Spam} ), q{regexflags, nothing to do} ) ;
- @regexflag = ('I am BAD' ) ;
- ok( not ( defined flags_regex( q{} ) ), 'flags_regex, bad regex' ) ;
+ @{ $mysync->{ regexflag } } = ('I am BAD' ) ;
+ ok( not ( defined regexflags( $mysync, q{} ) ), 'regexflags, 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( q{\Seen NonJunk } eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove $Spam: 's/\$Spam//g'} ) ;
+ @{ $mysync->{ regexflag } } = ( 's/NonJunk//g' ) ;
+ ok( q{\Seen $Spam} eq regexflags( $mysync, q{\Seen NonJunk $Spam} ), q{regexflags, remove NonJunk: 's/NonJunk//g'} ) ;
+ @{ $mysync->{ regexflag } } = ( q{s/\$Spam//g} ) ;
+ ok( q{\Seen NonJunk } eq regexflags( $mysync, q{\Seen NonJunk $Spam} ), q{regexflags, remove $Spam: 's/\$Spam//g'} ) ;
- @regexflag = ( 's/\\\\Seen//g' ) ;
+ @{ $mysync->{ 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 regexflags( $mysync, q{\Seen NonJunk $Spam} ), q{regexflags, remove \Seen: 's/\\\\\\\\Seen//g'} ) ;
- @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} ) ;
+ @{ $mysync->{ regexflag } } = ( 's/(\s|^)[^\\\\]\w+//g' ) ;
+ ok( q{\Seen \Middle \End} eq regexflags( $mysync, q{\Seen NonJunk \Middle $Spam \End} ), q{regexflags: only \word among \Seen NonJunk \Middle $Spam \End} ) ;
+ ok( q{ \Seen \Middle \End1} eq regexflags( $mysync, q{Begin \Seen NonJunk \Middle $Spam \End1 End} ),
+ q{regexflags: 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' ) ;
+ @{ $mysync->{ regexflag } } = ( q{s/.*?(Keep1|Keep2|Keep3)/$1 /g} ) ;
+ ok( 'Keep1 Keep2 ReB' eq regexflags( $mysync, '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' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'REM REM Keep1 Keep2' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'Keep1 REM REM Keep2' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'REM Keep1 REM REM Keep2' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'Keep1 Keep2' ), 'Keep only regex' ) ;
+ ok( 'Keep1 ' eq regexflags( $mysync, 'REM Keep1' ), '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' ) ;
+ @{ $mysync->{ regexflag } } = ( q{s/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g} ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'Keep1 Keep2 ReB' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'Keep1 Keep2 REM REM REM' ), 'Keep only regex' ) ;
+ ok( 'Keep2 ' eq regexflags( $mysync, 'Keep2 REM REM REM' ), 'Keep only regex' ) ;
- @regexflag = ( q{s/.*?(Keep1|Keep2|Keep3)/$1 /g},
+ @{ $mysync->{ 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( 'Keep1 Keep2 ' eq regexflags( $mysync, 'REM Keep1 REM Keep2 REM' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'Keep1 REM Keep2 REM' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'REM Keep1 Keep2 REM' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 ' eq regexflags( $mysync, 'REM Keep1 REM Keep2' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep2 Keep3 ' eq regexflags( $mysync, 'REM Keep1 REM Keep2 REM REM Keep3 REM' ), 'Keep only regex' ) ;
+ ok( 'Keep1 ' eq regexflags( $mysync, 'REM REM Keep1 REM REM REM ' ), 'Keep only regex' ) ;
+ ok( 'Keep1 Keep3 ' eq regexflags( $mysync, '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{Add jrdH8u 's/(.*)/\$1 jrdH8u/'} ) ;
- @regexflag = ('s/jrdH8u *//');
- ok('REM REM REM REM REM ' eq flags_regex('REM REM REM REM REM jrdH8u'), q{Remove jrdH8u s/jrdH8u *//} ) ;
+ @{ $mysync->{ regexflag } } = ( 's/(.*)/$1 jrdH8u/' ) ;
+ ok('REM REM REM REM REM jrdH8u' eq regexflags( $mysync, 'REM REM REM REM REM' ), q{Add jrdH8u 's/(.*)/\$1 jrdH8u/'} ) ;
+ @{ $mysync->{ regexflag } } = ('s/jrdH8u *//' );
+ ok('REM REM REM REM REM ' eq regexflags( $mysync, 'REM REM REM REM REM jrdH8u' ), q{Remove jrdH8u s/jrdH8u *//} ) ;
- @regexflag = (
+ @{ $mysync->{ 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'),
+ eq regexflags( $mysync, '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 regexflags( $mysync, q{} ), 'Keep only regex: Exchange case, null string (Phil)' ) ;
ok( q{}
- eq flags_regex('Blabla $Junk machin truc'),
+ eq regexflags( $mysync, '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 '),
+ eq regexflags( $mysync, '\\Deleted \\Answered \\Draft \\Flagged ' ),
'Keep only regex: Exchange case (Phil)' ) ;
- @regexflag = ( 's/\\\\Flagged//g' ) ;
+ @{ $mysync->{ regexflag } } = ( 's/\\\\Flagged//g' ) ;
is('\Deleted \Answered \Draft ',
- flags_regex('\\Deleted \\Answered \\Draft \\Flagged '),
- 'flags_regex: remove \Flagged 1' ) ;
+ regexflags( $mysync, '\\Deleted \\Answered \\Draft \\Flagged ' ),
+ 'regexflags: remove \Flagged 1' ) ;
+
is('\\Deleted \\Answered \\Draft',
- flags_regex('\\Deleted \\Flagged \\Answered \\Draft'),
- 'flags_regex: remove \Flagged 2' ) ;
+ regexflags( $mysync, '\\Deleted \\Flagged \\Answered \\Draft' ),
+ 'regexflags: remove \Flagged 2' ) ;
# I didn't understand why it gives \F
# https://perldoc.perl.org/perlrebackslash.html
@@ -8795,49 +10206,136 @@
# \F Not available in old Perl so I comment the test
- # @regexflag = ( 's/\\Flagged/X/g' ) ;
+ # @{ $mysync->{ regexflag } } = ( 's/\\Flagged/X/g' ) ;
#is('\Deleted FX \Answered \FX \Draft \FX',
- #flags_regex( '\Deleted Flagged \Answered \Flagged \Draft \Flagged' ),
- # 'flags_regex: remove \Flagged 3 mistery...' ) ;
+ #regexflags( '\Deleted Flagged \Answered \Flagged \Draft \Flagged' ),
+ # 'regexflags: remove \Flagged 3 mistery...' ) ;
- note( 'Leaving tests_flags_regex()' ) ;
+ $mysync->{ regexflag } = [ ] ;
+ $mysync->{ filterbuggyflags } = 1 ;
+ filterbuggyflags( $mysync ) ;
+
+ is( '\Deleted \Answered \Draft \Flagged',
+ regexflags( $mysync, '\\Deleted \\Answered \\RECEIPTCHECKED \\Draft \\Indexed \\Flagged' ),
+ 'regexflags: remove famous /X 1' ) ;
+
+ is( '\\Deleted \\Flagged \\Answered \\Draft',
+ regexflags( $mysync, '\\Deleted \\RECEIPTCHECKED \\Flagged \\Answered \\Indexed \\Draft' ),
+ 'regexflags: remove famous /X 2' ) ;
+
+ is( '\ ', '\\ ', 'regexflags: \ is \\ ' ) ;
+ is( '\\ ', '\\ ', 'regexflags: \\ is \\ ' ) ;
+ is( '\\ \ ', '\ \\ ', 'regexflags: \\ \ is \ \\ ' ) ;
+ note( 'Leaving tests_regexflags()' ) ;
return ;
}
-sub flags_regex
+sub regexflags
{
- 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" ) ;
+ my $mysync = shift ;
+ my $flags = shift ;
+
+ foreach my $regexflag ( @{ $mysync->{ regexflag } } )
+ {
+ my $flags_orig = $flags ;
+ $debugflags and myprint( "eval \$flags =~ $regexflag\n" ) ;
+ my $ret = eval "\$flags =~ $regexflag ; 1 " ;
+ $debugflags and myprint( "regexflag $regexflag [$flags_orig] -> [$flags]\n" ) ;
if( not ( defined $ret ) or $EVAL_ERROR ) {
myprint( "Error: eval regexflag '$regexflag': $EVAL_ERROR\n" ) ;
return( undef ) ;
}
}
- return( $h1_flags ) ;
+ return( $flags ) ;
}
+
+sub filterbuggyflags
+{
+ my $mysync = shift ;
+ if ( $mysync->{ filterbuggyflags } )
+ {
+ unshift @{ $mysync->{ regexflag } }, buggyflagsregex( ) ;
+ }
+ return ;
+}
+
+
+sub tests_remove_doublequotes_if_any
+{
+ note( 'Entering tests_remove_doublequotes_if_any()' ) ;
+ # the number of tests is stupid here
+ is( undef, remove_doublequotes_if_any( ), 'remove_doublequotes_if_any: no args => undef' ) ;
+ is( q{}, remove_doublequotes_if_any( q{} ), 'remove_doublequotes_if_any: empty string => empty string' ) ;
+ is( q{}, remove_doublequotes_if_any( q{""} ), 'remove_doublequotes_if_any: double-quotes => empty string' ) ;
+ is( q{}, remove_doublequotes_if_any( q{"""} ), 'remove_doublequotes_if_any: double-quotes => empty string' ) ;
+ is( q{}, remove_doublequotes_if_any( q{"""} ), 'remove_doublequotes_if_any: double-quotes => empty string' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{"toto"} ), 'remove_doublequotes_if_any: "toto" => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{toto} ), 'remove_doublequotes_if_any: toto => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{to"to} ), 'remove_doublequotes_if_any: to"to => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{toto"} ), 'remove_doublequotes_if_any: toto" => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{"toto} ), 'remove_doublequotes_if_any: "toto => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{"to"to} ), 'remove_doublequotes_if_any: "to"to => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{to"to"} ), 'remove_doublequotes_if_any: to"to" => toto' ) ;
+
+ is( q{toto}, remove_doublequotes_if_any( q{to\"to} ), 'remove_doublequotes_if_any: to\"to => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{toto\"} ), 'remove_doublequotes_if_any: toto\" => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{\"toto} ), 'remove_doublequotes_if_any: \"toto => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{\"to\"to} ), 'remove_doublequotes_if_any: \"to\"to => toto' ) ;
+ is( q{toto}, remove_doublequotes_if_any( q{to\"to\"} ), 'remove_doublequotes_if_any: to\"to" => toto' ) ;
+
+
+ note( 'Leaving tests_remove_doublequotes_if_any()' ) ;
+ return ;
+}
+
+
+
+sub remove_doublequotes_if_any
+{
+ my $string = shift ;
+
+ if ( ! defined $string ) { return ; }
+ $string =~ s/\\\"//g ;
+ $string =~ tr/"//d ;
+ return $string ;
+}
+
+
+# No globals here
sub acls_sync
{
- my($h1_fold, $h2_fold) = @_ ;
- if ( $syncacls ) {
- my $h1_hash = $sync->{imap1}->getacl($h1_fold)
- or myprint( "Could not getacl for $h1_fold: $EVAL_ERROR\n" ) ;
- my $h2_hash = $sync->{imap2}->getacl($h2_fold)
- or myprint( "Could not getacl for $h2_fold: $EVAL_ERROR\n" ) ;
+# https://tools.ietf.org/html/rfc4314
+# Standard Rights:
+# https://tools.ietf.org/html/rfc4314#section-2.1
+
+ my( $mysync, $h1_fold, $h2_fold ) = @_ ;
+ if ( $mysync->{ syncacls } ) {
+ my $h1_hash = $mysync->{imap1}->getacl($h1_fold)
+ or myprint( "Host1: Could not getacl for $h1_fold: $EVAL_ERROR\n" ) ;
+ my $h2_hash = $mysync->{imap2}->getacl($h2_fold)
+ or myprint( "Host2: 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" ) ;
- $sync->{imap2}->setacl($h2_fold, $user, $acl)
- or myprint( "Could not set acl: $EVAL_ERROR\n" ) ;
+ my $h1_acl = remove_doublequotes_if_any( $h1_hash->{$user} ) || '' ;
+ my $h2_acl = remove_doublequotes_if_any( $h2_hash->{$user} ) || '' ;
+ myprint( "Host1: user $user has acl [$h1_acl] on host1\n" ) ;
+ myprint( "Host2: user $user has acl [$h2_acl] on host2\n" ) ;
+ # removes surrounding double-quotes if any
+ my $user_no_quotes = remove_doublequotes_if_any( $user ) ;
+
+ if ( $h1_hash->{$user}
+ && $h2_hash->{$user}
+ && $h1_hash->{$user} eq $h2_hash->{$user} )
+ {
+ myprint( "Host2: user $user_no_quotes has already the same acl, no need to set it.\n" ) ;
+ next ;
+ }
+ myprint( "Host2: setting acl for folder $h2_fold user $user_no_quotes acl $h1_acl $mysync->{dry_message}\n" ) ;
+ unless ( $mysync->{dry} ) {
+ $mysync->{imap2}->setacl( $h2_fold, $user_no_quotes, $h1_acl )
+ or myprint( "Could not set acl for user $user_no_quotes on host2: $EVAL_ERROR\n" ) ;
}
}
}
@@ -8874,10 +10372,11 @@
if ( $line =~ m{\[PERMANENTFLAGS\s\(([^)]+?)\)\]}x ) {
( $debugflags or $sync->{ debug } ) and myprint( "permanentflags: $line" ) ;
my $permanentflags = $1 ;
- if ( $permanentflags =~ m{\\\*}x ) {
+ if ( $permanentflags =~ m{\\\*}x )
+ {
$permanentflags = q{} ;
}
- return($permanentflags) ;
+ return( $permanentflags ) ;
} ;
}
return( q{} ) ;
@@ -8913,19 +10412,6 @@
return( $flags_out ) ;
}
-sub flagscase
-{
- 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_out = join q{ }, @flags_out ;
-
- return( $flags_out ) ;
-}
-
sub tests_flagscase
{
note( 'Entering tests_flagscase()' ) ;
@@ -8943,6 +10429,93 @@
return ;
}
+sub flagscase
+{
+ 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_out = join q{ }, @flags_out ;
+
+ return( $flags_out ) ;
+}
+
+
+
+sub tests_flags_for_host2
+{
+ note( 'Entering tests_flags_for_host2()' ) ;
+
+ is( undef, flags_for_host2( ), 'flags_for_host2: no args => undef' ) ;
+
+ my $mysync ;
+ is( undef, flags_for_host2( $mysync ), 'flags_for_host2: undef => undef' ) ;
+
+ $mysync = { } ;
+ is( undef, flags_for_host2( $mysync ), 'flags_for_host2: nothing => undef' ) ;
+
+ is( q{}, flags_for_host2( $mysync, '' ), 'flags_for_host2: no flags => empty string' ) ;
+
+ is( q{}, flags_for_host2( $mysync, '\Recent' ), 'flags_for_host2: \Recent => empty string' ) ;
+
+ is( q{\Seen}, flags_for_host2( $mysync, '\Recent \Seen' ), 'flags_for_host2: \Recent \Seen => \Seen' ) ;
+
+ is( q{\Deleted \Seen}, flags_for_host2( $mysync, '\Deleted \Recent \Seen' ), 'flags_for_host2: \Deleted \Recent \Seen => \Deleted \Seen' ) ;
+
+ $mysync->{ flagscase } = 0 ;
+ is( q{\DELETED \Seen}, flags_for_host2( $mysync, '\DELETED \Seen' ), 'flags_for_host2: flagscase = 0 \DELETED \Seen => \DELETED \Seen' ) ;
+
+ $mysync->{ flagscase } = 1 ;
+ is( q{\Deleted \Seen}, flags_for_host2( $mysync, '\DELETED \Seen' ), 'flags_for_host2: flagscase = 1 \DELETED \Seen => \Deleted \Seen' ) ;
+
+ $mysync->{ filterflags } = 0 ;
+ is( q{\Seen \Blabla}, flags_for_host2( $mysync, '\Seen \Blabla', '\Seen \Junk' ), 'flags_for_host2: filterflags = 0 \Seen \Blabla among \Seen \Junk => \Seen \Blabla' ) ;
+
+ $mysync->{ filterflags } = 1 ;
+ is( q{\Seen}, flags_for_host2( $mysync, '\Seen \Blabla', '\Seen \Junk' ), 'flags_for_host2: filterflags = 1 \Seen \Blabla among \Seen \Junk => \Seen' ) ;
+
+ $mysync->{ filterflags } = 1 ;
+ is( q{\Seen \Blabla}, flags_for_host2( $mysync, '\Seen \Blabla', '' ), 'flags_for_host2: filterflags = 1 \Seen \Blabla among "" => \Seen \Blabla' ) ;
+
+
+ note( 'Leaving tests_flags_for_host2()' ) ;
+ return ;
+}
+
+
+
+
+sub flags_for_host2
+{
+ my $mysync = shift ;
+ my $h1_flags = shift ;
+ my $permanentflags2 = shift ;
+
+ if ( ! all_defined( $mysync, $h1_flags ) ) { return ; } ;
+
+ # RFC 2060: This flag can not be altered by any client
+ $h1_flags =~ s@\\Recent\s?@@xgi ;
+
+ my $h1_flags_re ;
+ if ( $mysync->{ regexflag } and defined( $h1_flags_re = regexflags( $mysync, $h1_flags ) ) ) {
+ $h1_flags = $h1_flags_re ;
+ }
+
+ if ( $mysync->{ flagscase } )
+ {
+ $h1_flags = flagscase( $h1_flags ) ;
+ }
+
+ if ( $permanentflags2 and $mysync->{ filterflags } )
+ {
+ $h1_flags = flags_filter( $h1_flags, $permanentflags2 ) ;
+ }
+
+ return( $h1_flags ) ;
+}
+
sub ucsecond
@@ -9041,8 +10614,7 @@
$debugdev and myprint( "Calling fetch_hash()\n" ) ;
- my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
- my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
+ my $fetch_hash_uids = $fetch_hash_set || "1:*" ;
%fetch = %{$imap->fetch_hash( $fetch_hash_uids, 'INTERNALDATE' ) } ;
@msgs_all = sort { $a <=> $b } keys %fetch ;
@@ -9108,6 +10680,10 @@
@min = @{ $min_ref } ;
SWITCH: {
+ if ( not ( defined $minage or defined $maxage ) )
+ {
+ return ;
+ }
unless( defined $minage ) { @msgs = @max ; last SWITCH } ;
unless( defined $maxage ) { @msgs = @min ; last SWITCH } ;
my ( %union, %inter ) ;
@@ -9125,23 +10701,38 @@
sub tests_msgs_from_maxmin
{
- note( 'Entering tests_msgs_from_maxmin()' ) ;
+ note( 'Entering tests_msgs_from_maxmin()' ) ;
+
my @msgs ;
+
+ # no maxage nor minage
+ @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
+ is_deeply( [ ], \@msgs , 'msgs_from_maxmin: no maxage nor minage => empty result' ) ;
+
+ # maxage alone
$maxage = $NUMBER_200 ;
@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
- ok( 0 == compare_lists( [ '1', '2' ], \@msgs ), 'msgs_from_maxmin: maxage++' ) ;
+ is_deeply( [ '1', '2' ], \@msgs , 'msgs_from_maxmin: maxage++' ) ;
+
+ # maxage > minage -> intersection
$minage = $NUMBER_100 ;
@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
- ok( 0 == compare_lists( [ '2' ], \@msgs ), 'msgs_from_maxmin: -maxage++minage-' ) ;
+ is_deeply( [ '2' ], \@msgs , 'msgs_from_maxmin: -maxage++minage-' ) ;
+
+ # maxage < minage -> union
$minage = $NUMBER_300 ;
@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
- ok( 0 == compare_lists( [ '1', '2', '3' ], \@msgs ), 'msgs_from_maxmin: ++maxage-minage++' ) ;
+ is_deeply( [ '1', '2', '3' ], \@msgs, 'msgs_from_maxmin: ++maxage-minage++' ) ;
+
+
+ # minage alone
$maxage = undef ;
@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
- ok( 0 == compare_lists( [ '2', '3' ], \@msgs ), 'msgs_from_maxmin: ++minage-' ) ;
+ is_deeply( [ '2', '3' ], \@msgs, 'msgs_from_maxmin: ++minage-' ) ;
- note( 'Leaving tests_msgs_from_maxmin()' ) ;
+
+ note( 'Leaving tests_msgs_from_maxmin()' ) ;
return ;
}
@@ -9249,6 +10840,13 @@
( $mysync->{ debug } or $mysync->{dry} )
and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $mysync->{dry_message} " . eta( $mysync ) . "\n" ) ;
+ if ( $mysync->{dry1} )
+ {
+ $mysync->{ h1_nb_msg_processed } +=1 ;
+ $nb_msg_skipped_dry_mode += 1 ;
+ return ;
+ }
+
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{} ;
@@ -9294,7 +10892,7 @@
( $mysync->{ 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 ) ;
+ $h1_flags = flags_for_host2( $mysync, $h1_flags, $permanentflags2 ) ;
( $mysync->{ debug } or $debugflags ) and
myprint( "Host1: flags filt msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n" ) ;
@@ -9447,7 +11045,7 @@
${ $string_ref } = $header . "\r\n" . ${ $string_ref } ;
}
- if ( ( defined $mysync->{ truncmess } ) and is_an_integer( $mysync->{ truncmess } ) )
+ if ( ( defined $mysync->{ truncmess } ) and is_integer( $mysync->{ truncmess } ) )
{
${ $string_ref } = truncmess( ${ $string_ref }, $mysync->{ truncmess } ) ;
}
@@ -10094,20 +11692,6 @@
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_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 = flags_filter( $h1_flags, $permanentflags2) if ( $permanentflags2 and $filterflags ) ;
-
- return( $h1_flags ) ;
-}
sub subject
{
@@ -10116,7 +11700,7 @@
my $header = extract_header( $string ) ;
- if( $header =~ m/^Subject:\s*([^\n\r]*)\r?$/msx ) {
+ if( $header =~ m/^Subject:[ \t]*([^\n\r]*)\r?$/msx ) {
#myprint( "MMM[$1]\n" ) ;
$subject = $1 ;
}
@@ -10125,12 +11709,14 @@
sub tests_subject
{
- note( 'Entering tests_subject()' ) ;
+ 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') ;
+ is( '', subject( 'Subject:' ), 'Subject:') ;
+ is( '', subject( "Subject:\r\n" ), 'Subject:\r\n') ;
+ 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') ;
+ ok( 'toto le hero' eq subject( "Subject:toto le hero\r\n" ), 'Subject: toto le hero\r\n') ;
my $MESS ;
$MESS = <<'EOF';
@@ -10169,13 +11755,24 @@
EOF
ok( q{} eq subject( $MESS ), 'subject: null but body could') ;
+
+ $MESS = <<'EOF';
+From: lalala
+Subject:
+Date: zzzzzz
+
+Subject: toto le hero
+EOF
+ is( '', subject( $MESS ), 'Subject:') ;
+
+
+
note( 'Leaving tests_subject()' ) ;
return ;
}
# GlobVar
-# $max_msg_size_in_bytes
# $h2_uidguess
# ...
#
@@ -10187,10 +11784,9 @@
my $new_id ;
if ( ! $mysync->{dry} ) {
- $max_msg_size_in_bytes = max( $string_len, $max_msg_size_in_bytes ) ;
$new_id = $mysync->{imap2}->append_string( $h2_fold, ${ $string_ref }, $h1_flags, $h1_date ) ;
myprint( debugmemory( $mysync, " at A2" ) ) ;
- if ( ! $new_id){
+ if ( ! defined $new_id ){
my $subject = subject( ${ $string_ref } ) ;
my $error_imap = $mysync->{imap2}->LastError || q{} ;
my $error = "- msg $h1_fold/$h1_msg {$string_len} could not append ( Subject:[$subject], Date:[$h1_date], Size:[$h1_size], Flags:[$h1_flags] ) to folder $h2_fold: $error_imap\n" ;
@@ -10210,6 +11806,7 @@
$mysync->{ total_bytes_transferred } += $string_len ;
$mysync->{ nb_msg_transferred } += 1 ;
$mysync->{ h1_nb_msg_processed } +=1 ;
+ $mysync->{ biggest_message_transferred } = max( $string_len, $mysync->{ biggest_message_transferred } ) ;
my $time_spent = timesince( $mysync->{begin_transfer_time} ) ;
my $rate = bytes_display_string( $mysync->{total_bytes_transferred} / $time_spent ) ;
@@ -10279,15 +11876,18 @@
{
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 ;
- }
+ 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 ;
# Must be positive
@@ -10360,7 +11960,7 @@
sub tests_sleep_max_bytes
{
- note( 'Entering tests_sleep_max_bytes()' ) ;
+ 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') ;
@@ -10371,7 +11971,7 @@
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()' ) ;
+ note( 'Leaving tests_sleep_max_bytes()' ) ;
return ;
}
@@ -10383,7 +11983,8 @@
if ( ! @h1_msg ) { return ; }
delete_messages_on_any(
$mysync,
- $mysync->{imap1},
+ $mysync->{ acc1 },
+ $mysync->{ imap1 },
"Host1: $h1_fold",
$expunge,
$split1,
@@ -10419,18 +12020,22 @@
return ;
}
+
sub delete_messages_on_any
{
- my( $mysync, $imap, $hostX_folder, $expunge, $split, @messages ) = @_ ;
+ # $acc is not used yet,
+ #
+ my( $mysync, $acc, $imap, $hostX_folder, $expunge, $split, @messages ) = @_ ;
my $expunge_message = q{} ;
my $dry_message = $mysync->{ dry_message } ;
$expunge_message = 'and expunged' if ( $expunge ) ;
# "Host1: msg "
- $imap->Debug( 1 ) ;
+ # $imap->Debug( 1 ) ;
- while ( my @messages_part = splice @messages, 0, $split )
+ my @messages_to_mark_deleted = @messages ;
+ while ( my @messages_part = splice @messages_to_mark_deleted, 0, $split )
{
foreach my $message ( @messages_part )
{
@@ -10442,7 +12047,7 @@
if ( defined $nb_deleted )
{
# $nb_deleted is not accurate
- $mysync->{ h1_nb_msg_deleted } += scalar @messages_part ;
+ $acc->{ nb_msg_deleted } += scalar @messages_part ;
}
else
{
@@ -10458,7 +12063,7 @@
uidexpunge_or_expunge( $mysync, $imap, @messages ) ;
}
- $imap->Debug( 0 ) ;
+ #$imap->Debug( 0 ) ;
return ;
}
@@ -10547,13 +12152,13 @@
$mysync->{ begin_transfer_time } = time ; # Now
$mysync->{ h1_nb_msg_processed } = 0 ;
- is( "ETA: " . localtime( time ) . " 0 s 0/0 msgs left",
+ is( "ETA: " . localtimez( time ) . " 0 s 0/0 msgs left",
eta( $mysync ),
'eta: no args => ETA: "Now" 0 s 0/0 msgs left' ) ;
$mysync->{ h1_nb_msg_processed } = 1 ;
$mysync->{ h1_nb_msg_start } = 2 ;
- is( "ETA: " . localtime( time ) . " 0 s 1/2 msgs left",
+ is( "ETA: " . localtimez( time ) . " 0 s 1/2 msgs left",
eta( $mysync ),
'eta: 1, 1, 2 => ETA: "Now" 0 s 1/2 msgs left' ) ;
@@ -10584,7 +12189,7 @@
my $time_remaining = time_remaining( $time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_msg_transferred ) ;
$mysync->{ debug } and myprint( "time_spent: $time_spent time_remaining: $time_remaining\n" ) ;
my $nb_msg_remaining = $h1_nb_msg_start - $h1_nb_processed ;
- my $eta_date = localtime( time + $time_remaining ) ;
+ my $eta_date = localtimez( 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 ) ) ;
}
@@ -11171,6 +12776,7 @@
}
+
sub tests_tmpdir_has_colon_bug
{
note( 'Entering tests_tmpdir_has_colon_bug()' ) ;
@@ -11237,7 +12843,7 @@
myprint( "Old cache directory $cachedir_old still exists\n" ) ;
$err++ ;
}else{
- myprint( "Old cache directory $cachedir_old successfuly moved\n" ) ;
+ myprint( "Old cache directory $cachedir_old successfully moved\n" ) ;
}
}
return( not $err ) ;
@@ -11280,31 +12886,33 @@
sub tests_filter_forbidden_characters
{
- note( 'Entering 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' ) ;
+ is( undef , filter_forbidden_characters( ), 'filter_forbidden_characters: no args -> undef' ) ;
- 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 "' ) ;
- } ;
+ is( 'a_b' , filter_forbidden_characters( 'a_b' ), 'filter_forbidden_characters: a_b -> a_b' ) ;
+ is( 'a_b' , filter_forbidden_characters( 'a*b' ), 'filter_forbidden_characters: a*b -> a_b' ) ;
+ is( 'a_b' , filter_forbidden_characters( 'a|b' ), 'filter_forbidden_characters: a|b -> a_b' ) ;
+ is( 'a_b' , filter_forbidden_characters( 'a?b' ), 'filter_forbidden_characters: a?b -> a_b' ) ;
+ is( 'a________b', filter_forbidden_characters( q{a*|?:"<>'b} ), q{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_"' ) ;
- } ;
- ok( 'a_b' eq filter_forbidden_characters( "a\tb" ), 'filter_forbidden_characters: a\tb -> a_b' ) ;
- ok( "a_b" eq filter_forbidden_characters( "a\rb" ), 'filter_forbidden_characters: a\rb -> a_b' ) ;
- ok( "a_b" eq filter_forbidden_characters( "a\nb" ), 'filter_forbidden_characters: a\nb -> a_b' ) ;
- ok( "a_b" eq filter_forbidden_characters( "a\\b" ), 'filter_forbidden_characters: a\b -> a_b' ) ;
+ is( 'a_b_' , filter_forbidden_characters( 'a b ' ), 'filter_forbidden_characters: "a b " -> "a_b_"' ) ;
- note( 'Leaving tests_filter_forbidden_characters()' ) ;
+
+ is( 'a_b' , filter_forbidden_characters( "a\tb" ), 'filter_forbidden_characters: a\tb -> a_b' ) ;
+ is( "a_b" , filter_forbidden_characters( "a\rb" ), 'filter_forbidden_characters: a\rb -> a_b' ) ;
+ is( "a_b" , filter_forbidden_characters( "a\nb" ), 'filter_forbidden_characters: a\nb -> a_b' ) ;
+ is( "a_b" , filter_forbidden_characters( "a\\b" ), 'filter_forbidden_characters: a\b -> a_b' ) ;
+
+ is( 'a-b' , filter_forbidden_characters( 'a-b' ), 'filter_forbidden_characters: a-b -> a-b' ) ;
+ is( 'a__-__-__-__-__b' , filter_forbidden_characters( 'aé-è-à -ç-Öb' ), 'filter_forbidden_characters: aé-è-à -ç-Öb -> a__-__-__-__-__b' ) ;
+
+ is( 'abcdABCDwxyzWXYZ012789' , filter_forbidden_characters( 'abcdABCDwxyzWXYZ012789' ),
+ 'filter_forbidden_characters: abcdABCDwxyzWXYZ012789 -> abcdABCDwxyzWXYZ012789' ) ;
+
+
+ note( 'Leaving tests_filter_forbidden_characters()' ) ;
return ;
}
@@ -11312,13 +12920,12 @@
{
my $string = shift ;
- if ( ! defined $string ) { return ; }
+ if ( ! defined $string ) { return ; }
- if ( 'MSWin32' eq $OSNAME ) {
- # Move trailing whitespace to _ " a b /c d " -> " a b_/c d_"
- $string =~ s{\ (/|$)}{_$1}xg ;
- }
- $string =~ s{[\Q*|?:"<>\E\t\r\n\\]}{_}xg ;
+ $string =~ s{[\Q*|?:"<>' \E\t\r\n\\]}{_}xg ;
+ # replace all non-ascii and control characters by _
+ $string =~ s/[[:^ascii:][:cntrl:]]/_/xg ;
+
#myprint( "[$string]\n" ) ;
return( $string ) ;
}
@@ -11351,58 +12958,58 @@
sub tests_regexmess
{
- note( 'Entering 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' ) ;
+ ok( not( defined regexmess( 'popopo' ) ), 'regexmess: bad regex lalala' ) ;
@regexmess = ( 's/p/Z/g' ) ;
- ok( 'ZoZoZo' eq regexmess( 'popopo' ), '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: c->C');
@regexmess = ( 's{\AFrom\ }{From:}gxms' ) ;
ok( q{}
eq regexmess(q{}),
- 'From mbox 1 add colon blank');
+ 'regexmess: From mbox 1 add colon blank');
ok( 'From:<tartanpion@machin.truc>'
eq regexmess('From <tartanpion@machin.truc>'),
- 'From mbox 2 add colo');
+ 'regexmess: From mbox 2 add colo');
ok( "\n" . 'From <tartanpion@machin.truc>'
eq regexmess("\n" . 'From <tartanpion@machin.truc>'),
- 'From mbox 3 add colo') ;
+ 'regexmess: From mbox 3 add colo') ;
ok( "From: zzz\n" . 'From <tartanpion@machin.truc>'
eq regexmess("From zzz\n" . 'From <tartanpion@machin.truc>'),
- 'From mbox 4 add colo') ;
+ 'regexmess: From mbox 4 add colo') ;
@regexmess = ( 's{\AFrom\ [^\n]*(\n)?}{}gxms' ) ;
ok( q{}
eq regexmess(q{}),
- 'From mbox 1 remove, blank');
+ 'regexmess: From mbox 1 remove, blank');
ok( q{}
eq regexmess('From <tartanpion@machin.truc>'),
- 'From mbox 2 remove');
+ 'regexmess: From mbox 2 remove');
ok( "\n" . 'From <tartanpion@machin.truc>'
eq regexmess("\n" . 'From <tartanpion@machin.truc>'),
- 'From mbox 3 remove');
+ 'regexmess: From mbox 3 remove');
#myprint( "[", regexmess("From zzz\n" . 'From <tartanpion@machin.truc>'), "]" ) ;
ok( q{} . 'From <tartanpion@machin.truc>'
eq regexmess("From zzz\n" . 'From <tartanpion@machin.truc>'),
- 'From mbox 4 remove');
+ 'regexmess: From mbox 4 remove');
- ok(
+ is(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11410,7 +13017,7 @@
Hello,
Bye.
EOM
- eq regexmess(
+ , regexmess(
<<'EOM'
From zzz
Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -11419,7 +13026,7 @@
Hello,
Bye.
EOM
-), 'From mbox 5 remove');
+ ), 'regexmess: From mbox 5 remove');
@regexmess = ( 's{\A((?:[^\n]+\n)+|)^Disposition-Notification-To:[^\n]*\n(\r?\n|.*\n\r?\n)}{$1$2}xms' ) ; # SUPER SUPER BEST!
@@ -11460,7 +13067,7 @@
Hello,
Bye.
EOM
-),
+ ),
'regexmess: 2 Delete header Disposition-Notification-To:');
ok(
@@ -11480,7 +13087,7 @@
Hello,
Bye.
EOM
-),
+ ),
'regexmess: 3 Delete header Disposition-Notification-To:');
ok(
@@ -11500,7 +13107,7 @@
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Bye.
EOM
-),
+ ),
'regexmess: 4 Delete header Disposition-Notification-To:');
@@ -11520,11 +13127,11 @@
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Bye.
EOM
-),
+ ),
'regexmess: 5 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11542,10 +13149,10 @@
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Bye.
EOM
-),
+ ),
'regexmess: 6 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11565,11 +13172,11 @@
Bye.
EOM
-),
+ ),
'regexmess: 7 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11589,7 +13196,7 @@
'regexmess: 8 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11607,12 +13214,12 @@
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Bye.
EOM
-),
+ ),
'regexmess: 9 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11634,10 +13241,10 @@
Bye.
EOM
-),
+ ),
'regexmess: 10 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11662,7 +13269,7 @@
),
'regexmess: 11 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11688,15 +13295,15 @@
Bye.
EOM
-),
+ ),
'regexmess: 12 Delete header Disposition-Notification-To:');
-@regexmess = ( 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' ) ; # BAD!
-@regexmess = ( 's{\A((?:[^\n]+\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims' ) ;
+ @regexmess = ( 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' ) ; # BAD!
+ @regexmess = ( 's{\A((?:[^\n]+\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims' ) ;
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11722,10 +13329,10 @@
Bye.
EOM
-),
+ ),
'regexmess: 13 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
X-Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
@@ -11753,10 +13360,10 @@
Bye.
EOM
-),
+ ),
'regexmess: 14 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
X-Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
@@ -11776,11 +13383,11 @@
Bye.
EOM
-),
+ ),
'regexmess: 15 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
@@ -11800,10 +13407,10 @@
Bye.
EOM
-),
+ ),
'regexmess: 16 Delete header Disposition-Notification-To:');
-ok(
+ ok(
<<'EOM'
X-Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Date: Sat, 10 Jul 2010 05:34:45 -0700
@@ -11827,15 +13434,15 @@
'regexmess: 17 Delete header Disposition-Notification-To:');
@regexmess = ( 's/.{11}\K.*//gs' ) ;
- is( "0123456789\n", regexmess( "0123456789\n" x 100 ), 'regexmess, truncate whole message after 11 characters' ) ;
- is( "0123456789\n", regexmess( "0123456789\n" x 100_000 ), 'regexmess, truncate whole message after 11 characters ~ 1MB' ) ;
+ is( "0123456789\n", regexmess( "0123456789\n" x 100 ), 'regexmess: truncate whole message after 11 characters' ) ;
+ is( "0123456789\n", regexmess( "0123456789\n" x 100_000 ), 'regexmess: truncate whole message after 11 characters ~ 1MB' ) ;
@regexmess = ( 's/.{10000}\K.*//gs' ) ;
- is( "123456789\n" x 1000, regexmess( "123456789\n" x 100_000 ), 'regexmess, truncate whole message after 10000 characters ~ 1MB' ) ;
+ is( "123456789\n" x 1000, regexmess( "123456789\n" x 100_000 ), 'regexmess: truncate whole message after 10000 characters ~ 1MB' ) ;
-@regexmess = ( 's/^(X-Ham-Report.*?\n)^X-/X-/sm' ) ;
+ @regexmess = ( 's/^(X-Ham-Report.*?\n)^X-/X-/sm' ) ;
-is(
+ is(
<<'EOM'
X-Spam-Score: -1
X-Spam-Bar: /
@@ -11848,7 +13455,7 @@
Bye.
EOM
,
-regexmess(
+ regexmess(
<<'EOM'
X-Spam-Score: -1
X-Spam-Bar: /
@@ -11868,20 +13475,247 @@
Bye.
EOM
-),
- 'regexmess: 1 Delete header X-Ham-Report:');
+ ),
+ 'regexmess: Delete header X-Ham-Report:');
# regex to play with Date: from the FAQ
#@regexmess = 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}gxms'
+# Change 8bit characters in whole email to X characters
+ @regexmess = ( 's{[\x80-\xff]}{X}gxms' ) ;
+ is( 'X-8bit: kaka 1 XX kiki', regexmess('X-8bit: kaka 1 ¤ kiki'), 'regexmess: 1 Change 8bit characters in whole email to X characters');
+
+# Same change but using tr
+ @regexmess = ( 'tr [\x80-\xff] [X]' ) ;
+ is( 'X-8bit: kaka 1 XXXX kiki', regexmess('X-8bit: kaka 1 ¤£ kiki'), 'regexmess: 2 Change 8bit characters in whole email to X characters, using tr');
- note( 'Leaving tests_regexmess()' ) ;
- return ;
+# Add a final \r\n if missing
+ @regexmess = ( 's{(?<![\n])\z}{\r\n}gxms' ) ;
+ is( "\r\n", regexmess(""), 'regexmess: 1. Add a final \r\n if missing. Missing' ) ;
+ is( "abc\r\n", regexmess("abc"), 'regexmess: 2. Add a final \r\n if missing. Missing' ) ;
+ is( "abc\ndef\r\n", regexmess("abc\ndef"), 'regexmess: 3. Add a final \r\n if missing. Missing' ) ;
+ is( "abc\r\ndef\r\n", regexmess("abc\r\ndef"), 'regexmess: 3. Add a final \r\n if missing. Missing' ) ;
+ is( "\r\n", regexmess("\r\n"), 'regexmess: 3. Add a final \r\n if missing. Not missing' ) ;
+ is( "abc\n", regexmess("abc\n"), 'regexmess: 4. Add a final \r\n if missing. Not missing' ) ;
+ is( "abc\r\n", regexmess("abc\r\n"), 'regexmess: 4. Add a final \r\n if missing. Not missing' ) ;
+ is( "abc\ndef\n", regexmess("abc\ndef\n"), 'regexmess: 4. Add a final \r\n if missing. Not missing' ) ;
+ is( "abc\r\ndef\r\n", regexmess("abc\r\ndef\r\n"), 'regexmess: 4. Add a final \r\n if missing. Not missing' ) ;
+
+# Remove the fucking buggy X-Spam-Report: a bad header on several lines that can even begin without a space!
+
+ @regexmess = ( 's{X-Spam-Report:.*?\n(^[^\n]+:|^\r?\n)}{$1}xms' ) ;
+ # Damien regexes:
+ #@regexmess = ( 's{X-Spam-Report:.*?\n(^[a-zA-Z0-9\-]+:)}{$1}xms' ) ;
+ #@regexmess = ( 's{X-Spam-Report:.*?\n(^[a-zA-Z0-9\-]+:|^\r?\n)}{$1}xms' ) ;
+
+ is(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+LaSuite: super
+
+Hello,
+Bye.
+EOM
+ , regexmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+X-Spam-Report: caca
+caca
+ caca
+caca
+LaSuite: super
+
+Hello,
+Bye.
+EOM
+ ), 'regexmess: 1 remove buggy X-Spam-Report: across several lines, not the final header');
+
+
+ is(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+LaSuite: super
+LaSuite2: super 2
+
+Hello,
+Bye.
+EOM
+ , regexmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+X-Spam-Report: caca
+caca
+ caca
+caca
+LaSuite: super
+LaSuite2: super 2
+
+Hello,
+Bye.
+EOM
+ ), 'regexmess: 2 remove buggy X-Spam-Report: across several lines, not the final header');
+
+
+ is(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+LaSuite: super
+LaSuite2: super 2
+
+Hello,
+Bye.
+EOM
+ , regexmess(
+<<'EOM'
+X-Spam-Report: caca
+caca
+ caca
+caca
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+LaSuite: super
+LaSuite2: super 2
+
+Hello,
+Bye.
+EOM
+ ), 'regexmess: 3 remove buggy X-Spam-Report: across several lines, first header');
+
+
+
+
+ is(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+
+Hello,
+Bye.
+EOM
+ , regexmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+X-Spam-Report: caca
+caca
+ caca
+caca
+
+Hello,
+Bye.
+EOM
+ ), 'regexmess: 4 remove buggy X-Spam-Report: across several lines, final header');
+
+
+ is(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+
+Hello,
+Bye.
+EOM
+ , regexmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From:<tartanpion@machin.truc>
+
+Hello,
+Bye.
+EOM
+ ), 'regexmess: 5 remove buggy X-Spam-Report: not there at all');
+
+
+ is(
+<<"EOM"
+Date: Sat, 10 Jul 2010 05:34:45 -0700\r
+From:<tartanpion>\r
+LaSuite: super\r
+LaSuite2: super 2\r
+\r
+Hello,\r
+Bye.\r
+EOM
+ , regexmess(
+<<"EOM"
+X-Spam-Report: caca\r
+caca\r
+ caca\r
+caca\r
+Date: Sat, 10 Jul 2010 05:34:45 -0700\r
+From:<tartanpion>\r
+LaSuite: super\r
+LaSuite2: super 2\r
+\r
+Hello,\r
+Bye.\r
+EOM
+ ), 'regexmess: 6 remove buggy X-Spam-Report: across several lines, first header, with \r');
+
+
+ is(
+<<"EOM"
+Date: Sat, 10 Jul 2010 05:34:45 -0700\r
+From:<tartanpion>\r
+LaSuite: super\r
+LaSuite2: super 2\r
+\r
+Hello,\r
+Bye.\r
+EOM
+ , regexmess(
+<<"EOM"
+Date: Sat, 10 Jul 2010 05:34:45 -0700\r
+From:<tartanpion>\r
+X-Spam-Report: caca\r
+caca\r
+ caca\r
+caca\r
+LaSuite: super\r
+LaSuite2: super 2\r
+\r
+Hello,\r
+Bye.\r
+EOM
+ ), 'regexmess: 7 remove buggy X-Spam-Report: across several lines, middle header, with \r');
+
+
+ is(
+<<"EOM"
+Date: Sat, 10 Jul 2010 05:34:45 -0700\r
+From:<tartanpion>\r
+\r
+Hello,\r
+Bye.\r
+EOM
+ , regexmess(
+<<"EOM"
+Date: Sat, 10 Jul 2010 05:34:45 -0700\r
+From:<tartanpion>\r
+X-Spam-Report: caca\r
+caca\r
+ caca\r
+caca\r
+\r
+Hello,\r
+Bye.\r
+EOM
+ ), 'regexmess: 8 remove buggy X-Spam-Report: across several lines, final header, with \r');
+
+
+ undef @regexmess ;
+ note( 'Leaving tests_regexmess()' ) ;
+ return ;
}
sub regexmess
@@ -12119,10 +13953,83 @@
# Complex regular subexpression recursion limit (32766) exceeded with more lines
# exit;
- note( 'Leaving tests_skipmess()' ) ;
+
+ undef @skipmess ;
+ note( 'Leaving tests_skipmess()' ) ;
return ;
}
+
+sub tests_skipmess_neg
+{
+ note( 'Entering tests_skipmess_neg()' ) ;
+
+
+ @skipmess = ('m{i}') ;
+ ok( 1 == skipmess( 'Hi!' ), 'skipmess: i string yes' ) ;
+ ok( 0 == skipmess( 'Ho!' ), 'skipmess: i string no' ) ;
+
+ @skipmess = ('m{\A(?!.*i)}') ;
+ ok( 0 == skipmess( 'Hi!' ), 'skipmess: not i string no' ) ;
+ ok( 1 == skipmess( 'Ho!' ), 'skipmess: not i string yes' ) ;
+
+
+ @skipmess = ('m{\A(?!.*^From:[^\n]*tartanpion\@machin\.truc)}xms') ;
+
+ ok( 0 == skipmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From: <tartanpion@machin.truc>
+
+Bye.
+EOM
+),
+ 'skipmess: 1 not From tartanpion@machin.truc' ) ;
+
+ok( 1 == skipmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From: <kikiki@machin.truc>
+
+Bye.
+EOM
+),
+ 'skipmess: 2 not From tartanpion@machin.truc' ) ;
+
+
+
+
+ ok( 0 == skipmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From: <tartanpion@machin.truc>
+
+ From: <tartanpion@machin.truc>
+Bye.
+EOM
+),
+ 'skipmess: 3 not From tartanpion@machin.truc' ) ;
+
+ok( 1 == skipmess(
+<<'EOM'
+Date: Sat, 10 Jul 2010 05:34:45 -0700
+From: <kikiki@machin.truc>
+
+ From: <tartanpion@machin.truc>
+Bye.
+EOM
+),
+ 'skipmess: 4 not From tartanpion@machin.truc' ) ;
+
+
+
+
+ undef @skipmess ;
+ note( 'Leaving tests_skipmess_neg()' ) ;
+ return ;
+}
+
+
sub skipmess
{
my ( $string ) = @_ ;
@@ -12154,25 +14061,25 @@
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( 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' ) ;
+ is( '0.000 KiB', bytes_display_string( 0 ), 'bytes_display_string: 0' ) ;
+ is( '0.001 KiB', bytes_display_string( 1 ), 'bytes_display_string: 1' ) ;
+ is( '0.010 KiB', bytes_display_string( 10 ), 'bytes_display_string: 10' ) ;
+ is( '1.000 MiB', bytes_display_string( 1_048_575 ), 'bytes_display_string: 1_048_575' ) ;
+ is( '1.000 MiB', bytes_display_string( 1_048_576 ), 'bytes_display_string: 1_048_576' ) ;
- 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 ' ) ;
+ is( '1.000 GiB', bytes_display_string( 1_073_741_823 ), 'bytes_display_string: 1_073_741_823 ' ) ;
+ is( '1.000 GiB', bytes_display_string( 1_073_741_824 ), 'bytes_display_string: 1_073_741_824 ' ) ;
- 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' ) ;
+ is( '1.000 TiB', bytes_display_string( 1_099_511_627_775 ), 'bytes_display_string: 1_099_511_627_775' ) ;
+ is( '1.000 TiB', bytes_display_string( 1_099_511_627_776 ), 'bytes_display_string: 1_099_511_627_776' ) ;
- 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' ) ;
+ is( '1.000 PiB', bytes_display_string( 1_125_899_906_842_623 ), 'bytes_display_string: 1_125_899_906_842_623' ) ;
+ is( '1.000 PiB', bytes_display_string( 1_125_899_906_842_624 ), 'bytes_display_string: 1_125_899_906_842_624' ) ;
- 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' ) ;
+ is( '1024.000 PiB', bytes_display_string( 1_152_921_504_606_846_975 ), 'bytes_display_string: 1_152_921_504_606_846_975' ) ;
+ is( '1024.000 PiB', bytes_display_string( 1_152_921_504_606_846_976 ), 'bytes_display_string: 1_152_921_504_606_846_976' ) ;
- 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' ) ;
+ is( '1048576.000 PiB', 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()' ) ;
@@ -12257,27 +14164,31 @@
return ;
}
-sub stats
+sub do_and_print_stats
{
my $mysync = shift ;
- if ( ! $mysync->{stats} ) {
+ if ( ! $mysync->{can_do_stats} ) {
return ;
}
my $timeend = time ;
my $timediff = $timeend - $mysync->{timestart} ;
- my $timeend_str = localtime $timeend ;
+ my $timeend_str = localtimez( $timeend ) ;
+
+ my $cpu_time = cpu_time( $mysync ) ;
+ my $cpu_percent = cpu_percent( $mysync, $cpu_time, $timediff ) ;
+ my $cpu_percent_global = cpu_percent_global( $mysync, $cpu_percent ) ;
my $memory_consumption_at_end = memory_consumption( ) || 0 ;
my $memory_consumption_at_start = $mysync->{ memory_consumption_at_start } || 0 ;
- my $memory_ratio = ($max_msg_size_in_bytes) ?
- mysprintf('%.1f', $memory_consumption_at_end / $max_msg_size_in_bytes) : 'NA' ;
+ my $memory_ratio = ( $mysync->{ biggest_message_transferred } ) ?
+ mysprintf( '%.1f', $memory_consumption_at_end / $mysync->{ biggest_message_transferred } ) : 'NA' ;
# my $useheader_suggestion = useheader_suggestion( $mysync ) ;
myprint( "++++ Statistics\n" ) ;
- myprint( "Transfer started on : $timestart_str\n" ) ;
+ myprint( "Transfer started on : $mysync->{ 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" ) ;
@@ -12285,8 +14196,8 @@
myprint( "(could be $nb_msg_skipped_dry_mode without dry mode)" ) if ( $mysync->{dry} ) ;
myprint( "\n" ) ;
myprint( "Messages skipped : $mysync->{ 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 found duplicate on host1 : $mysync->{ acc1 }->{ nb_msg_duplicate }\n" ) ;
+ myprint( "Messages found duplicate on host2 : $mysync->{ acc2 }->{ nb_msg_duplicate }\n" ) ;
myprint( "Messages found crossduplicate on host2 : $mysync->{ h2_nb_msg_crossdup }\n" ) ;
myprint( "Messages void (noheader) on host1 : $mysync->{ h1_nb_msg_noheader } ", useheader_suggestion( $mysync ), "\n" ) ;
myprint( "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n" ) ;
@@ -12294,8 +14205,8 @@
nb_messages_in_2_not_in_1( $mysync ) ;
myprintf( "Messages found in host1 not in host2 : %s messages\n", $mysync->{ nb_messages_in_1_not_in_2 } ) ;
myprintf( "Messages found in host2 not in host1 : %s messages\n", $mysync->{ nb_messages_in_2_not_in_1 } ) ;
- myprint( "Messages deleted on host1 : $mysync->{ h1_nb_msg_deleted }\n" ) ;
- myprint( "Messages deleted on host2 : $h2_nb_msg_deleted\n" ) ;
+ myprint( "Messages deleted on host1 : $mysync->{ acc1 }->{ nb_msg_deleted }\n" ) ;
+ myprint( "Messages deleted on host2 : $mysync->{ acc2 }->{ nb_msg_deleted }\n" ) ;
myprintf( "Total bytes transferred : %s (%s)\n",
$mysync->{total_bytes_transferred},
bytes_display_string( $mysync->{total_bytes_transferred} ) ) ;
@@ -12311,10 +14222,10 @@
$memory_consumption_at_end / $KIBI / $KIBI,
$memory_consumption_at_start / $KIBI / $KIBI ) ;
myprint( "Load end is : " . ( join( q{ }, loadavg( ) ) || 'unknown' ), " on $mysync->{cpu_number} cores\n" ) ;
-
- myprintf("Biggest message : %s bytes (%s)\n",
- $max_msg_size_in_bytes,
- bytes_display_string( $max_msg_size_in_bytes) ) ;
+ myprint( "CPU time and %cpu : $cpu_time sec $cpu_percent %cpu $cpu_percent_global %allcpus\n" ) ;
+ myprintf("Biggest message transferred : %s bytes (%s)\n",
+ $mysync->{ biggest_message_transferred },
+ bytes_display_string( $mysync->{ biggest_message_transferred } ) ) ;
myprint( "Memory/biggest message ratio : $memory_ratio\n" ) ;
if ( $mysync->{ foldersizesatend } and $mysync->{ foldersizes } ) {
@@ -12440,7 +14351,7 @@
}
-
+# Globals: $skipsize $wholeheaderifneeded
sub parse_header_msg
{
my ( $mysync, $imap, $m_uid, $s_heads, $s_fir, $side, $s_hash ) = @_ ;
@@ -12463,9 +14374,7 @@
#myprint( Data::Dumper->Dump( [ $head, \%useheader ] ) ) ;
- my $headstr ;
-
- $headstr = header_construct( $head, $side, $m_uid ) ;
+ my $headstr = header_construct( $mysync, $head, $side, $m_uid ) ;
if ( ( ! $headstr ) and ( $mysync->{addheader} ) and ( $side eq 'Host1' ) ) {
my $header = add_header( $m_uid ) ;
@@ -12481,49 +14390,124 @@
my $idate = $s_fir->{$m_uid}->{'INTERNALDATE'} ;
$size = length $headstr unless ( $size ) ;
my $m_md5 = md5_base64( $headstr ) ;
- $mysync->{ debug } and myprint( "$side: uid $m_uid sig $m_md5 size $size idate $idate\n" ) ;
+
my $key ;
- if ($skipsize) {
+ if ( $skipsize ) {
$key = "$m_md5";
}
else {
$key = "$m_md5:$size";
}
- # 0 return code is used to identify duplicate message hash
- return 0 if exists $s_hash->{"$key"};
- $s_hash->{"$key"}{'5'} = $m_md5;
- $s_hash->{"$key"}{'s'} = $size;
- $s_hash->{"$key"}{'D'} = $idate;
- $s_hash->{"$key"}{'F'} = $flags;
- $s_hash->{"$key"}{'m'} = $m_uid;
- return( 1 ) ;
+ if ( exists $s_hash->{"$key"} )
+ {
+ # 0 return code is used to identify duplicate message hash
+ my $dup_ref = $s_hash->{"$key"}->{'U'} ;
+ my $num = scalar( @{ $dup_ref } ) ;
+ push( @{ $dup_ref }, $m_uid ) ;
+ my $keydup = "$key#$num" ;
+ $mysync->{ debug } and myprint( "$side: uid $m_uid sig $keydup size $size idate $idate dup @{ $dup_ref }\n" ) ;
+ if ( $mysync->{ syncduplicates } )
+ {
+ $s_hash->{"$keydup"}{'5'} = $m_md5 ;
+ $s_hash->{"$keydup"}{'s'} = $size ;
+ $s_hash->{"$keydup"}{'D'} = $idate ;
+ $s_hash->{"$keydup"}{'F'} = $flags ;
+ $s_hash->{"$keydup"}{'m'} = $m_uid ;
+ }
+ return 0 ;
+ }
+ else
+ {
+ $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 ;
+ $s_hash->{"$key"}{'U'} = [ $m_uid ] ; # ? or [ ] ?
+ $mysync->{ debug } and myprint( "$side: uid $m_uid sig $key size $size idate $idate\n" ) ;
+ return( 1 ) ;
+ }
+
+ # we should not be here
+ return ;
}
+sub tests_header_construct
+{
+ note( 'Entering tests_header_construct()' ) ;
+
+ is( undef, header_construct( ), 'header_construct: no args => undef' ) ;
+ my $mysync = {} ;
+ my $head = {
+ 'key1' => [ 'val1_key1' ]
+ } ;
+ is( undef, header_construct( $mysync, $head, 'Host1', '1' ), 'header_construct: key1 val1_key1 no useheader => undef' ) ;
+
+ $mysync->{useheader}->{ 'KEY1' } = 1 ;
+ is( 'KEY1: VAL1_KEY1', header_construct( $mysync, $head, 'Host1', '1' ), 'header_construct: key1 val1_key1 => KEY1: VAL1_KEY1' ) ;
+
+
+
+ $head = {
+ 'key1' => [ 'val1_key1', 'val3_key1', 'val2_key1' ]
+ } ;
+ is( 'KEY1: VAL1_KEY1KEY1: VAL2_KEY1KEY1: VAL3_KEY1', header_construct( $mysync, $head, 'Host1', '1' ),
+ 'header_construct: key1 val1_key1 val3_key1 val2_key1 => KEY1: VAL1_KEY1KEY1: VAL2_KEY1KEY1: VAL3_KEY1' ) ;
+
+ $head = {
+ 'key1' => [ 'val1_key1', 'val3_key1', ' val2_key1' ]
+ } ;
+ is( 'KEY1: VAL1_KEY1KEY1: VAL2_KEY1KEY1: VAL3_KEY1', header_construct( $mysync, $head, 'Host1', '1' ),
+ 'header_construct: key1 val1_key1 val3_key1 val2_key1 => KEY1: VAL1_KEY1KEY1: VAL2_KEY1KEY1: VAL3_KEY1' ) ;
+
+ $mysync->{useheader}->{ 'ALL' } = 1 ;
+
+ is( 'KEY1: VAL1_KEY1KEY1: VAL2_KEY1KEY1: VAL3_KEY1', header_construct( $mysync, $head, 'Host1', '1' ),
+ 'header_construct: key1 val1_key1 val3_key1 val2_key1 useheader ALL => KEY1: VAL1_KEY1KEY1: VAL2_KEY1KEY1: VAL3_KEY1' ) ;
+
+ $mysync->{skipheader} = 'key1' ;
+ is( undef, header_construct( $mysync, $head, 'Host1', '1' ),
+ 'header_construct: key1 val1_key1 val3_key1 val2_key1 useheader ALL => undef' ) ;
+
+ $head = {
+ 'key1' => [ 'val1_key1', 'val3_key1', ' val2_key1' ],
+ 'key2' => [ 'val1_key2', 'val3_key2', ' val2_key2' ]
+ } ;
+ is( 'KEY2: VAL1_KEY2KEY2: VAL2_KEY2KEY2: VAL3_KEY2', header_construct( $mysync, $head, 'Host1', '1' ),
+ 'header_construct: ... useheader ALL skipheader key1 => KEY2: VAL1_KEY2KEY2: VAL2_KEY2KEY2: VAL3_KEY2' ) ;
+
+
+ note( 'Leaving tests_header_construct()' ) ;
+ return ;
+}
+
+
+# No global in header_construct
sub header_construct
{
+ my( $mysync, $head, $side, $m_uid ) = @_ ;
- my( $head, $side, $m_uid ) = @_ ;
-
- my $headstr ;
+ my @headstr ;
foreach my $h ( sort keys %{ $head } ) {
- next if ( not ( exists $useheader{ uc $h } )
- and ( not exists $useheader{ 'ALL' } )
+ next if ( not ( exists $mysync->{useheader}->{ uc $h } )
+ and ( not exists $mysync->{useheader}->{ 'ALL' } )
) ;
- foreach my $val ( sort @{$head->{$h}} ) {
+ foreach my $val ( @{$head->{$h}} ) {
my $H = header_line_normalize( $h, $val ) ;
# show stuff in debug mode
- $sync->{ debug } and myprint( "$side uid $m_uid header [$H]", "\n" ) ;
+ $mysync->{ debug } and myprint( "$side uid $m_uid header [$H]", "\n" ) ;
- if ($skipheader and $H =~ m/$skipheader/xi) {
- $sync->{ debug } and myprint( "$side uid $m_uid skipping header [$H]\n" ) ;
+ if ( $mysync->{skipheader} and $H =~ m/$mysync->{skipheader}/xi) {
+ $mysync->{ debug } and myprint( "$side uid $m_uid skipping header [$H]\n" ) ;
next ;
}
- $headstr .= "$H" ;
+ push @headstr, $H ;
}
}
+ my $headstr = join( '', sort @headstr ) || undef ;
return( $headstr ) ;
}
@@ -12655,7 +14639,6 @@
is( q{}, nthline( 'W/tmp/tests/noexist.txt', 2 ), 'nthline: 2nd getting empty string from inexisting W/tmp/tests/noexist.txt' ) ;
ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'nthline: mkpath W/tmp/tests/' ) ;
-
is( "L1\nL2\nL3\nL4\n" , string_to_file( "L1\nL2\nL3\nL4\n", 'W/tmp/tests/nthline.txt' ), 'nthline: put L1\nL2\nL3\nL4\n in W/tmp/tests/nthline.txt' ) ;
is( 'L3' , nthline( 'W/tmp/tests/nthline.txt', 3 ), 'nthline: get L3 from W/tmp/tests/nthline.txt' ) ;
@@ -12689,21 +14672,44 @@
}
}
+sub tests_file_to_array
+{
+ note( 'Entering tests_file_to_array()' ) ;
-# Should be unit tested and then be used by file_to_string, refactoring file_to_string
+ is( undef, file_to_array( ), 'file_to_array: no args => undef' ) ;
+ is( undef, file_to_array( '/noexist' ), 'file_to_array: /noexist => undef' ) ;
+ is( undef, file_to_array( '/' ), 'file_to_array: reading a directory => undef' ) ;
+
+ ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'file_to_array: mkpath W/tmp/tests/' ) ;
+ is( "L1\nL2\nL3\nL4\n" , string_to_file( "L1\nL2\nL3\nL4\n", 'W/tmp/tests/file_to_array.txt' ), 'file_to_array: put L1\nL2\nL3\nL4\n in W/tmp/tests/file_to_array.txt' ) ;
+ is_deeply( [ "L1\n", "L2\n", "L3\n", "L4\n" ] , [ file_to_array( 'W/tmp/tests/file_to_array.txt' ) ], 'file_to_array: get back L1\n L2\n L3\n L4\n from W/tmp/tests/file_to_array.txt' ) ;
+
+ note( 'Leaving tests_file_to_array()' ) ;
+ return ;
+}
+
sub file_to_array
{
my( $file ) = shift ;
+ if ( ! $file ) { return ; }
+ if ( ! -e $file ) { return ; }
+ if ( ! -f $file ) { return ; }
+ if ( ! -r $file ) { return ; }
+
my @string ;
- open my $FILE, '<', $file or do {
+ if ( open my $FILE, '<', $file )
+ {
+ @string = <$FILE> ;
+ close $FILE ;
+ return( @string ) ;
+ }
+ else
+ {
myprint( "Error reading file $file : $OS_ERROR\n" ) ;
return ;
- } ;
- @string = <$FILE> ;
- close $FILE ;
- return( @string ) ;
+ }
}
@@ -12735,15 +14741,8 @@
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 ;
- }
+
+ return( join q{}, file_to_array( $file ) ) ;
}
@@ -13157,7 +15156,7 @@
{
note( 'Entering tests_version_from_rcs()' ) ;
- is( undef, version_from_rcs( ), 'version_from_rcs: no args => UNKNOWN' ) ;
+ is( undef, version_from_rcs( ), 'version_from_rcs: no args => undef' ) ;
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' ) ;
@@ -13221,47 +15220,104 @@
{
note( 'Entering tests_cpu_number()' ) ;
- is( 1, is_an_integer( cpu_number( ) ), "cpu_number: is_an_integer" ) ;
+ is( 1, is_integer( cpu_number( ) ), "cpu_number: is_integer" ) ;
ok( 1 <= cpu_number( ), "cpu_number: 1 or more" ) ;
is( 1, cpu_number( 1 ), "cpu_number: 1 => 1" ) ;
is( 1, cpu_number( $MINUS_ONE ), "cpu_number: -1 => 1" ) ;
is( 1, cpu_number( 'lalala' ), "cpu_number: lalala => 1" ) ;
is( $NUMBER_42, cpu_number( $NUMBER_42 ), "cpu_number: $NUMBER_42 => $NUMBER_42" ) ;
+
+ note( "cpu_number = " . cpu_number( ) . "\n" ) ;
+ note( "hostname = " . hostname( ) . "\n" ) ;
+ SKIP: {
+ if ( ! ( 'i005' eq hostname() ) )
+ {
+ skip( 'cpu_number on host != i005 (FreeBSD)', 1 ) ;
+ }
+ is( 4, cpu_number( ), "cpu_number: on i005 (FreeBSD) => 4" ) ;
+ } ;
+
+ SKIP: {
+ if ( ! ( 'petite' eq hostname() ) )
+ {
+ skip( 'cpu_number on host != petite (Linux)', 1 ) ;
+ }
+ is( 2, cpu_number( ), "cpu_number: on petite (Linux) => 2" ) ;
+ } ;
+
+ SKIP: {
+ if ( ! ( skip_macosx( ) ) )
+ {
+ skip( 'cpu_number on host != polarhome macosx (Darwin MacOS X 10.7.5 Lion)', 1 ) ;
+ }
+ is( 2, cpu_number( ), "cpu_number: on polarhome macosx (Darwin MacOS X 10.7.5 Lion) => 2" ) ;
+ } ;
+
+ SKIP: {
+ if ( ! ( 'pcHPDV7-HP' eq hostname() ) )
+ {
+ skip( 'cpu_number on host != pcHPDV7-HP (Windows 7, 64bits)', 1 ) ;
+ }
+ is( 2, cpu_number( ), "cpu_number: on pcHPDV7-HP (Windows 7, 64bits) => 2" ) ;
+ } ;
+
+ SKIP: {
+ if ( ! ( 'CUILLERE' eq hostname() ) )
+ {
+ skip( 'cpu_number on host != CUILLERE (Windows XP, 32bits)', 1 ) ;
+ }
+ is( 1, cpu_number( ), "cpu_number: on CUILLERE (Windows XP, 32bits) => 1" ) ;
+ } ;
+
+
note( 'Leaving tests_cpu_number()' ) ;
return ;
}
-sub cpu_number
-{
+
+sub cpu_number {
my $cpu_number_forced = shift ;
# Well, here 1 is better than 0 or undef
my $cpu_number = 1 ; # Default value, erased if better found
my @cpuinfo ;
- if ( $ENV{"NUMBER_OF_PROCESSORS"} ) {
+ if ( $ENV{"NUMBER_OF_PROCESSORS"} )
+ {
# might be under a Windows system
$cpu_number = $ENV{"NUMBER_OF_PROCESSORS"} ;
- $sync->{ debug } and myprint( "Number of processors found by env var NUMBER_OF_PROCESSORS: $cpu_number\n" ) ;
- }elsif ( 'darwin' eq $OSNAME or 'freebsd' eq $OSNAME ) {
+ #myprint( "Number of processors found by env var NUMBER_OF_PROCESSORS: $cpu_number\n" ) ;
+ }
+
+ if ( 'darwin' eq $OSNAME )
+ {
$cpu_number = backtick( "sysctl -n hw.ncpu" ) ;
chomp( $cpu_number ) ;
- $sync->{ debug } and myprint( "Number of processors found by cmd 'sysctl -n hw.ncpu': $cpu_number\n" ) ;
- }elsif ( ! -e '/proc/cpuinfo' ) {
- $sync->{ debug } and myprint( "Number of processors not found so I might assume there is only 1\n" ) ;
- $cpu_number = 1 ;
- }elsif( @cpuinfo = file_to_array( '/proc/cpuinfo' ) ) {
- $cpu_number = grep { /^processor/mxs } @cpuinfo ;
- $sync->{ debug } and myprint( "Number of processors found via /proc/cpuinfo: $cpu_number\n" ) ;
+ #myprint( "Number of processors found by cmd 'sysctl -n hw.ncpu': $cpu_number\n" ) ;
}
-
- if ( defined $cpu_number_forced ) {
+
+ if ( 'freebsd' eq $OSNAME )
+ {
+ $cpu_number = backtick( "sysctl -n kern.smp.cpus" ) ;
+ chomp( $cpu_number ) ;
+ #myprint( "Number of processors found by cmd 'sysctl -n kern.smp.cpus': $cpu_number\n" ) ;
+ }
+
+ if ( 'linux' eq $OSNAME && -e '/proc/cpuinfo' )
+ {
+ @cpuinfo = file_to_array( '/proc/cpuinfo' ) ;
+ $cpu_number = grep { /^processor/mxs } @cpuinfo ;
+ #myprint( "Number of processors found via /proc/cpuinfo: $cpu_number\n" ) ;
+ }
+
+ if ( defined $cpu_number_forced )
+ {
$cpu_number = $cpu_number_forced ;
}
+
return( integer_or_1( $cpu_number ) ) ;
}
-
sub tests_integer_or_1
{
note( 'Entering tests_integer_or_1()' ) ;
@@ -13279,33 +15335,33 @@
sub integer_or_1
{
my $number = shift ;
- if ( is_an_integer( $number ) ) {
+ if ( is_integer( $number ) ) {
return $number ;
}
# else
return 1 ;
}
-sub tests_is_an_integer
+sub tests_is_integer
{
- note( 'Entering tests_is_an_integer()' ) ;
+ note( 'Entering tests_is_integer()' ) ;
- is( undef, is_an_integer( ), 'is_an_integer: no args => undef ' ) ;
- ok( is_an_integer( 1 ), 'is_an_integer: 1 => yes ') ;
- ok( is_an_integer( $NUMBER_42 ), 'is_an_integer: 42 => yes ') ;
- ok( is_an_integer( "$NUMBER_42" ), 'is_an_integer: "$NUMBER_42" => yes ') ;
- ok( is_an_integer( '42' ), 'is_an_integer: "42" => yes ') ;
- ok( is_an_integer( $NUMBER_104_857_600 ), 'is_an_integer: 104_857_600 => yes') ;
- ok( is_an_integer( "$NUMBER_104_857_600" ), 'is_an_integer: "$NUMBER_104_857_600" => yes') ;
- ok( is_an_integer( '104857600' ), 'is_an_integer: 104857600 => yes') ;
- ok( ! is_an_integer( 'blabla' ), 'is_an_integer: blabla => no' ) ;
- ok( ! is_an_integer( q{} ), 'is_an_integer: empty string => no' ) ;
+ is( undef, is_integer( ), 'is_integer: no args => undef ' ) ;
+ ok( is_integer( 1 ), 'is_integer: 1 => yes ') ;
+ ok( is_integer( $NUMBER_42 ), 'is_integer: 42 => yes ') ;
+ ok( is_integer( "$NUMBER_42" ), 'is_integer: "$NUMBER_42" => yes ') ;
+ ok( is_integer( '42' ), 'is_integer: "42" => yes ') ;
+ ok( is_integer( $NUMBER_104_857_600 ), 'is_integer: 104_857_600 => yes') ;
+ ok( is_integer( "$NUMBER_104_857_600" ), 'is_integer: "$NUMBER_104_857_600" => yes') ;
+ ok( is_integer( '104857600' ), 'is_integer: 104857600 => yes') ;
+ ok( ! is_integer( 'blabla' ), 'is_integer: blabla => no' ) ;
+ ok( ! is_integer( q{} ), 'is_integer: empty string => no' ) ;
- note( 'Leaving tests_is_an_integer()' ) ;
+ note( 'Leaving tests_is_integer()' ) ;
return ;
}
-sub is_an_integer
+sub is_integer
{
my $number = shift ;
if ( ! defined $number ) { return ; }
@@ -13470,48 +15526,38 @@
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( 1, 1, 1, 1, 'lalala' ), 'load_and_delay: five arguments is 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 ' ) ;
-# Old behavior, rather strict
- # 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 ' ) ;
+# ( $cpu_num, $avg_1_min, $avg_5_min, $avg_15_min )
- # 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( 0, load_and_delay( 1, 1, 1, 1 ), 'load_and_delay: one core, loads are all 1 => ok ' ) ;
+ is( 0, load_and_delay( 1, 1, 1, 1, 'lalala' ), 'load_and_delay: five arguments is 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 ' ) ;
-# New behavior, tolerate more load
- 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( 0, load_and_delay( 1, 2, 0, 0 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
- is( 0, load_and_delay( 1, 2, 0, 2 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
- is( 0, load_and_delay( 1, 2, 2, 0 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
- is( 0, load_and_delay( 1, 2, 2, 2 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;
+ 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( 0, load_and_delay( 1, 0, 3, 3 ), 'load_and_delay: one core, load1m=0 load5m=3 load15m=3 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 0, 4, 4 ), 'load_and_delay: one core, load1m=0 load5m=3 load15m=3 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 2, 0, 0 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=0 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 2, 0, 2 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=2 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 2, 2, 0 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=0 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 2, 2, 2 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=2 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 2.9, 2.9, 2.9 ), 'load_and_delay: one core, load1m=2.9 load5m=2.9 load15m=2.9 => 0 ' ) ;
- is( 1, load_and_delay( 1, 4, 0, 0 ), 'load_and_delay: one core, load1m=4 load5m=0 load15m=0 => 1 ' ) ;
- is( 1, load_and_delay( 1, 4, 0, 4 ), 'load_and_delay: one core, load1m=4 load5m=0 load15m=4 => 1 ' ) ;
- is( 5, load_and_delay( 1, 4, 4, 0 ), 'load_and_delay: one core, load1m=4 load5m=4 load15m=0 => 5 ' ) ;
- is( 15, load_and_delay( 1, 4, 4, 4 ), 'load_and_delay: one core, load1m=4 load5m=4 load15m=4 => 15 ' ) ;
+ is( 0, load_and_delay( 1, 3, 0, 0 ), 'load_and_delay: one core, load1m=3 load5m=0 load15m=0 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 3, 2.9, 2.9 ), 'load_and_delay: one core, load1m=3 load5m=2.9 load15m=2.9 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 3, 3, 2.9 ), 'load_and_delay: one core, load1m=3 load5m=3 load15m=2.9 => 0 ' ) ;
+ is( 0, load_and_delay( 1, 3, 3, 3 ), 'load_and_delay: one core, load1m=3 load5m=3 load15m=3 => 0 ' ) ;
- is( 0, load_and_delay( 4, 0, 9, 9 ), 'load_and_delay: four core, load1m=0 load5m=9 load15m=9 => 0 ' ) ;
- is( 1, load_and_delay( 4, 9, 0, 0 ), 'load_and_delay: four core, load1m=9 load5m=0 load15m=0 => 1 ' ) ;
- is( 1, load_and_delay( 4, 9, 0, 9 ), 'load_and_delay: four core, load1m=9 load5m=0 load15m=9 => 1 ' ) ;
- is( 5, load_and_delay( 4, 9, 9, 0 ), 'load_and_delay: four core, load1m=9 load5m=9 load15m=0 => 5 ' ) ;
- is( 15, load_and_delay( 4, 9, 9, 9 ), 'load_and_delay: four core, load1m=9 load5m=9 load15m=9 => 15 ' ) ;
+ is( 1, load_and_delay( 1, 6, 0, 0 ), 'load_and_delay: one core, load1m=3 load5m=0 load15m=0 => 1 ' ) ;
+ is( 1, load_and_delay( 1, 6, 5.9, 5.9 ), 'load_and_delay: one core, load1m=3 load5m=2.9 load15m=2.9 => 1 ' ) ;
+ is( 5, load_and_delay( 1, 6, 6, 5.9 ), 'load_and_delay: one core, load1m=3 load5m=3 load15m=2.9 => 5 ' ) ;
+ is( 15, load_and_delay( 1, 6, 6, 6 ), 'load_and_delay: one core, load1m=3 load5m=3 load15m=3 => 15 ' ) ;
+
+
note( 'Leaving tests_load_and_delay()' ) ;
return ;
@@ -13531,12 +15577,123 @@
# 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 <= 2 ) { return 0 ; }
- if ( $avg_5_min <= 2 ) { return 1 ; } # Retry in 1 minute
- if ( $avg_15_min <= 2 ) { return 5 ; } # Retry in 5 minutes
+ if ( $avg_1_min < 6 ) { return 0 ; }
+ if ( $avg_5_min < 6 ) { return 1 ; } # Retry in 1 minute
+ if ( $avg_15_min < 6 ) { return 5 ; } # Retry in 5 minutes
return 15 ; # Retry in 15 minutes
}
+
+sub tests_cpu_time
+{
+ note( 'Entering tests_cpu_time()' ) ;
+
+ ok( is_number( cpu_time( ) ), 'cpu_time: no args => a number' ) ;
+
+ my $mysync = { } ;
+ $mysync->{ debug } = 1 ;
+ ok( is_number( cpu_time( $mysync ) ), 'cpu_time: {} => a number' ) ;
+
+ note( 'Leaving tests_cpu_time()' ) ;
+ return ;
+}
+
+sub cpu_time
+{
+ my $mysync = shift ;
+
+ my @cpu_times = times ;
+ if ( ! @cpu_times ) { return ; }
+
+ my $cpu_time = 0 ;
+ # last element is the sum of all elements
+ $cpu_time = ( map { $cpu_time += $_ } @cpu_times )[ -1 ] ;
+ $mysync->{ debug } and myprint( join(' + ', @cpu_times), " = $cpu_time\n" ) ;
+
+ return $cpu_time ;
+}
+
+
+sub tests_cpu_percent
+{
+ note( 'Entering tests_cpu_percent()' ) ;
+
+ is( '0.0', cpu_percent( ), 'cpu_percent: no args => 0.0' ) ;
+ my $mysync = { } ;
+ $mysync->{ debug } = 1 ;
+ is( '0.0', cpu_percent( $mysync ), 'cpu_percent: {} => 0.0' ) ;
+ is( '0.0', cpu_percent( $mysync, 0 ), 'cpu_percent: {} 0 => 0.0' ) ;
+ is( '300.0', cpu_percent( $mysync, 3 ), 'cpu_percent: {} 3 => 300.0' ) ;
+ is( '30.0', cpu_percent( $mysync, 3, 10 ), 'cpu_percent: {} 3 10 => 30.0' ) ;
+ is( '0.0', cpu_percent( $mysync, 0, 10 ), 'cpu_percent: {} 0 10 => 0.0' ) ;
+
+ note( 'Leaving tests_cpu_percent()' ) ;
+ return ;
+}
+
+sub cpu_percent
+{
+ my $mysync = shift ;
+ my $cpu_time = shift || 0 ;
+ my $timediff = shift || 1 ; # no division by 0
+
+ if ( $cpu_time > $timediff )
+ {
+ myprint( "Strange: cpu_time $cpu_time > timediff $timediff\n" ) ;
+ }
+ my $cpu_percent = 0 ;
+ $cpu_percent = mysprintf( '%.1f', 100 * $cpu_time / $timediff ) ;
+ $mysync->{ debug } and myprint( "cpu_percent: $cpu_percent \n" ) ;
+
+ return $cpu_percent ;
+
+}
+
+sub tests_cpu_percent_global
+{
+ note( 'Entering tests_cpu_percent_global()' ) ;
+
+ is( '0.0', cpu_percent_global( ), 'cpu_percent_global: no args => 0' ) ;
+ my $mysync = { } ;
+ $mysync->{ debug } = 1 ;
+ is( '0.0', cpu_percent_global( $mysync ), 'cpu_percent_global: {} => 0' ) ;
+ is( '0.0', cpu_percent_global( $mysync, 0 ), 'cpu_percent_global: {} 0 => 0' ) ;
+
+ SKIP: {
+ if ( ! ( 'i005' eq hostname() ) )
+ {
+ skip( 'cpu_percent_global on host != i005', 1 ) ;
+ }
+ is( '25.0', cpu_percent_global( $mysync, 100 ), 'cpu_percent_global: {} 100 => 25 on host i005' ) ;
+ } ;
+
+ SKIP: {
+ if ( ! ( 'petite' eq hostname() ) )
+ {
+ skip( 'cpu_percent_global on host != petite', 1 ) ;
+ }
+ is( '50.0', cpu_percent_global( $mysync, 100 ), 'cpu_percent_global: {} 100 => 50 on host petite' ) ;
+ } ;
+
+ note( 'Leaving tests_cpu_percent_global()' ) ;
+ return ;
+}
+
+sub cpu_percent_global
+{
+ my $mysync = shift ;
+ my $cpu_percent = shift || 0 ;
+
+ my $cpu_number = cpu_number( ) ;
+
+ my $cpu_percent_global ;
+ $cpu_percent_global = mysprintf( '%.1f', $cpu_percent / $cpu_number ) ;
+ $mysync->{ debug } and myprint( "cpu_percent_global: $cpu_percent_global \n" ) ;
+
+ return( $cpu_percent_global ) ;
+}
+
+
sub ram_memory_info
{
# In GigaBytes so division by 1024 * 1024 * 1024
@@ -13623,7 +15780,7 @@
#myprint( "ps: @ps" ) ;
# Use IPC::Open3 from perlcrit -3
- # It stalls on Darwin, don't understand why!
+ # But it stalls on Darwin, I don't understand why!
#my @ps = backtick( "ps -o vsz -p @pid" ) ;
#myprint( "ps: @ps" ) ;
@@ -13795,7 +15952,7 @@
else
{
# Found only embedded dynamic lib
- myprint( "Found nothing\n" ) ;
+ myprint( "Found only embedded dynamic lib. Good!\n" ) ;
return 1 ;
}
}
@@ -13819,22 +15976,22 @@
sub search_dyn_lib_locale_darwin
{
- my $command = qq{ lsof -p $PID | grep ' REG ' | grep .dylib | grep -v '/par-' } ;
+ my $command = qq{ lsof -p $PROCESS_ID | grep ' REG ' | grep .dylib | grep -v '/par-' } ;
myprint( "Search non embeded dynamic libs with the command: $command\n" ) ;
return backtick( $command ) ;
}
sub search_dyn_lib_locale_linux
{
- my $command = qq{ lsof -p $PID | grep ' REG ' | grep -v '/tmp/par-' | grep '\.so' } ;
+ my $command = qq{ lsof -p $PROCESS_ID | grep ' REG ' | grep -v '/tmp/par-' | grep '\.so' } ;
myprint( "Search non embeded dynamic libs with the command: $command\n" ) ;
return backtick( $command ) ;
}
sub search_dyn_lib_locale_MSWin32
{
- my $command = qq{ Listdlls.exe $PID|findstr Strawberry } ;
- # $command = qq{ Listdlls.exe $PID|findstr Strawberry } ;
+ my $command = qq{ Listdlls.exe $PROCESS_ID|findstr Strawberry } ;
+ # $command = qq{ Listdlls.exe $PROCESS_ID|findstr Strawberry } ;
myprint( "Search non embeded dynamic libs with the command: $command\n" ) ;
return qx( $command ) ;
}
@@ -14229,6 +16386,8 @@
{
myprint( "The sync is not finished, there are ",
$mysync->{ nb_messages_in_1_not_in_2 },
+ " among ",
+ $nb_identified_h1_messages,
" identified messages in host1 that are not on host2.\n" ) ;
}
@@ -14242,7 +16401,7 @@
}
else
{
- myprint( "There is no unidentified message\n" ) ;
+ myprint( "There is no unidentified message on host1.\n" ) ;
}
return ;
@@ -14277,9 +16436,11 @@
{
myprint( "The sync is not strict, there are ",
$mysync->{ nb_messages_in_2_not_in_1 },
- " messages in host2 that are not on host1.",
- " Use --delete2 to delete them and have a strict sync.",
- " ($nb_identified_h2_messages identified messages in host2)\n" ) ;
+ " among ",
+ $nb_identified_h2_messages,
+ " identified messages in host2 that are not on host1.",
+ " Use --delete2 and sync again to delete them and have a strict sync.\n"
+ ) ;
}
return ;
}
@@ -15053,24 +17214,25 @@
my( $mysync ) = shift ;
# When aborting another process the log file name finishes with "_abort.txt"
- my $abort_suffix = ( $mysync->{abort} ) ? '_abort' : q{} ;
+ my $abort_suffix = ( $mysync->{ abort } ) ? '_abort' : q{} ;
+
# When acting as a proxy the log file name finishes with "_remote.txt"
- # proxy mode is not done yet
- my $remote_suffix = ( $mysync->{remote} ) ? '_remote' : q{} ;
+ # proxy mode is not done in imapsync, it is done by proximapsync
+ my $remote_suffix = ( $mysync->{ remote } ) ? '_remote' : q{} ;
my $suffix = (
- filter_forbidden_characters( slash_to_underscore( $mysync->{user1} ) ) || q{} )
+ filter_forbidden_characters( slash_to_underscore( $mysync->{ user1 } ) ) || q{} )
. '_'
- . ( filter_forbidden_characters( slash_to_underscore( $mysync->{user2} ) ) || q{} )
+ . ( filter_forbidden_characters( slash_to_underscore( $mysync->{ user2 } ) ) || q{} )
. $remote_suffix . $abort_suffix ;
- $mysync->{logdir} = defined $mysync->{logdir} ? $mysync->{logdir} : $DEFAULT_LOGDIR ;
+ $mysync->{ logdir } = defined $mysync->{ logdir } ? $mysync->{ logdir } : $DEFAULT_LOGDIR ;
- $mysync->{logfile} = defined $mysync->{logfile}
- ? "$mysync->{logdir}/$mysync->{logfile}"
- : logfile( $mysync->{timestart}, $suffix, $mysync->{logdir} ) ;
+ $mysync->{ logfile } = defined $mysync->{ logfile }
+ ? "$mysync->{ logdir }/$mysync->{ logfile }"
+ : logfile( $mysync->{ timestart }, $suffix, $mysync->{ logdir } ) ;
- return( $mysync->{logfile} ) ;
+ return( $mysync->{ logfile } ) ;
}
sub tests_logfile
@@ -15082,7 +17244,8 @@
skip( 'Too hard to have a well known timezone on Windows', 10 ) if ( 'MSWin32' eq $OSNAME ) ;
local $ENV{TZ} = 'GMT' ;
- { POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
+ {
+ 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' ) ;
@@ -15129,6 +17292,38 @@
}
+sub tests_localtimez
+{
+ note( 'Entering tests_localtimez()' ) ;
+
+ SKIP: {
+ # Too hard to have a well known timezone on Windows
+ skip( 'Too hard to have a well known timezone on Windows', 1 ) if ( 'MSWin32' eq $OSNAME ) ;
+ local $ENV{TZ} = 'GMT' ;
+ like( localtimez( 0 ), qr'1970-01-01 00:00:00 \+0000 (GMT|UTC)', 'localtimez: 0 => match 1970-01-01 00:00:00 +0000 GMT' ) ;
+ }
+
+ is( localtimez( ), localtimez( time ), 'localtimez: undef => equals currrent' ) ;
+ note( 'Leaving tests_localtimez()' ) ;
+ return ;
+}
+
+
+
+sub localtimez
+{
+ my $time = shift ;
+
+ $time = defined( $time ) ? $time : time ;
+
+ my $datetimestr = POSIX::strftime( '%A %e %B %Y-%m-%d %H:%M:%S %z %Z', localtime( $time ) ) ;
+
+ #myprint( "$datetimestr\n" ) ;
+ return $datetimestr ;
+}
+
+
+
sub tests_slash_to_underscore
{
@@ -15227,6 +17422,8 @@
is( undef, teelaunch( $mysync ), 'teelaunch: arg empty {} => undef' ) ;
$mysync->{logfile} = q{} ;
is( undef, teelaunch( $mysync ), 'teelaunch: logfile empty string => undef' ) ;
+
+ # First time, learning IO::Tee intrasics
$mysync->{logfile} = 'W/tmp/tests/tests_teelaunch.txt' ;
isa_ok( my $tee = teelaunch( $mysync ), 'IO::Tee' , 'teelaunch: logfile W/tmp/tests/tests_teelaunch.txt' ) ;
is( 1, print( $tee "Hi!\n" ), 'teelaunch: write Hi!') ;
@@ -15234,6 +17431,38 @@
is( 1, print( $tee "Hoo\n" ), 'teelaunch: write Hoo') ;
is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch.txt is Hi!\nHoo\n' ) ;
+ # closing so tee won't be happy
+ close $mysync->{logfile_handle} ;
+ is( undef, print( $tee "Argh1\n" ), 'teelaunch: write Argh1') ;
+ is( undef, print( $tee "Argh2\n" ), 'teelaunch: write Argh2') ;
+ # write not done
+ is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch.txt is still Hi!\nHoo\n' ) ;
+ print join( ' ', $tee->handles ), "\n";
+ is( 2, scalar $tee->handles, 'teelaunch: 2 handles') ;
+ shift @{*{$tee}};
+ print join(' ', $tee->handles), "\n" ;
+ is( 1, scalar $tee->handles, 'teelaunch: 1 handle') ;
+ is( 1, print( $tee "Argh3\n" ), 'teelaunch: write Argh3 yeah') ;
+
+ shift @{*{$tee}};
+ # will not print anything now
+ is( 0, scalar $tee->handles, 'teelaunch: 0 handle') ;
+ is( 1, print( $tee "Argh 4\n" ), 'teelaunch: write Argh4 no') ;
+
+ # Second time, lesson learnt IO::Tee
+ $mysync->{logfile} = 'W/tmp/tests/tests_teelaunch2.txt' ;
+ isa_ok( $tee = teelaunch( $mysync ), 'IO::Tee' , 'teelaunch: logfile W/tmp/tests/tests_teelaunch2.txt' ) ;
+ is( 1, print( $tee "Hi!\n" ), 'teelaunch: write Hi!') ;
+ is( "Hi!\n", file_to_string( 'W/tmp/tests/tests_teelaunch2.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch2.txt is Hi!\n' ) ;
+ is( 1, print( $tee "Hoo\n" ), 'teelaunch: write Hoo') ;
+ is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch2.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch2.txt is Hi!\nHoo\n' ) ;
+
+ is( 1, teefinish( $mysync ), 'teefinish: return 1') ;
+ is( 1, print( $tee "Argh1\n" ), 'teelaunch: write Argh1') ;
+ is( 1, print( $tee "Argh2\n" ), 'teelaunch: write Argh2') ;
+ is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch2.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch2.txt is still Hi!\nHoo\n' ) ;
+ is( 1, teefinish( $mysync ), 'teefinish: still return 1') ;
+
note( 'Leaving tests_teelaunch()' ) ;
return ;
}
@@ -15268,6 +17497,28 @@
return $tee ;
}
+sub teefinish
+{
+ my $mysync = shift ;
+
+ if ( ! defined( $mysync ) ) { return ; }
+
+ my $tee = $mysync->{tee} ;
+
+ if ( ! defined( $tee ) ) { return ; }
+
+ if ( 2 == scalar $tee->handles )
+ {
+ shift @{*{$tee}};
+ }
+ else
+ {
+ # nothing
+ }
+ return scalar $tee->handles ;
+}
+
+
sub getpwuid_any_os
{
my $uid = shift ;
@@ -15278,15 +17529,44 @@
}
+
+
+sub abortifneeded
+{
+ my $mysync = shift ;
+ if ( -e $mysync->{ abortfile } )
+ {
+ myprint( "Asked to terminate by file $mysync->{ abortfile }\n" ) ;
+ do_and_print_stats( $mysync ) ;
+ myprint( "You should resynchronize those accounts by running a sync again,\n",
+ "since some messages and entire folders might still be missing on host2.\n"
+ ) ;
+ exit_clean( $mysync, $EXIT_BY_FILE ) ;
+ return ;
+ }
+ else
+ {
+ return ;
+ }
+}
+
sub simulong
{
- my $max_seconds = shift ;
+ my $mysync = shift ;
+
+ my $max_seconds = $mysync->{ simulong } ;
+
+ if ( ! $max_seconds ) { return ; }
+
my $division = 5 ;
- my $last_count = $division * $max_seconds ;
+ my $last_count = int( $division * $max_seconds ) ;
+ $mysync->{ debug } and myprint "last_count $last_count = int( division $division * max_seconds $max_seconds)\n" ;
foreach my $i ( 1 .. ( $last_count ) ) {
- myprint( "Are you still here ETA: " . ($last_count - $i) . "/$last_count msgs left\n" ) ;
+ myprint( "Are you still here ETA: " . ( $last_count - $i ) . "/$last_count msgs left\n" ) ;
+ #this one is for testing huge page behavior
#myprint( "Are you still here ETA: " . ($last_count - $i) . "/$last_count msgs left\n" . ( "Ah" x 40 . "\n") x 4000 ) ;
sleep( 1 / $division ) ;
+ abortifneeded( $mysync ) ;
}
return ;
@@ -15302,12 +17582,14 @@
return ;
}
-sub testsexit
+
+sub unittestssuite
{
my $mysync = shift ;
if ( ! ( $mysync->{ tests } or $mysync->{ testsdebug } or $mysync->{ testsunit } ) ) {
return ;
}
+
my $test_builder = Test::More->builder ;
tests( $mysync ) ;
testsdebug( $mysync ) ;
@@ -15323,16 +17605,12 @@
#$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 ;
+ return $EXIT_TESTS_FAILED ;
}
cleanup_mess_from_tests( ) ;
- # Cover is larger with --tests --testslive
- if ( ! $mysync->{ testslive } )
- {
- exit ;
- }
- return ;
+
+ return 0 ;
}
sub cleanup_mess_from_tests
@@ -15476,8 +17754,8 @@
$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 when computed from Gmail documentation
- $mysync->{maxbytesafter} ||= 1_000_000_000 ;
+ $mysync->{maxbytespersecond} ||= 20_000 ; # should be less than 10_000 when computed from Gmail documentation
+ $mysync->{maxbytesafter} ||= 1_000_000_000 ; # In fact it is documented as half: 500_000_000
$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
$mysync->{maxsleep} = ( defined $mysync->{maxsleep} ) ? $mysync->{maxsleep} : $MAX_SLEEP ; ;
$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 0 ;
@@ -15495,8 +17773,8 @@
# 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->{maxbytespersecond} ||= 40_000 ; # should be 30_000 computed from by Gmail documentation
+ $mysync->{maxbytesafter} ||= 3_000_000_000 ; #
$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
$mysync->{maxsleep} = ( defined $mysync->{maxsleep} ) ? $mysync->{maxsleep} : $MAX_SLEEP ; ;
$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;
@@ -15507,24 +17785,24 @@
return ;
}
-sub gmail2
+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
+ $mysync->{ host2 } ||= 'imap.gmail.com' ;
+ $mysync->{ ssl2 } = ( defined $mysync->{ ssl2 } ) ? $mysync->{ ssl2 } : 1 ;
+ $mysync->{ maxbytespersecond } ||= 20_000 ; # should be less than 10_000 computed from by Gmail documentation
+ $mysync->{ maxbytesafter } ||= 1_000_000_000 ; # In fact it is documented as half: 500_000_000
- $mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
+ $mysync->{ automap } = ( defined $mysync->{ automap } ) ? $mysync->{ automap } : 1 ;
#$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;
$mysync->{ expunge1 } = ( defined $mysync->{ expunge1 } ) ? $mysync->{ expunge1 } : 1 ;
- $mysync->{addheader} = ( defined $mysync->{addheader} ) ? $mysync->{addheader} : 1 ;
- $mysync->{maxsleep} = ( defined $mysync->{maxsleep} ) ? $mysync->{maxsleep} : $MAX_SLEEP ; ;
+ $mysync->{ addheader } = ( defined $mysync->{ addheader } ) ? $mysync->{ addheader } : 1 ;
+ $mysync->{ maxsleep } = ( defined $mysync->{ maxsleep } ) ? $mysync->{ maxsleep } : $MAX_SLEEP ; ;
- $mysync->{maxsize} = ( defined $mysync->{maxsize} ) ? $mysync->{maxsize} : $GMAIL_MAXSIZE ;
+ #$mysync->{ maxsize } = ( defined $mysync->{ maxsize } ) ? $mysync->{ maxsize } : $GMAIL_MAXSIZE ;
- if ( ! $mysync->{noexclude} ) {
+ if ( ! $mysync->{ noexclude } ) {
push @exclude, '\[Gmail\]$' ;
}
push @useheader, 'Message-Id' ;
@@ -15571,7 +17849,7 @@
$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
$mysync->{ maxsize } ||= 45_000_000 ;
$mysync->{maxmessagespersecond} ||= 4 ;
- #push @regexflag, 's/\\\\Flagged//g' ; # No problem without! tested 2018_09_10
+ #push @{ $mysync->{ regexflag } }, 's/\\\\Flagged//g' ; # No problem without! tested 2018_09_10
$disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
# I dislike double negation but here is one
if ( ! $mysync->{noregexmess} )
@@ -15607,7 +17885,7 @@
$disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
# I dislike double negation but here are two
if ( ! $mysync->{noregexflag} ) {
- push @regexflag, 's/\\\\Flagged//g' ;
+ push @{ $mysync->{ regexflag } }, 's/\\\\Flagged//g' ;
}
if ( ! $mysync->{noregexmess} ) {
push @regexmess, 's,(.{10239}),$1\r\n,g' ;
@@ -15649,14 +17927,17 @@
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' ) ;
+ is( '2001:41d0:2:84e0::1', resolv( 'imapsync.lamiral.info' ), 'resolv: imapsync.lamiral.info => 2001:41d0:2:84e0::1' ) ;
# ip6-localhost ( in /etc/hosts )
is( '::1', resolv( 'ip6-localhost' ), 'resolv: ip6-localhost => ::1' ) ;
is( '::1', resolv( '::1' ), 'resolv: ::1 => ::1' ) ;
- # ks2
+ # ks2ipv6 now has CNAME ks6ipv6
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' ) ;
+ is( '2001:41d0:8:9951::1', resolv( 'ks6ipv6.lamiral.info' ), 'resolv: ks6ipv6.lamiral.info => 2001:41d0:8:9951::1' ) ;
+ # ks6
+ is( '2001:41d0:8:9951::1', resolv( '2001:41d0:8:9951::1' ), 'resolv: 2001:41d0:8:9951::1 => 2001:41d0:8:9951::1' ) ;
+ is( '2001:41d0:8:9951::1', resolv( 'ks6ipv6.lamiral.info' ), 'resolv: ks6ipv6.lamiral.info => 2001:41d0:8:9951::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' ) ;
@@ -15692,6 +17973,7 @@
{
my $host = shift @ARG ;
+ $sync->{ debug } and myprint( "Entering resolv_with_getaddrinfo( $host )\n" ) ;
if ( ! $host ) { return ; }
my ( $err_getaddrinfo, @res ) = Socket::getaddrinfo( $host, "", { socktype => Socket::SOCK_RAW } ) ;
@@ -15706,14 +17988,17 @@
if ( $err_getnameinfo ) {
myprint( "Cannot getnameinfo of $host: $err_getnameinfo\n" ) ;
return ;
- }
- $sync->{ debug } and myprint( "$host => $ipaddr\n" ) ;
- push @addr, $ipaddr ;
- my $reverse ;
- ( $err_getnameinfo, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
- $sync->{ debug } and myprint( "$host => $ipaddr => $reverse\n" ) ;
- }
+ }else{
+ $sync->{ debug } and myprint( "$host => $ipaddr\n" ) ;
+ push @addr, $ipaddr ;
+ my $reverse ;
+ ( $err_getnameinfo, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
+ $sync->{ debug } and myprint( "$host => $ipaddr => $reverse\n" ) ;
+ }
+ $sync->{ debug } and myprint( "$host => $ipaddr\n" ) ;
+ }
+ $sync->{ debug } and myprint( "Leaving resolv_with_getaddrinfo( $host => $addr[0])\n" ) ;
return $addr[0] ;
}
@@ -15733,8 +18018,8 @@
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' ) ;
+ is( 'ks6ipv6.lamiral.info', resolvrev( '2001:41d0:8:d8b6::1' ), 'resolvrev: 2001:41d0:8:d8b6::1 => ks6ipv6.lamiral.info' ) ;
+ is( 'ks6ipv6.lamiral.info', resolvrev( 'ks6ipv6.lamiral.info' ), 'resolvrev: ks6ipv6.lamiral.info => ks6ipv6.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' ) ;
@@ -15793,7 +18078,7 @@
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' ) ;
+ is( 1, imapsping( 'ks6ipv6.lamiral.info' ), 'imapsping: ks6ipv6.lamiral.info => 1' ) ;
note( 'Leaving tests_imapsping()' ) ;
return ;
}
@@ -15873,7 +18158,7 @@
$mysync = {
sslcheck => 1,
- host1 => 'imapsync.lamiral.info',
+ host1 => 'test1.lamiral.info',
tls1 => 1,
} ;
@@ -15881,32 +18166,32 @@
$mysync = {
sslcheck => 1,
- host1 => 'imapsync.lamiral.info',
+ host1 => 'test1.lamiral.info',
} ;
- is( 1, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info => 1' ) ;
- is( 1, $mysync->{ssl1}, 'sslcheck: imapsync.lamiral.info => ssl1 1' ) ;
+ is( 1, sslcheck( $mysync ), 'sslcheck: test1.lamiral.info => 1' ) ;
+ is( 1, $mysync->{ssl1}, 'sslcheck: test1.lamiral.info => ssl1 1' ) ;
$mysync->{sslcheck} = 0 ;
is( undef, sslcheck( $mysync ), 'sslcheck: sslcheck off => undef' ) ;
$mysync = {
sslcheck => 1,
- host1 => 'imapsync.lamiral.info',
+ host1 => 'test1.lamiral.info',
host2 => 'test2.lamiral.info',
} ;
- is( 2, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info + test2.lamiral.info => 2' ) ;
+ is( 2, sslcheck( $mysync ), 'sslcheck: test1.lamiral.info + test2.lamiral.info => 2' ) ;
$mysync = {
sslcheck => 1,
- host1 => 'imapsync.lamiral.info',
+ host1 => 'test1.lamiral.info',
host2 => 'test2.lamiral.info',
tls1 => 1,
} ;
- is( 1, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info + test2.lamiral.info + tls1 => 1' ) ;
+ is( 1, sslcheck( $mysync ), 'sslcheck: test1.lamiral.info + test2.lamiral.info + tls1 => 1' ) ;
note( 'Leaving tests_sslcheck()' ) ;
return ;
@@ -15977,10 +18262,10 @@
sub testslive6_init
{
my $mysync = shift ;
- $mysync->{host1} ||= 'ks2ipv6.lamiral.info' ;
+ $mysync->{host1} ||= 'ks6ipv6.lamiral.info' ;
$mysync->{user1} ||= 'test1' ;
$mysync->{password1} ||= 'secret1' ;
- $mysync->{host2} ||= 'ks2ipv6.lamiral.info' ;
+ $mysync->{host2} ||= 'ks6ipv6.lamiral.info' ;
$mysync->{user2} ||= 'test2' ;
$mysync->{password2} ||= 'secret2' ;
return ;
@@ -16143,7 +18428,6 @@
}
-
sub tests_toggle_sleep
{
note( 'Entering tests_toggle_sleep()' ) ;
@@ -16318,6 +18602,147 @@
return( $usage ) ;
}
+
+
+
+sub setvalfromcgikey
+{
+ my ( $mysync, $mycgi, $key, $val ) = @ARG ;
+
+ my $badthings = 0 ;
+
+
+ my ( $name, $type, $struct ) ;
+ if ( $key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/mxs )
+ {
+ $badthings++ ;
+ next ; # Unknown item
+ }
+ else
+ {
+ $name = [ split '|', $1, 1 ]->[0] ; # option name ab|cd|ef => keep only ab
+ $type = $2 ; # = or : followed by i or s or f
+ $struct = $3 ; # + or ! or @ or %
+ }
+
+ if ( ( $struct || q{} ) eq '+' )
+ {
+ ${$val} = $mycgi->param( $name ) ; # "Incremental" integer
+ }
+ elsif ( $type )
+ {
+ my @values = $mycgi->multi_param( $name ) ;
+
+ #myprint( "type[$type]values[@values]\$struct[", $struct || q{}, "]val[$val]ref(val)[", ref($val), "]\n" ) ;
+ if ( ( $struct || q{} ) eq '%' or ref( $val ) eq 'HASH' )
+ {
+ setvalfromhash( $val, $type, @values ) ;
+ }
+ else
+ {
+ setvalfromlist( $mysync, $val, $name, $type, $struct, @values ) ;
+ }
+ }
+ else
+ {
+ setvalfromcheckbox( $mysync, $mycgi, $key, $name, $val ) ;
+ }
+
+ return $badthings ;
+}
+
+sub setvalfromlist
+{
+ my ( $mysync, $val, $name, $type, $struct, @values ) = @ARG ;
+ if ( $type =~ m/i$/mxs )
+ {
+ @values = map { q{} ne $_ ? int $_ : undef } @values ;
+ }
+ elsif ( $type =~ m/f$/mxs )
+ {
+ @values = map { 0 + $_ } @values ;
+ }
+
+ if ( ( $struct || q{} ) eq '@' )
+ {
+ @{ ${$val} } = @values ;
+ my @option = map { +( "--$name", "$_" ) } @values ;
+ push @{ $mysync->{ cmdcgi } }, @option ;
+ }
+ elsif ( ref( $val ) eq 'ARRAY' )
+ {
+ @{$val} = @values ;
+ }
+ elsif ( my $value = $values[0] )
+ {
+ ${$val} = $value ;
+ push @{ $mysync->{ cmdcgi } }, "--$name", $value ;
+ }
+ else
+ {
+ }
+
+ return ;
+}
+sub setvalfromhash
+{
+ my ( $val, $type, @values ) = @ARG ;
+
+ 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 )
+ {
+ %{ ${$val} } = %values ;
+ }
+ else
+ {
+ %{$val} = %values ;
+ }
+
+ return ;
+}
+
+
+sub setvalfromcheckbox
+{
+ my ( $mysync, $mycgi, $key, $name, $val ) = @ARG ;
+
+ # Checkbox
+ # --noname is set by name=0 or name=
+ my $value = $mycgi->param( $name ) ;
+ if ( defined $value )
+ {
+ ${$val} = $value ;
+ if ( $value )
+ {
+ push @{ $mysync->{ cmdcgi } }, "--$name" ;
+ }
+ else
+ {
+ push @{ $mysync->{ cmdcgi } }, "--no$name" ;
+ }
+ }
+ else
+ {
+ ${$val} = undef ;
+ }
+ return ;
+}
+
sub myGetOptions
{
@@ -16325,6 +18750,7 @@
# 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.
+ # It also applies for the sub functions called from this one.
my $mysync = shift @ARG ;
my $arguments_ref = shift @ARG ;
@@ -16345,84 +18771,10 @@
foreach my $key ( sort keys %options ) {
my $val = $options{$key} ;
- if ( $key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/mxs ) {
- $badthings++ ;
- next ; # Unknown item
- }
+ $badthings += setvalfromcgikey( $mysync, $mycgi, $key, $val ) ;
- 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[$type]values[@values]\$3[", $3 || q{}, "]val[$val]ref(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 ) {
- %{ ${$val} } = %values ;
- }
- else {
- %{$val} = %values ;
- }
- }
- else {
- if ( $type =~ m/i$/mxs ) {
- @values = map { q{} ne $_ ? int $_ : undef } @values ;
- }
- elsif ( $type =~ m/f$/mxs ) {
- @values = map { 0 + $_ } @values ;
- }
- if ( ( $3 || q{} ) eq '@' ) {
- @{ ${$val} } = @values ;
- my @option = map { +( "--$name", "$_" ) } @values ;
- push @{ $mysync->{ cmdcgi } }, @option ;
- }
- elsif ( ref( $val ) eq 'ARRAY' ) {
- @{$val} = @values ;
- }
- elsif ( my $value = $values[0] )
- {
- ${$val} = $value ;
- push @{ $mysync->{ cmdcgi } }, "--$name", $value ;
- }
- else
- {
-
- }
- }
- }
- else
- {
- # Checkbox
- # Considers only --name
- # Should consider also --no-name and --noname
- my $value = $mycgi->param( $name ) ;
- if ( $value )
- {
- ${$val} = 1 ;
- push @{ $mysync->{ cmdcgi } }, "--$name" ;
- }
- else
- {
- ${$val} = undef ;
- }
- }
}
+
if ( $badthings ) {
return ; # undef or ()
}
@@ -16432,11 +18784,12 @@
}
-my @blabla ; # just used to check get_options_cgi() with an array
+
sub tests_get_options_cgi_context
{
- note( 'Entering tests_get_options_cgi()' ) ;
+ note( 'Entering tests_get_options_cgi_context()' ) ;
+
# Temporary, have to think harder about testing CGI context in command line --tests
# API:
@@ -16454,15 +18807,21 @@
my $mysync ;
is( undef, get_options( $mysync ), 'get_options cgi context: no CGI module => undef' ) ;
- require CGI ;
- CGI->import( qw( -no_debug -utf8 ) ) ;
+ # skip all next tests if the CGI module is not available
+
+ SKIP: {
+ if ( ! eval { require CGI ; } ) {
+ skip( "CGI Perl module is not installed", 19 ) ;
+ }
+
+ CGI->import( qw( -no_debug -utf8 ) ) ;
is( undef, get_options( $mysync ), 'get_options cgi context: no CGI param => undef' ) ;
# Testing boolean
$mysync->{cgi} = CGI->new( 'version=on&debugenv=on' ) ;
local $ENV{'QUERY_STRING'} = 'version=on&debugenv=on' ;
is( 22, get_options( $mysync ), 'get_options cgi context: QUERY_STRING => 22' ) ;
- is( 1, $mysync->{ version }, 'get_options cgi context: --version => 1' ) ;
+ is( 'on', $mysync->{ version }, 'get_options cgi context: --version => on' ) ;
# debugenv is not allowed in cgi context
is( undef, $mysync->{debugenv}, 'get_options cgi context: $mysync->{debugenv} => undef' ) ;
@@ -16474,14 +18833,6 @@
is( 'test1', $mysync->{user1}, 'get_options cgi context: $mysync->{user1} => test1' ) ;
#local $ENV{'QUERY_STRING'} = undef ;
- # Testing @
- $mysync->{cgi} = CGI->new( 'blabla=fd1' ) ;
- get_options( $mysync ) ;
- is_deeply( [ 'fd1' ], [ @blabla ], 'get_options cgi context: @blabla => fd1' ) ;
- $mysync->{cgi} = CGI->new( 'blabla=fd1&blabla=fd2' ) ;
- get_options( $mysync ) ;
- is_deeply( [ 'fd1', 'fd2' ], [ @blabla ], 'get_options cgi context: @blabla => fd1, fd2' ) ;
-
# Testing s@ as ref
$mysync->{cgi} = CGI->new( 'folder=fd1' ) ;
get_options( $mysync ) ;
@@ -16522,10 +18873,21 @@
#myprint( Data::Dumper->Dump( [ $mysync ] ) ) ;
$mysync ={} ;
- $mysync->{cgi} = CGI->new( 'justfoldersizes=on' ) ;
+ $mysync->{cgi} = CGI->new( 'testslive=on' ) ;
get_options( $mysync ) ;
- is( 1, $mysync->{ justfoldersizes }, 'get_options cgi context: --justfoldersizes=1 => justfoldersizes => 1' ) ;
- myprint( Data::Dumper->Dump( [ $mysync ] ) ) ;
+ is( 'on', $mysync->{ testslive }, 'get_options cgi context: --testslive=on => testslive => on' ) ;
+ #myprint( Data::Dumper->Dump( [ $mysync ] ) ) ;
+
+ $mysync ={} ;
+ $mysync->{cgi} = CGI->new( 'log=0' ) ;
+ get_options( $mysync ) ;
+ is( 0, $mysync->{ log }, 'get_options cgi context: --log=0 => log => 0' ) ;
+ #myprint( Data::Dumper->Dump( [ $mysync ] ) ) ;
+
+
+ # What is this fucked up indentation?
+ }
+
note( 'Leaving tests_get_options_cgi_context()' ) ;
return ;
@@ -16545,41 +18907,43 @@
my $opt_ret = myGetOptions(
$mysync,
\@arguments,
- 'abort' => \$mysync->{abort},
+ 'abort' => \$mysync->{ abort },
+ 'abortbyfile' => \$mysync->{ abortbyfile },
'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' => \$mysync->{version},
- 'ssl1!' => \$mysync->{ssl1},
- 'ssl2!' => \$mysync->{ssl2},
- 'tls1!' => \$mysync->{tls1},
- 'tls2!' => \$mysync->{tls2},
- 'justlogin!' => \$mysync->{justlogin},
- 'justconnect!' => \$mysync->{justconnect},
- 'addheader!' => \$mysync->{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},
- 'f1f2h=s%' => \$mysync->{f1f2h},
- 'folder=s@' => \$mysync->{ folder },
- 'blabla=s' => \@blabla,
- 'testslive!' => \$mysync->{testslive},
- 'testslive6!' => \$mysync->{testslive6},
- 'releasecheck!' => \$mysync->{releasecheck},
- 'simulong=i' => \$mysync->{simulong},
- 'debugsleep=f' => \$mysync->{debugsleep},
+ 'password1=s' => \$mysync->{ password1 },
+ 'password2=s' => \$mysync->{ password2 },
+ 'dry!' => \$mysync->{ dry },
+ 'dry1!' => \$mysync->{ dry1 },
+ 'version' => \$mysync->{ version },
+ 'ssl1!' => \$mysync->{ ssl1 },
+ 'ssl2!' => \$mysync->{ ssl2 },
+ 'tls1!' => \$mysync->{ tls1 },
+ 'tls2!' => \$mysync->{ tls2 },
+ 'justbanner!' => \$mysync->{ justbanner },
+ 'justlogin!' => \$mysync->{ justlogin },
+ 'justconnect!' => \$mysync->{ justconnect },
+ 'addheader!' => \$mysync->{ 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 },
+ 'f1f2h=s%' => \$mysync->{ f1f2h },
+ 'folder=s@' => \$mysync->{ folder },
+ 'testslive!' => \$mysync->{ testslive },
+ 'testslive6!' => \$mysync->{ testslive6 },
+ 'releasecheck!' => \$mysync->{ releasecheck },
+ 'simulong=f' => \$mysync->{ simulong },
+ 'debugsleep=f' => \$mysync->{ debugsleep },
'subfolder1=s' => \$mysync->{ subfolder1 },
'subfolder2=s' => \$mysync->{ subfolder2 },
'justfolders!' => \$mysync->{ justfolders },
@@ -16587,9 +18951,15 @@
'delete1!' => \$mysync->{ delete1 },
'delete2!' => \$mysync->{ delete2 },
'delete2duplicates!' => \$mysync->{ delete2duplicates },
- 'tail!' => \$mysync->{tail},
+ 'tail!' => \$mysync->{ tail },
+ 'tmphash=s' => \$mysync->{ tmphash },
+ 'exitwhenover=i' => \$mysync->{ exitwhenover },
+ 'syncduplicates!' => \$mysync->{ syncduplicates },
+ 'log!' => \$mysync->{ log },
+ 'loglogfile!' => \$mysync->{ loglogfile },
+
-# blabla and f1f2h=s% could be removed but
+# f1f2h=s% could be removed but
# tests_get_options_cgi() should be split before
# with a sub tests_myGetOptions()
) ;
@@ -16624,9 +18994,9 @@
'debugcontent!' => \$debugcontent,
'debugsleep=f' => \$mysync->{debugsleep},
'debugflags!' => \$debugflags,
- 'debugimap!' => \$debugimap,
- 'debugimap1!' => \$debugimap1,
- 'debugimap2!' => \$debugimap2,
+ 'debugimap!' => \$mysync->{ debugimap },
+ 'debugimap1!' => \$mysync->{ acc1 }->{ debugimap },
+ 'debugimap2!' => \$mysync->{ acc2 }->{ debugimap },
'debugdev!' => \$debugdev,
'debugmemory!' => \$mysync->{debugmemory},
'debugfolders!' => \$mysync->{debugfolders},
@@ -16635,8 +19005,11 @@
'debugenv!' => \$mysync->{debugenv},
'debugsig!' => \$mysync->{debugsig},
'debuglabels!' => \$mysync->{debuglabels},
- 'simulong=i' => \$mysync->{simulong},
+
+ 'simulong=f' => \$mysync->{simulong},
'abort' => \$mysync->{abort},
+ 'abortbyfile' => \$mysync->{abortbyfile},
+
'host1=s' => \$mysync->{ host1 },
'host2=s' => \$mysync->{ host2 },
'port1=i' => \$mysync->{port1},
@@ -16653,8 +19026,8 @@
'exchange2' => \$mysync->{exchange2},
'domino1' => \$mysync->{domino1},
'domino2' => \$mysync->{domino2},
- 'domain1=s' => \$domain1,
- 'domain2=s' => \$domain2,
+ 'domain1=s' => \$mysync->{ acc1 }->{ domain },
+ 'domain2=s' => \$mysync->{ acc2 }->{ domain },
'password1=s' => \$mysync->{password1},
'password2=s' => \$mysync->{password2},
'passfile1=s' => \$mysync->{ passfile1 },
@@ -16662,6 +19035,15 @@
'authmd5!' => \$authmd5,
'authmd51!' => \$authmd51,
'authmd52!' => \$authmd52,
+
+ 'trylogin!' => \$mysync->{ trylogin },
+
+ 'oauthdirect1=s' => \$mysync->{ acc1 }->{ oauthdirect },
+ 'oauthdirect2=s' => \$mysync->{ acc2 }->{ oauthdirect },
+
+ 'oauthaccesstoken1=s' => \$mysync->{ acc1 }->{ oauthaccesstoken },
+ 'oauthaccesstoken2=s' => \$mysync->{ acc2 }->{ oauthaccesstoken },
+
'sep1=s' => \$mysync->{ sep1 },
'sep2=s' => \$mysync->{ sep2 },
'sanitize!' => \$mysync->{ sanitize },
@@ -16687,10 +19069,11 @@
'pipemess=s' => \@pipemess,
'pipemesscheck!' => \$pipemesscheck,
'disarmreadreceipts!' => \$disarmreadreceipts,
- 'regexflag=s' => \@regexflag,
- 'noregexflag' => \$mysync->{noregexflag},
- 'filterflags!' => \$filterflags,
- 'flagscase!' => \$flagscase,
+ 'regexflag=s@' => \$mysync->{ regexflag },
+ 'noregexflag' => \$mysync->{ noregexflag },
+ 'filterflags!' => \$mysync->{ filterflags },
+ 'filterbuggyflags!' => \$mysync->{ filterbuggyflags },
+ 'flagscase!' => \$mysync->{ flagscase },
'syncflagsaftercopy!' => \$syncflagsaftercopy,
'resyncflags!' => \$mysync->{ resyncflags },
'synclabels!' => \$mysync->{ synclabels },
@@ -16703,7 +19086,7 @@
'delete2foldersbutnot=s' => \$delete2foldersbutnot,
'syncinternaldates!' => \$syncinternaldates,
'idatefromheader!' => \$idatefromheader,
- 'syncacls!' => \$syncacls,
+ 'syncacls!' => \$mysync->{ syncacls },
'maxsize=i' => \$mysync->{ maxsize },
'appendlimit=i' => \$mysync->{ appendlimit },
'truncmess=i' => \$mysync->{ truncmess },
@@ -16716,51 +19099,52 @@
'foldersizes!' => \$mysync->{ foldersizes },
'foldersizesatend!' => \$mysync->{ foldersizesatend },
'dry!' => \$mysync->{dry},
+ 'dry1!' => \$mysync->{dry1},
'expunge1|expunge!' => \$mysync->{ expunge1 },
'expunge2!' => \$mysync->{ expunge2 },
'uidexpunge2!' => \$mysync->{ uidexpunge2 },
'subscribed' => \$subscribed,
'subscribe!' => \$subscribe,
'subscribeall|subscribe_all!' => \$subscribeall,
- 'justbanner!' => \$justbanner,
+ 'justbanner!' => \$mysync->{ justbanner },
'justfolders!'=> \$mysync->{ justfolders },
'justfoldersizes!' => \$mysync->{ justfoldersizes },
'fast!' => \$fast,
'version' => \$mysync->{version},
'help' => \$help,
- 'timeout=i' => \$timeout,
- 'timeout1=i' => \$mysync->{h1}->{timeout},
- 'timeout2=i' => \$mysync->{h2}->{timeout},
- 'skipheader=s' => \$skipheader,
+ 'timeout=f' => \$mysync->{timeout},
+ 'timeout1=f' => \$mysync->{ acc1 }->{timeout},
+ 'timeout2=f' => \$mysync->{ acc2 }->{timeout},
+ 'skipheader=s' => \$mysync->{ skipheader },
'useheader=s' => \@useheader,
'wholeheaderifneeded!' => \$wholeheaderifneeded,
'messageidnodomain!' => \$messageidnodomain,
'skipsize!' => \$skipsize,
'allowsizemismatch!' => \$allowsizemismatch,
- 'fastio1!' => \$fastio1,
- 'fastio2!' => \$fastio2,
+ 'fastio1!' => \$mysync->{ acc1 }->{ fastio },
+ 'fastio2!' => \$mysync->{ acc2 }->{ fastio },
'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},
+ 'ssl1_ssl_version=s' => \$mysync->{ acc1 }->{sslargs}->{SSL_version},
+ 'ssl2_ssl_version=s' => \$mysync->{ acc2 }->{sslargs}->{SSL_version},
+ 'sslargs1=s%' => \$mysync->{ acc1 }->{sslargs},
+ 'sslargs2=s%' => \$mysync->{ acc2 }->{sslargs},
'tls1!' => \$mysync->{tls1},
'tls2!' => \$mysync->{tls2},
'uid1!' => \$uid1,
'uid2!' => \$uid2,
- 'authmech1=s' => \$authmech1,
- 'authmech2=s' => \$authmech2,
- 'authuser1=s' => \$authuser1,
- 'authuser2=s' => \$authuser2,
- 'proxyauth1' => \$proxyauth1,
- 'proxyauth2' => \$proxyauth2,
+ 'authmech1=s' => \$mysync->{ acc1 }->{ authmech },
+ 'authmech2=s' => \$mysync->{ acc2 }->{ authmech },
+ 'authuser1=s' => \$mysync->{ acc1 }->{ authuser },
+ 'authuser2=s' => \$mysync->{ acc2 }->{ authuser },
+ 'proxyauth1' => \$mysync->{ acc1 }->{ proxyauth },
+ 'proxyauth2' => \$mysync->{ acc2 }->{ proxyauth },
'split1=i' => \$split1,
'split2=i' => \$split2,
'buffersize=i' => \$buffersize,
- 'reconnectretry1=i' => \$reconnectretry1,
- 'reconnectretry2=i' => \$reconnectretry2,
+ 'reconnectretry1=i' => \$mysync->{ acc1 }->{ reconnectretry },
+ 'reconnectretry2=i' => \$mysync->{ acc2 }->{ reconnectretry },
'tests!' => \$mysync->{ tests },
'testsdebug|tests_debug!' => \$mysync->{ testsdebug },
'testsunit=s@' => \$mysync->{testsunit},
@@ -16816,15 +19200,23 @@
'nof1f2' => \$mysync->{nof1f2},
'f1f2h=s%' => \$mysync->{f1f2h},
'justfolderlists!' => \$mysync->{justfolderlists},
- 'delete1emptyfolders' => \$mysync->{delete1emptyfolders},
+ 'delete1emptyfolders' => \$mysync->{delete1emptyfolders},
+ 'checknoabletosearch!' => \$mysync->{checknoabletosearch},
+ 'syncduplicates!' => \$mysync->{ syncduplicates },
+ 'dockercontext!' => \$mysync->{ dockercontext },
+
+
) ;
#myprint( Data::Dumper->Dump( [ $mysync ] ) ) ;
$mysync->{ debug } and output( $mysync, "get options: [$opt_ret][$numopt]\n" ) ;
my $numopt_after = scalar @arguments ;
#myprint( "get options: [$opt_ret][$numopt][$numopt_after]\n" ) ;
- if ( $numopt_after ) {
+
+ # The $arguments[0] test is just because parallel adds "" when it is
+ # used with {=7=} in sync_parallel_unix.sh
+ if ( $numopt_after and $arguments[0] ) {
myprint(
- "Extra arguments found: @arguments\n",
+ "Found ", scalar( @arguments ), " extra arguments : [@arguments]\n",
"It usually means a quoting issue in the command line ",
"or some misspelling options.\n",
) ;
@@ -16915,6 +19307,25 @@
return $ret ;
}
+
+sub condition_to_leave_after_tests
+{
+ my $mysync = shift ;
+ if ( $mysync->{ testslive } or $mysync->{ testslive6 } )
+ {
+ return 0 ;
+ }
+
+ if ( $mysync->{ tests }
+ or $mysync->{ testsdebug }
+ or $mysync->{ testsunit }
+ )
+ {
+ return 1 ;
+ }
+}
+
+
sub testunitsession
{
my $mysync = shift ;
@@ -17055,7 +19466,9 @@
#tests_killpid_by_brother( ) ;
#tests_kill_zero( ) ;
#tests_connect_socket( ) ;
- tests_probe_imapssl( ) ;
+ #tests_probe_imapssl( ) ;
+ tests_cpu_number( ) ;
+ tests_mailimapclient_connect( ) ;
#tests_always_fail( ) ;
note( 'Leaving testsdebug()' ) ;
@@ -17077,7 +19490,7 @@
tests_compare_lists( ) ;
tests_regexmess( ) ;
tests_skipmess( ) ;
- tests_flags_regex();
+ tests_regexflags( );
tests_ucsecond( ) ;
tests_permanentflags();
tests_flags_filter( ) ;
@@ -17186,7 +19599,7 @@
tests_remove_pidfile_not_running( ) ;
tests_match_a_pid_number( ) ;
tests_prefix_seperator_invertion( ) ;
- tests_is_an_integer( ) ;
+ tests_is_integer( ) ;
tests_integer_or_1( ) ;
tests_is_number( ) ;
tests_sig_install( ) ;
@@ -17232,16 +19645,37 @@
tests_abort( ) ;
tests_probe_imapssl( ) ;
tests_mailimapclient_connect( ) ;
+ tests_checknoabletosearch( ) ;
+ tests_errorsdump( ) ;
+ tests_errorsanalyse( ) ;
+ tests_most_common_error( ) ;
+ tests_errorclassify( ) ;
+ tests_error_type( ) ;
+ tests_sanitize_host( ) ;
+ tests_hmac_sha1_hex( ) ;
+ tests_total_bytes_max_reached( ) ;
+ tests_header_construct( ) ;
+ tests_remove_doublequotes_if_any( ) ;
+ tests_login_imap( ) ;
+ tests_login_imap_oauth( ) ;
+ tests_skipmess_neg( ) ;
+ tests_localtimez( ) ;
+ tests_file_to_array( ) ;
+ tests_cpu_time( ) ;
+ tests_cpu_percent( ) ;
+ tests_cpu_percent_global( ) ;
+ tests_flags_for_host2( ) ;
+ tests_under_docker_context( ) ;
#tests_resolv( ) ;
-
- # Those three are for later use, when webserver will be inside imapsync
+
+ # Those three are for later use, when webserver will be inside imapsync
# or will be deleted them if I abandon the project.
#tests_killpid_by_parent( ) ;
#tests_killpid_by_brother( ) ;
#tests_kill_zero( ) ;
-
+
#tests_always_fail( ) ;
- done_testing( 1496 ) ;
+ done_testing( 1742 ) ;
note( 'Leaving tests()' ) ;
}
return ;
@@ -17251,11 +19685,19 @@
{
note( 'Entering tests_template()' ) ;
- is( undef, undef, 'template: no args => undef' ) ;
+ is( undef, template( ), 'template: no args => undef' ) ;
+ my $mysync = { } ;
+ is( undef, template( $mysync ), 'template: undef => undef' ) ;
is_deeply( {}, {}, 'template: a hash is a hash' ) ;
is_deeply( [], [], 'template: an array is an array' ) ;
+
note( 'Leaving tests_template()' ) ;
return ;
}
-
+sub template
+{
+ my $mysync = shift @ARG ;
+
+ return ;
+}
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync_cron.pl b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync_runner.pl
similarity index 96%
rename from mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync_cron.pl
rename to mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync_runner.pl
index 746b1d4..0f01a97 100644
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync_cron.pl
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/imapsync_runner.pl
@@ -36,11 +36,11 @@
}
$run_dir="/tmp";
-$dsn = 'DBI:mysql:database=__DBNAME__;mysql_socket=/var/run/mysqld/mysqld.sock';
+$dsn = 'DBI:mysql:database=' . $ENV{'DBNAME'} . ';mysql_socket=/var/run/mysqld/mysqld.sock';
$lock_file = $run_dir . "/imapsync_busy";
$lockmgr = LockFile::Simple->make(-autoclean => 1, -max => 1);
$lockmgr->lock($lock_file) || die "can't lock ${lock_file}";
-$dbh = DBI->connect($dsn, '__DBUSER__', '__DBPASS__', {
+$dbh = DBI->connect($dsn, $ENV{'DBUSER'}, $ENV{'DBPASS'}, {
mysql_auto_reconnect => 1,
mysql_enable_utf8mb4 => 1
});
@@ -127,6 +127,7 @@
my $generated_cmds = [ "/usr/local/bin/imapsync",
"--tmpdir", "/tmp",
"--nofoldersizes",
+ "--addheader",
($timeout1 gt "0" ? () : ('--timeout1', $timeout1)),
($timeout2 gt "0" ? () : ('--timeout2', $timeout2)),
($exclude eq "" ? () : ("--exclude", $exclude)),
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/maildir_gc.sh b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/maildir_gc.sh
index 24c1e46..21358cc 100755
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/maildir_gc.sh
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/maildir_gc.sh
@@ -1,2 +1,2 @@
-#/bin/bash
+#!/bin/bash
[ -d /var/vmail/_garbage/ ] && /usr/bin/find /var/vmail/_garbage/ -mindepth 1 -maxdepth 1 -type d -cmin +${MAILDIR_GC_TIME} -exec rm -r {} \;
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/postlogin.sh b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/postlogin.sh
deleted file mode 100755
index 01a45f3..0000000
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/postlogin.sh
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/sh
-export MASTER_USER=$USER
-exec "$@"
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quarantine_notify.py b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quarantine_notify.py
index adf3171..acd887a 100755
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quarantine_notify.py
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quarantine_notify.py
@@ -2,6 +2,7 @@
import smtplib
import os
+import sys
import mysql.connector
from email.mime.multipart import MIMEMultipart
from email.mime.text import MIMEText
@@ -15,137 +16,154 @@
import html2text
import socket
-while True:
- try:
- r = redis.StrictRedis(host='redis', decode_responses=True, port=6379, db=0)
- r.ping()
- except Exception as ex:
- print('%s - trying again...' % (ex))
- time.sleep(3)
- else:
- break
+pid = str(os.getpid())
+pidfile = "/tmp/quarantine_notify.pid"
-time_now = int(time.time())
-mailcow_hostname = '__MAILCOW_HOSTNAME__'
+if os.path.isfile(pidfile):
+ print("%s already exists, exiting" % (pidfile))
+ sys.exit()
-max_score = float(r.get('Q_MAX_SCORE') or "9999.0")
-if max_score == "":
- max_score = 9999.0
+pid = str(os.getpid())
+f = open(pidfile, 'w')
+f.write(pid)
+f.close()
-def query_mysql(query, headers = True, update = False):
+try:
+
while True:
try:
- cnx = mysql.connector.connect(unix_socket = '/var/run/mysqld/mysqld.sock', user='__DBUSER__', passwd='__DBPASS__', database='__DBNAME__', charset="utf8")
+ r = redis.StrictRedis(host='redis', decode_responses=True, port=6379, db=0)
+ r.ping()
except Exception as ex:
print('%s - trying again...' % (ex))
time.sleep(3)
else:
break
- cur = cnx.cursor()
- cur.execute(query)
- if not update:
- result = []
- columns = tuple( [d[0] for d in cur.description] )
- for row in cur:
- if headers:
- result.append(dict(list(zip(columns, row))))
- else:
- result.append(row)
- cur.close()
- cnx.close()
- return result
- else:
- cnx.commit()
- cur.close()
- cnx.close()
-def notify_rcpt(rcpt, msg_count, quarantine_acl, category):
- if category == "add_header": category = "add header"
- meta_query = query_mysql('SELECT SHA2(CONCAT(id, qid), 256) AS qhash, id, subject, score, sender, created, action FROM quarantine WHERE notified = 0 AND rcpt = "%s" AND score < %f AND (action = "%s" OR "all" = "%s")' % (rcpt, max_score, category, category))
- print("%s: %d of %d messages qualify for notification" % (rcpt, len(meta_query), msg_count))
- if len(meta_query) == 0:
- return
- msg_count = len(meta_query)
- if r.get('Q_HTML'):
- try:
- template = Template(r.get('Q_HTML'))
- except:
- print("Error: Cannot parse quarantine template, falling back to default template.")
+ time_now = int(time.time())
+ mailcow_hostname = os.environ.get('MAILCOW_HOSTNAME')
+
+ max_score = float(r.get('Q_MAX_SCORE') or "9999.0")
+ if max_score == "":
+ max_score = 9999.0
+
+ def query_mysql(query, headers = True, update = False):
+ while True:
+ try:
+ cnx = mysql.connector.connect(unix_socket = '/var/run/mysqld/mysqld.sock', user=os.environ.get('DBUSER'), passwd=os.environ.get('DBPASS'), database=os.environ.get('DBNAME'), charset="utf8")
+ except Exception as ex:
+ print('%s - trying again...' % (ex))
+ time.sleep(3)
+ else:
+ break
+ cur = cnx.cursor()
+ cur.execute(query)
+ if not update:
+ result = []
+ columns = tuple( [d[0] for d in cur.description] )
+ for row in cur:
+ if headers:
+ result.append(dict(list(zip(columns, row))))
+ else:
+ result.append(row)
+ cur.close()
+ cnx.close()
+ return result
+ else:
+ cnx.commit()
+ cur.close()
+ cnx.close()
+
+ def notify_rcpt(rcpt, msg_count, quarantine_acl, category):
+ if category == "add_header": category = "add header"
+ meta_query = query_mysql('SELECT SHA2(CONCAT(id, qid), 256) AS qhash, id, subject, score, sender, created, action FROM quarantine WHERE notified = 0 AND rcpt = "%s" AND score < %f AND (action = "%s" OR "all" = "%s")' % (rcpt, max_score, category, category))
+ print("%s: %d of %d messages qualify for notification" % (rcpt, len(meta_query), msg_count))
+ if len(meta_query) == 0:
+ return
+ msg_count = len(meta_query)
+ if r.get('Q_HTML'):
+ try:
+ template = Template(r.get('Q_HTML'))
+ except:
+ print("Error: Cannot parse quarantine template, falling back to default template.")
+ with open('/templates/quarantine.tpl') as file_:
+ template = Template(file_.read())
+ else:
with open('/templates/quarantine.tpl') as file_:
template = Template(file_.read())
- else:
- with open('/templates/quarantine.tpl') as file_:
- template = Template(file_.read())
- html = template.render(meta=meta_query, username=rcpt, counter=msg_count, hostname=mailcow_hostname, quarantine_acl=quarantine_acl)
- text = html2text.html2text(html)
- count = 0
- while count < 15:
- count += 1
+ html = template.render(meta=meta_query, username=rcpt, counter=msg_count, hostname=mailcow_hostname, quarantine_acl=quarantine_acl)
+ text = html2text.html2text(html)
+ count = 0
+ while count < 15:
+ count += 1
+ try:
+ server = smtplib.SMTP('postfix', 590, 'quarantine')
+ server.ehlo()
+ msg = MIMEMultipart('alternative')
+ msg_from = r.get('Q_SENDER') or "quarantine@localhost"
+ # Remove non-ascii chars from field
+ msg['From'] = ''.join([i if ord(i) < 128 else '' for i in msg_from])
+ msg['Subject'] = r.get('Q_SUBJ') or "Spam Quarantine Notification"
+ msg['Date'] = formatdate(localtime = True)
+ text_part = MIMEText(text, 'plain', 'utf-8')
+ html_part = MIMEText(html, 'html', 'utf-8')
+ msg.attach(text_part)
+ msg.attach(html_part)
+ msg['To'] = str(rcpt)
+ bcc = r.get('Q_BCC') or ""
+ redirect = r.get('Q_REDIRECT') or ""
+ text = msg.as_string()
+ if bcc == '':
+ if redirect == '':
+ server.sendmail(msg['From'], str(rcpt), text)
+ else:
+ server.sendmail(msg['From'], str(redirect), text)
+ else:
+ if redirect == '':
+ server.sendmail(msg['From'], [str(rcpt)] + [str(bcc)], text)
+ else:
+ server.sendmail(msg['From'], [str(redirect)] + [str(bcc)], text)
+ server.quit()
+ for res in meta_query:
+ query_mysql('UPDATE quarantine SET notified = 1 WHERE id = "%d"' % (res['id']), update = True)
+ r.hset('Q_LAST_NOTIFIED', record['rcpt'], time_now)
+ break
+ except Exception as ex:
+ server.quit()
+ print('%s' % (ex))
+ time.sleep(3)
+
+ records = query_mysql('SELECT IFNULL(user_acl.quarantine, 0) AS quarantine_acl, count(id) AS counter, rcpt FROM quarantine LEFT OUTER JOIN user_acl ON user_acl.username = rcpt WHERE notified = 0 AND score < %f AND rcpt in (SELECT username FROM mailbox) GROUP BY rcpt' % (max_score))
+
+ for record in records:
+ attrs = ''
+ attrs_json = ''
+ time_trans = {
+ "hourly": 3600,
+ "daily": 86400,
+ "weekly": 604800
+ }
try:
- server = smtplib.SMTP('postfix', 590, 'quarantine')
- server.ehlo()
- msg = MIMEMultipart('alternative')
- msg_from = r.get('Q_SENDER') or "quarantine@localhost"
- # Remove non-ascii chars from field
- msg['From'] = ''.join([i if ord(i) < 128 else '' for i in msg_from])
- msg['Subject'] = r.get('Q_SUBJ') or "Spam Quarantine Notification"
- msg['Date'] = formatdate(localtime = True)
- text_part = MIMEText(text, 'plain', 'utf-8')
- html_part = MIMEText(html, 'html', 'utf-8')
- msg.attach(text_part)
- msg.attach(html_part)
- msg['To'] = str(rcpt)
- bcc = r.get('Q_BCC') or ""
- redirect = r.get('Q_REDIRECT') or ""
- text = msg.as_string()
- if bcc == '':
- if redirect == '':
- server.sendmail(msg['From'], str(rcpt), text)
- else:
- server.sendmail(msg['From'], str(redirect), text)
- else:
- if redirect == '':
- server.sendmail(msg['From'], [str(rcpt)] + [str(bcc)], text)
- else:
- server.sendmail(msg['From'], [str(redirect)] + [str(bcc)], text)
- server.quit()
- for res in meta_query:
- query_mysql('UPDATE quarantine SET notified = 1 WHERE id = "%d"' % (res['id']), update = True)
- r.hset('Q_LAST_NOTIFIED', record['rcpt'], time_now)
- break
+ last_notification = int(r.hget('Q_LAST_NOTIFIED', record['rcpt']))
+ if last_notification > time_now:
+ print('Last notification is > time now, assuming never')
+ last_notification = 0
except Exception as ex:
- server.quit()
- print('%s' % (ex))
- time.sleep(3)
-
-records = query_mysql('SELECT IFNULL(user_acl.quarantine, 0) AS quarantine_acl, count(id) AS counter, rcpt FROM quarantine LEFT OUTER JOIN user_acl ON user_acl.username = rcpt WHERE notified = 0 AND score < %f AND rcpt in (SELECT username FROM mailbox) GROUP BY rcpt' % (max_score))
-
-for record in records:
- attrs = ''
- attrs_json = ''
- time_trans = {
- "hourly": 3600,
- "daily": 86400,
- "weekly": 604800
- }
- try:
- last_notification = int(r.hget('Q_LAST_NOTIFIED', record['rcpt']))
- if last_notification > time_now:
- print('Last notification is > time now, assuming never')
+ print('Could not determine last notification for %s, assuming never' % (record['rcpt']))
last_notification = 0
- except Exception as ex:
- print('Could not determine last notification for %s, assuming never' % (record['rcpt']))
- last_notification = 0
- attrs_json = query_mysql('SELECT attributes FROM mailbox WHERE username = "%s"' % (record['rcpt']))
- attrs = attrs_json[0]['attributes']
- if isinstance(attrs, str):
- # if attr is str then just load it
- attrs = json.loads(attrs)
- else:
- # if it's bytes then decode and load it
- attrs = json.loads(attrs.decode('utf-8'))
- if attrs['quarantine_notification'] not in ('hourly', 'daily', 'weekly'):
- continue
- if last_notification == 0 or (last_notification + time_trans[attrs['quarantine_notification']]) < time_now:
- print("Notifying %s: Considering %d new items in quarantine (policy: %s)" % (record['rcpt'], record['counter'], attrs['quarantine_notification']))
- notify_rcpt(record['rcpt'], record['counter'], record['quarantine_acl'], attrs['quarantine_category'])
+ attrs_json = query_mysql('SELECT attributes FROM mailbox WHERE username = "%s"' % (record['rcpt']))
+ attrs = attrs_json[0]['attributes']
+ if isinstance(attrs, str):
+ # if attr is str then just load it
+ attrs = json.loads(attrs)
+ else:
+ # if it's bytes then decode and load it
+ attrs = json.loads(attrs.decode('utf-8'))
+ if attrs['quarantine_notification'] not in ('hourly', 'daily', 'weekly'):
+ continue
+ if last_notification == 0 or (last_notification + time_trans[attrs['quarantine_notification']]) < time_now:
+ print("Notifying %s: Considering %d new items in quarantine (policy: %s)" % (record['rcpt'], record['counter'], attrs['quarantine_notification']))
+ notify_rcpt(record['rcpt'], record['counter'], record['quarantine_acl'], attrs['quarantine_category'])
+
+finally:
+ os.unlink(pidfile)
\ No newline at end of file
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quota_notify.py b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quota_notify.py
index fdfda30..2d7361b 100755
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quota_notify.py
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/quota_notify.py
@@ -9,6 +9,7 @@
from jinja2 import Template
import redis
import time
+import json
import sys
import html2text
from subprocess import Popen, PIPE, STDOUT
@@ -57,6 +58,27 @@
p = Popen(['/usr/lib/dovecot/dovecot-lda', '-d', username, '-o', '"plugin/quota=maildir:User quota:noenforcing"'], stdout=PIPE, stdin=PIPE, stderr=STDOUT)
p.communicate(input=bytes(msg.as_string(), 'utf-8'))
+ domain = username.split("@")[-1]
+ if domain and r.hget('QW_BCC', domain):
+ bcc_data = json.loads(r.hget('QW_BCC', domain))
+ bcc_rcpts = bcc_data['bcc_rcpts']
+ if bcc_data['active'] == 1:
+ for rcpt in bcc_rcpts:
+ msg = MIMEMultipart('alternative')
+ msg['From'] = username
+ subject = r.get('QW_SUBJ') or "Quota warning"
+ msg['Subject'] = subject + ' (' + username + ')'
+ msg['Date'] = formatdate(localtime = True)
+ text_part = MIMEText(text, 'plain', 'utf-8')
+ html_part = MIMEText(html, 'html', 'utf-8')
+ msg.attach(text_part)
+ msg.attach(html_part)
+ msg['To'] = rcpt
+ server = smtplib.SMTP('postfix', 588, 'quotanotification')
+ server.ehlo()
+ server.sendmail(msg['From'], str(rcpt), msg.as_string())
+ server.quit()
+
except Exception as ex:
print('Failed to send quota notification: %s' % (ex))
sys.exit(1)
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/sa-rules.sh b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/sa-rules.sh
index 1bfc8cc..89911c1 100755
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/sa-rules.sh
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/sa-rules.sh
@@ -2,7 +2,6 @@
# Create temp directories
[[ ! -d /tmp/sa-rules-heinlein ]] && mkdir -p /tmp/sa-rules-heinlein
-#[[ ! -d /tmp/sa-rules-schaal ]] && mkdir -p /tmp/sa-rules-schaal
# Hash current SA rules
if [[ ! -f /etc/rspamd/custom/sa-rules ]]; then
@@ -12,19 +11,11 @@
fi
# Deploy
-## Heinlein
-curl --connect-timeout 15 --retry 10 --max-time 30 http://www.spamassassin.heinlein-support.de/$(dig txt 1.4.3.spamassassin.heinlein-support.de +short | tr -d '"').tar.gz --output /tmp/sa-rules-heinlein.tar.gz
+curl --connect-timeout 15 --retry 10 --max-time 30 http://www.spamassassin.heinlein-support.de/$(dig txt 1.4.3.spamassassin.heinlein-support.de +short | tr -d '"' | tr -dc '0-9').tar.gz --output /tmp/sa-rules-heinlein.tar.gz
if gzip -t /tmp/sa-rules-heinlein.tar.gz; then
tar xfvz /tmp/sa-rules-heinlein.tar.gz -C /tmp/sa-rules-heinlein
cat /tmp/sa-rules-heinlein/*cf > /etc/rspamd/custom/sa-rules
fi
-## Schaal
-#curl --connect-timeout 15 --max-time 30 http://sa.schaal-it.net/$(dig txt 1.4.3.sa.schaal-it.net +short | tr -d '"').tar.gz --output /tmp/sa-rules-schaal.tar.gz
-#if gzip -t /tmp/sa-rules-schaal.tar.gz; then
-# tar xfvz /tmp/sa-rules-schaal.tar.gz -C /tmp/sa-rules-schaal
-# # Append, do not overwrite
-# cat /tmp/sa-rules-schaal/*cf >> /etc/rspamd/custom/sa-rules
-#fi
sed -i -e 's/\([^\\]\)\$\([^\/]\)/\1\\$\2/g' /etc/rspamd/custom/sa-rules
@@ -40,4 +31,3 @@
# Cleanup
rm -rf /tmp/sa-rules-heinlein /tmp/sa-rules-heinlein.tar.gz
-#rm -rf /tmp/sa-rules-schaal /tmp/sa-rules-schaal.tar.gz
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/supervisord.conf b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/supervisord.conf
index 2d91b55..a769864 100644
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/supervisord.conf
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/supervisord.conf
@@ -15,10 +15,6 @@
command=/usr/sbin/dovecot -F
autorestart=true
-[program:cron]
-command=/usr/sbin/cron -f
-autorestart=true
-
[eventlistener:processes]
command=/usr/local/sbin/stop-supervisor.sh
events=PROCESS_STATE_STOPPED, PROCESS_STATE_EXITED, PROCESS_STATE_FATAL
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng-redis_slave.conf b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng-redis_slave.conf
index 335cbfe..f690509 100644
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng-redis_slave.conf
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng-redis_slave.conf
@@ -27,7 +27,7 @@
host("`REDIS_SLAVEOF_IP`")
persist-name("redis2")
port(`REDIS_SLAVEOF_PORT`)
- command("PUBLISH" "F2B_CHANNEL" "$MESSAGE")
+ command("PUBLISH" "F2B_CHANNEL" "$(sanitize $MESSAGE)")
);
};
filter f_mail { facility(mail); };
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng.conf b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng.conf
index f0489ea..bdaca9c 100644
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng.conf
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/syslog-ng.conf
@@ -27,7 +27,7 @@
host("redis-mailcow")
persist-name("redis2")
port(6379)
- command("PUBLISH" "F2B_CHANNEL" "$MESSAGE")
+ command("PUBLISH" "F2B_CHANNEL" "$(sanitize $MESSAGE)")
);
};
filter f_mail { facility(mail); };
diff --git a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/trim_logs.sh b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/trim_logs.sh
index 2993a4c..9b0824e 100755
--- a/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/trim_logs.sh
+++ b/mailcow/src/mailcow-dockerized/data/Dockerfiles/dovecot/trim_logs.sh
@@ -14,12 +14,12 @@
else
REDIS_CMDLINE="redis-cli -h redis -p 6379"
fi
-catch_non_zero "${REDIS_CMDLINE} LTRIM ACME_LOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM POSTFIX_MAILLOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM DOVECOT_MAILLOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM SOGO_LOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM NETFILTER_LOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM AUTODISCOVER_LOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM API_LOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM RL_LOG 0 __LOG_LINES__"
-catch_non_zero "${REDIS_CMDLINE} LTRIM WATCHDOG_LOG 0 __LOG_LINES__"
+catch_non_zero "${REDIS_CMDLINE} LTRIM ACME_LOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM POSTFIX_MAILLOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM DOVECOT_MAILLOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM SOGO_LOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM NETFILTER_LOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM AUTODISCOVER_LOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM API_LOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM RL_LOG 0 ${LOG_LINES}"
+catch_non_zero "${REDIS_CMDLINE} LTRIM WATCHDOG_LOG 0 ${LOG_LINES}"