From 7b3dcc45fb82d959b755aab811173c85c157386b Mon Sep 17 00:00:00 2001 From: Nick Bebout Date: Mon, 20 May 2013 17:04:57 -0500 Subject: [PATCH] 1.542 --- CREDITS | 5 +- ChangeLog | 32 +- FAQ | 50 +- INSTALL | 73 +- Makefile | 9 +- README | 15 +- VERSION | 2 +- VERSION_EXE | 2 +- W/.BUILD_EXE_TIME | 4 + W/TIME | 1 + W/build_exe.bat | 10 +- W/paypal_reply/memo | 2 +- W/paypal_reply/paypal_bilan | 2 + W/paypal_reply/paypal_build_invoices | 15 +- W/paypal_return.shtml | 14 +- W/test2.bat | 6 +- .../LOG/log_user001_2_2013_04_24_11_16_12.txt | 1 + .../LOG/log_user002_2_2013_04_24_11_16_12.txt | 1 + .../LOG/log_user003_2_2013_04_24_11_16_12.txt | 1 + .../LOG/log_user004_2_2013_04_24_11_16_12.txt | 1 + .../LOG/log_user005_2_2013_04_24_11_16_12.txt | 1 + examples/archive_per_month | 6 +- examples/install_modules.bat | 30 + examples/sync_loop_windows.bat | 23 +- imapsync | 1245 +++-------------- index.shtml | 24 +- perlcritic.out | 20 + tests.sh | 52 +- 28 files changed, 503 insertions(+), 1144 deletions(-) create mode 100644 examples/LOG/log_user001_2_2013_04_24_11_16_12.txt create mode 100644 examples/LOG/log_user002_2_2013_04_24_11_16_12.txt create mode 100644 examples/LOG/log_user003_2_2013_04_24_11_16_12.txt create mode 100644 examples/LOG/log_user004_2_2013_04_24_11_16_12.txt create mode 100644 examples/LOG/log_user005_2_2013_04_24_11_16_12.txt create mode 100644 examples/install_modules.bat create mode 100644 perlcritic.out diff --git a/CREDITS b/CREDITS index 85a22b2..8931c9e 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.172 2013/01/29 09:31:00 gilles Exp gilles $ +# $Id: CREDITS,v 1.173 2013/05/06 08:16:53 gilles Exp gilles $ If you want to make a donation to the author, Gilles LAMIRAL, use any of the following ways: @@ -30,6 +30,9 @@ I thank very much all of these people. I thank also very much all people who bought imapsync from the homepage but I don't cite them here. +Eduardo Bortoluzzi Junior +Write the XOAUTH code and FAQ item. + Marc Weber Suggested --mark-as-deleted1 --mark-as-deleted2 diff --git a/ChangeLog b/ChangeLog index 0c7bcf8..673bd12 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,41 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.536 +head: 1.542 branch: locks: strict - gilles: 1.536 + gilles: 1.542 access list: symbolic names: keyword substitution: kv -total revisions: 536; selected revisions: 536 +total revisions: 542; selected revisions: 542 description: ---------------------------- -revision 1.536 locked by: gilles; +revision 1.542 locked by: gilles; +date: 2013/05/06 08:30:35; author: gilles; state: Exp; lines: +7 -7 +Syntax with "" fix. +---------------------------- +revision 1.541 +date: 2013/05/06 07:10:29; author: gilles; state: Exp; lines: +111 -74 +Started perlcritic corrections. Left 4 eval at level 5. +---------------------------- +revision 1.540 +date: 2013/04/22 11:05:51; author: gilles; state: Exp; lines: +11 -982 +Removed old 2.2.9 Mail::IMAPClient patch stuff. +---------------------------- +revision 1.539 +date: 2013/04/22 00:54:22; author: gilles; state: Exp; lines: +12 -12 +Fixed require namespace with uri_escape() calls. +---------------------------- +revision 1.538 +date: 2013/04/22 00:46:54; author: gilles; state: Exp; lines: +94 -9 +Added XOAUTH authentication. Thanks to Eduardo Bortoluzzi Junior. +---------------------------- +revision 1.537 +date: 2013/04/19 06:59:17; author: gilles; state: Exp; lines: +9 -9 +MDaemon 9.6.5, Surgemail 6.3d-72 +---------------------------- +revision 1.536 date: 2013/04/17 14:33:12; author: gilles; state: Exp; lines: +7 -7 Added --delete1 as an alias for --delete ---------------------------- diff --git a/FAQ b/FAQ index 37127af..4d1c044 100644 --- a/FAQ +++ b/FAQ @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ,v 1.130 2013/04/17 12:46:10 gilles Exp gilles $ +# $Id: FAQ,v 1.133 2013/05/06 08:17:13 gilles Exp gilles $ +------------------+ | FAQ for imapsync | @@ -359,16 +359,18 @@ Q. We have found that the sent time and date have been changed to the R. This is the case with: - Eudora - - Zimbra - Outlook 2003 - - Gmail - but not with + but not with - Mutt - Thunderbird + and no longer with + - Zimbra + - Gmail + Eurora shows by default the time the imap server received the email. I think it is quite a wrong behavior since the messages can have -travelled some time before the reception. +traveled some time before the reception. The sent time and date are given by the "Date:" header and it is set most of the time by the MUA (Mail User Agent, Mutt, Eudora, @@ -1448,7 +1450,6 @@ R. Gmail needs SSL ./imapsync \ --host1 imap.gmail.com \ --ssl1 \ - --authmech1 LOGIN \ --user1 gilles.lamiral@gmail.com \ --password1 gmailsecret \ --exitwhenover 2500000000 \ @@ -1470,6 +1471,43 @@ exceed maximum limit. See http://support.google.com/a/bin/answer.py?hl=en&answer=1071518 +======================================================================= +Q. How to use XOAUTH to globally authenticate gmail users? + The XOAUTH code and this FAQ item come from Eduardo Bortoluzzi + Thanks Eduardo! + +R. The goal of OAUTH is to migrate all users from/to Google Apps + Premier Edition without knowing their passwords. + + The global password is available at the Google Apps control panel, + at Advanced Tools -> Manage OAuth domain key. + +./imapsync \ + --host1 imap.gmail.com --ssl1 \ + --user1 foo@lab3.dedal.br \ + --password1 secret1 \ + --authmech1 XOAUTH \ + --host2 imap.gmail.com --ssl2 \ + --user2 bar@lab3.dedal.br \ + --password2 secret2 \ + --authmech2 XOAUTH + +Google Apps is a paid service, but you can try it for 30 days without any cost. + +Some notes about configuring the Google Apps XOAUTH: + + On "Advanced Tools > Manage OAuth domain key > Two-legged OAuth access control" + the "Allow access to all APIs" must be checked + (https://support.google.com/a/bin/answer.py?answer=162105) + + OR + + On "Advanced Tools > Manage third party OAuth client access", + the configured costumer key must have the scope + "https://mail.google.com/" configured + (https://support.google.com/a/bin/answer.py?answer=162106). + + ======================================================================= Q. migrate email from gmail to google apps diff --git a/INSTALL b/INSTALL index 712219f..ac9dee6 100644 --- a/INSTALL +++ b/INSTALL @@ -1,4 +1,4 @@ -# $Id: INSTALL,v 1.27 2013/04/17 12:35:18 gilles Exp gilles $ +# $Id: INSTALL,v 1.28 2013/05/14 08:19:08 gilles Exp gilles $ # # INSTALL file for imapsync # imapsync : IMAP sync or copy tool. @@ -30,16 +30,32 @@ WINDOWS a) Simplest way: - Buy imapsync.exe at http://imapsync.lamiral.info/ + - Run imapsync.exe in a command prompt (execute cmd.exe). +- Or simpler, look at the batch file at + http://imapsync.lamiral.info/examples/imapsync_example.bat + and replace the parameters with your values + then run the batch file with a double-click. + It is simpler to edit a batch file with notepad than + the command line in dos mode. + b) Hard way: - Get imapsync-x.xx.tgz - Install Perl if it isn't already installed. - Strawberry Perl is a good candidate -- Use PPM to install modules listed in the PREREQUISITES section. - PPM is Perl Package Manager. + Strawberry Perl is a very good candidate + http://strawberryperl.com/ +- Use the command CPAN to install modules listed in the PREREQUISITES section. + There is also a batch file that does this install for you + It is called install_modules.bat available at + http://imapsync.lamiral.info/examples/install_modules.bat + +c) How to build imapsync.exe? + +- Do the hard stuff in b) +- Run W/build_exe.bat (found in the tarball) PREREQUISITES ------------- @@ -118,36 +134,51 @@ Here is some individual module help: - Perl Time::HiRes perl -mTime::HiRes -e "" +- Perl Data::Uniqid + perl -mData::Uniqid -e "" + +- Perl URI::Escape + perl -mURI::Escape -e "" + + Test everything in one command: perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL \ - -mFile::Spec -mDigest::HMAC_MD5 -mAuthen::NTLM -e -mTime::HiRes '' + -mFile::Spec -mDigest::HMAC_MD5 -mAuthen::NTLM -e -mTime::HiRes \ + -mData::Uniqid -mURI::Escape "" You can install easily those Perl modules in latest release via the following commands (with root permissions) - perl -MCPAN -e 'install Mail::IMAPClient' - perl -MCPAN -e 'install Digest::MD5' - perl -MCPAN -e 'install Term::ReadKey' - perl -MCPAN -e 'install IO::Socket::SSL' - perl -MCPAN -e 'install File::Spec' - perl -MCPAN -e 'install Digest::HMAC_MD5' - perl -MCPAN -e 'install Authen::NTLM' - perl -MCPAN -e 'install Time::HiRes' + perl -MCPAN -e "install Mail::IMAPClient" + perl -MCPAN -e "install Digest::MD5" + perl -MCPAN -e "install Term::ReadKey" + perl -MCPAN -e "install IO::Socket::SSL" + perl -MCPAN -e "install File::Spec" + perl -MCPAN -e "install Digest::HMAC_MD5" + perl -MCPAN -e "install Authen::NTLM" + perl -MCPAN -e "install Time::HiRes" + perl -MCPAN -e "install Data::Uniqid" + perl -MCPAN -e "install URI::Escape" + You can install them easily too by using the standard install command on your system if the packages have been made on it (so you may not have the latest but most of the time it -doesn't care). +doesn't care). + +Modules Authen::NTLM, Data::Uniqid may be not available +this way since I haven't find them on Ubuntu. + Example on Debian/Ubuntu: - aptitude install libmail-imapclient-perl # Mail::IMAPClient' - aptitude install libdigest-md5-file-perl # Digest::MD5' - aptitude install libterm-readkey-perl # Term::ReadKey' - aptitude install libio-socket-ssl-perl # IO::Socket::SSL' - aptitude install libfile-spec-perl # File::Spec' - aptitude install libdigest-hmac-perl # Digest::HMAC_MD5' - aptitude install ? # (not free?) # Authen::NTLM + aptitude install libmail-imapclient-perl # Mail::IMAPClient + aptitude install libdigest-md5-file-perl # Digest::MD5 + aptitude install libterm-readkey-perl # Term::ReadKey + aptitude install libio-socket-ssl-perl # IO::Socket::SSL + aptitude install libfile-spec-perl # File::Spec + aptitude install libdigest-hmac-perl # Digest::HMAC_MD5 Digest::HMAC_SHA1 + INSTALLING on Unix ------------------ diff --git a/Makefile b/Makefile index e4cd3e8..71f86df 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.116 2013/04/18 01:24:25 gilles Exp gilles $ +# $Id: Makefile,v 1.118 2013/05/14 05:59:55 gilles Exp gilles $ .PHONY: help usage all @@ -13,6 +13,7 @@ usage: @echo "make test_quick # few tests verbosely" @echo "make tests_win32 # run tests on win32" @echo "make tests_win32_dev # run test2.bat on win32" + @echo "make prereq_win32 # run W/install_modules.bat on win32" @echo "make all " @echo "make upload_index" @echo "make upload_ks" @@ -20,6 +21,7 @@ usage: @echo "make imapsync_elf_x86.bin" @echo "make publish" + PREFIX ?= /usr DIST_NAME=imapsync-$(VERSION) DIST_FILE=$(DIST_NAME).tgz @@ -145,6 +147,9 @@ test_imapsync_exe: dosify_bat scp W/test_exe.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' time ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test_exe.bat' +prereq_win32: imapsync examples/install_modules.bat .dosify_bat + scp examples/install_modules.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' + time ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/install_modules.bat' imapsync.exe: imapsync W/build_exe.bat .dosify_bat rcsdiff imapsync @@ -257,7 +262,7 @@ ksa: rsync -avHz --delete -P \ . imapsync@ks.lamiral.info:public_html/imapsync/ -publish: upload_ks ksa ml +publish: ksa upload_ks ml PUBLIC_FILES = ./ChangeLog ./NOLIMIT ./LICENSE ./CREDITS ./FAQ \ ./index.shtml ./INSTALL \ diff --git a/README b/README index 8bd78e1..baab76d 100644 --- a/README +++ b/README @@ -4,7 +4,7 @@ NAME More than 52 different IMAP server softwares supported with success, few failures. - $Revision: 1.536 $ + $Revision: 1.542 $ SYNOPSIS To synchronize imap account "foo" on "imap.truc.org" to imap account @@ -191,6 +191,11 @@ SECURITY --proxyauth1 to enable administrative user to masquerade as another user. Can also be used on destination server with --proxyauth2 + You can authenticate with OAUTH when transfering from Google Apps. The + consumer key will be the domain part of the --user, and the --password + will be used as the consumer secret. It does not work with Google Apps + free edition. + EXIT STATUS imapsync will exit with a 0 status (return code) if everything went good. Otherwise, it exits with a non-zero status. @@ -351,8 +356,8 @@ IMAP SERVERS - Kerio 7.2.0 Patch 1 [host1] [host2] - Mail2World IMAP4 Server 2.5 [host1] (http://www.mail2world.com/) - MailEnable 4.23 [host1] [host2], 4.26 [host1][host2], 5 [host1] - - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), 12 [host2], - 12.0.3 [host1], 12.5.5 [host1], + - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), + 9.6.5 [host1], 12 [host2], 12.0.3 [host1], 12.5.5 [host1], - Mercury 4.1 (Windows server 2000 platform) - Microsoft Exchange Server 5.5, 6.0.6249.0[host1], 6.0.6487.0[host1], 6.5.7638.1 [host2], 6.5 [host1], Exchange 2007 SP1 (with Update Rollup 2), @@ -374,7 +379,7 @@ IMAP SERVERS - Softalk Workgroup Mail 7.6.4 [host1]. - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) - Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 - - Surgemail 3.6f5-5 + - Surgemail 3.6f5-5, 6.3d-72 [host2] - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) (http://www.washington.edu/imap/) @@ -458,5 +463,5 @@ SIMILAR SOFTWARES Feedback (good or bad) will often be welcome. - $Id: imapsync,v 1.536 2013/04/17 14:33:12 gilles Exp gilles $ + $Id: imapsync,v 1.542 2013/05/06 08:30:35 gilles Exp gilles $ diff --git a/VERSION b/VERSION index e84694e..972a4c1 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.536 +1.542 diff --git a/VERSION_EXE b/VERSION_EXE index e84694e..972a4c1 100644 --- a/VERSION_EXE +++ b/VERSION_EXE @@ -1 +1 @@ -1.536 +1.542 diff --git a/W/.BUILD_EXE_TIME b/W/.BUILD_EXE_TIME index d274a7c..08d4baa 100644 --- a/W/.BUILD_EXE_TIME +++ b/W/.BUILD_EXE_TIME @@ -184,3 +184,7 @@ 1366203902 END 1.535 : mercredi 17 avril 2013, 15:05:02 (UTC+0200) 1366209307 BEGIN 1.536 : mercredi 17 avril 2013, 16:35:07 (UTC+0200) 1366210370 END 1.536 : mercredi 17 avril 2013, 16:52:50 (UTC+0200) +1366591668 BEGIN 1.538 : lundi 22 avril 2013, 02:47:48 (UTC+0200) +1366592337 END 1.538 : lundi 22 avril 2013, 02:58:57 (UTC+0200) +1367829058 BEGIN 1.542 : lundi 6 mai 2013, 10:30:58 (UTC+0200) +1367829799 END 1.542 : lundi 6 mai 2013, 10:43:19 (UTC+0200) diff --git a/W/TIME b/W/TIME index 91aa126..843ea44 100644 --- a/W/TIME +++ b/W/TIME @@ -1,3 +1,4 @@ + 90 Added XOATH FAQ item, thanks to Eduardo, email feedback, amazon gift. 120 Fixed Scott issue, took long time (all messages list) even with --useuid --delete --nousecache --maxage 1 240 Fixed long names in invoices. + january invoices. 180 Release 1.476 --addheader diff --git a/W/build_exe.bat b/W/build_exe.bat index 5767941..dba1053 100644 --- a/W/build_exe.bat +++ b/W/build_exe.bat @@ -1,20 +1,20 @@ -REM $Id: build_exe.bat,v 1.11 2012/12/24 02:25:55 gilles Exp gilles $ +REM $Id: build_exe.bat,v 1.12 2013/05/06 08:16:26 gilles Exp gilles $ REM echo Building imapsync.exe cd C:\msys\1.0\home\Admin\imapsync perl -mMail::IMAPClient -mIO::Socket -mIO::Socket::SSL ^ - -mDigest::MD5 -mDigest::HMAC_MD5 ^ + -mDigest::MD5 -mDigest::HMAC_MD5 -mDigest::HMAC_SHA1 ^ -mTerm::ReadKey -mFile::Spec -mAuthen::NTLM ^ - -mTime::Local ^ + -mTime::Local -mURI::Escape -mData::Uniqid^ -e '' pp -o imapsync.exe --link libeay32_.dll --link libssl32_.dll ^ -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL ^ - -M Digest::MD5 -M Digest::HMAC_MD5 ^ + -M Digest::MD5 -M Digest::HMAC_MD5 -M Digest::HMAC_SHA1 ^ -M Term::ReadKey -M Authen::NTLM ^ - -M Time::Local ^ + -M Time::Local -M URI::Escape -M Data::Uniqid ^ imapsync echo Done building imapsync.exe diff --git a/W/paypal_reply/memo b/W/paypal_reply/memo index 21154f2..f64a5d3 100644 --- a/W/paypal_reply/memo +++ b/W/paypal_reply/memo @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: memo,v 1.13 2013/02/08 15:01:18 gilles Exp gilles $ +# $Id: memo,v 1.14 2013/04/29 08:15:35 gilles Exp gilles $ echo paypal_bilan_todo diff --git a/W/paypal_reply/paypal_bilan b/W/paypal_reply/paypal_bilan index 6ce373e..1cba7b7 100755 --- a/W/paypal_reply/paypal_bilan +++ b/W/paypal_reply/paypal_bilan @@ -367,6 +367,8 @@ sub tests_exportbnc { } + + sub tests { tests_next_invoice( ) ; #tests_half( ) ; diff --git a/W/paypal_reply/paypal_build_invoices b/W/paypal_reply/paypal_build_invoices index 876bac9..eba61c7 100755 --- a/W/paypal_reply/paypal_build_invoices +++ b/W/paypal_reply/paypal_build_invoices @@ -35,7 +35,8 @@ cp /home/gilles/public_html/AGIL/factures/000/facture_imapsync-000.tex /g/var/pa #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2224 /g/paypal/paypal_2012_12_complet.csv #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2299 /g/paypal/paypal_2013_01_complet.csv #/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2384 /g/paypal/paypal_2013_02_complet.csv -/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2451 /g/paypal/paypal_2013_03_complet.csv +#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2451 /g/paypal/paypal_2013_03_complet.csv +/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 2519 /g/paypal/paypal_2013_04_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 147 /g/paypal/paypal_2010_11_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 214 /g/paypal/paypal_2010_12_complet.csv @@ -65,8 +66,9 @@ cp /home/gilles/public_html/AGIL/factures/000/facture_imapsync-000.tex /g/var/pa : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2224 /g/paypal/paypal_2012_12_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2299 /g/paypal/paypal_2013_01_complet.csv : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2384 /g/paypal/paypal_2013_02_complet.csv -set -x : /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2451 /g/paypal/paypal_2013_03_complet.csv +set -x +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 2519 /g/paypal/paypal_2013_04_complet.csv set +x # La totale @@ -81,6 +83,15 @@ set -v /g/paypal/paypal_201?_??_complet.csv set +v +# 2012 +echo 2012 +set -v +: /g/public_html/imapsync/W/paypal_reply/paypal_bilan \ + --first_in 1335 --usdeur 1.2952 --bnc --avoid_numbers '292 293 643 644 731 732 1093 1330 1331 1332 1333 1334 1652 1653 2131 2132 2295 2296 2297 2298' \ + /g/paypal/paypal_2012_??_complet.csv +set +v + + echo 'sh paypal_build_invoices /g/var/paypal_invoices/2???' # USD de 147 à 340 diff --git a/W/paypal_return.shtml b/W/paypal_return.shtml index 1313ea7..1ee49ab 100644 --- a/W/paypal_return.shtml +++ b/W/paypal_return.shtml @@ -5,7 +5,7 @@ imapsync download - + @@ -39,7 +39,7 @@ border:0px;

The payment has been made and the transaction has been completed.
A receipt for your purchase has been emailed to you.
You may log into your account at www.paypal.com -to view details of this transaction. +to view details of this transaction (if you have a Paypal account).

You will find the latest imapsync.exe binary release
@@ -47,10 +47,12 @@ and the latest imapsync source code release /">download page.

-

You will receive an invoice soon.

+

You will receive an invoice soon, in a couple of weeks at worth. +Ask for it if you need it before.

-

Next imapsync releases will be available for one year without extra payment.
-You will be soon subscribed to the newsletter announcing new releases (and only this).

+

Next imapsync releases will be available for lifetime without extra payment.
+This current page will be updated to reflect the lastest release of imapsync.
+You will be soon subscribed to the newsletter announcing new releases (and only new releases).

To explain your specific needs, find best solutions for them, avoid loosing time,
and then succeed your migration quickly you can buy @@ -81,7 +83,7 @@ gilles.lamiral@laposte.net

This document last modified on
-($Id: paypal_return.shtml,v 1.13 2012/08/29 10:26:23 gilles Exp gilles $) +($Id: paypal_return.shtml,v 1.14 2013/04/18 13:53:25 gilles Exp gilles $)

diff --git a/W/test2.bat b/W/test2.bat index f1a7d90..f5c0533 100644 --- a/W/test2.bat +++ b/W/test2.bat @@ -1,5 +1,5 @@ -REM $Id: test2.bat,v 1.14 2012/12/24 02:25:34 gilles Exp gilles $ +REM $Id: test2.bat,v 1.15 2013/05/06 08:15:39 gilles Exp gilles $ REM cd C:\msys\1.0\home\Admin\imapsync @@ -45,6 +45,8 @@ REM imapsync.exe --host1 imap.gmail.com --port1 993 --ssl1 --host2 imap.bigs.dk REM @echo off +SET csvfile=file.txt + DATE /t TIME /t @@ -53,7 +55,7 @@ FOR /f "tokens=1-2 delims=-/: " %%a IN ('TIME /t') DO (SET mytime=%%a_%%b) ECHO %mydate%_%mytime% if not exist LOG mkdir LOG -FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO ECHO syncing to user %%I & imapsync ^ +FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (%csvfile%) DO ECHO syncing to user %%I & imapsync ^ --host1 imap.side1.org --user1 %%G --password1 %%H ^ --host2 imap.side2.org --user2 %%I --password2 %%J ^ > LOG\log_%%I_%mydate%_%mytime%.txt 2>&1 diff --git a/examples/LOG/log_user001_2_2013_04_24_11_16_12.txt b/examples/LOG/log_user001_2_2013_04_24_11_16_12.txt new file mode 100644 index 0000000..3061c23 --- /dev/null +++ b/examples/LOG/log_user001_2_2013_04_24_11_16_12.txt @@ -0,0 +1 @@ +/home/gilles/migration.sh: 15: imapsync: not found diff --git a/examples/LOG/log_user002_2_2013_04_24_11_16_12.txt b/examples/LOG/log_user002_2_2013_04_24_11_16_12.txt new file mode 100644 index 0000000..3061c23 --- /dev/null +++ b/examples/LOG/log_user002_2_2013_04_24_11_16_12.txt @@ -0,0 +1 @@ +/home/gilles/migration.sh: 15: imapsync: not found diff --git a/examples/LOG/log_user003_2_2013_04_24_11_16_12.txt b/examples/LOG/log_user003_2_2013_04_24_11_16_12.txt new file mode 100644 index 0000000..3061c23 --- /dev/null +++ b/examples/LOG/log_user003_2_2013_04_24_11_16_12.txt @@ -0,0 +1 @@ +/home/gilles/migration.sh: 15: imapsync: not found diff --git a/examples/LOG/log_user004_2_2013_04_24_11_16_12.txt b/examples/LOG/log_user004_2_2013_04_24_11_16_12.txt new file mode 100644 index 0000000..3061c23 --- /dev/null +++ b/examples/LOG/log_user004_2_2013_04_24_11_16_12.txt @@ -0,0 +1 @@ +/home/gilles/migration.sh: 15: imapsync: not found diff --git a/examples/LOG/log_user005_2_2013_04_24_11_16_12.txt b/examples/LOG/log_user005_2_2013_04_24_11_16_12.txt new file mode 100644 index 0000000..3061c23 --- /dev/null +++ b/examples/LOG/log_user005_2_2013_04_24_11_16_12.txt @@ -0,0 +1 @@ +/home/gilles/migration.sh: 15: imapsync: not found diff --git a/examples/archive_per_month b/examples/archive_per_month index 338efcf..04b94f5 100755 --- a/examples/archive_per_month +++ b/examples/archive_per_month @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: archive_per_month,v 1.5 2012/08/12 16:41:22 gilles Exp gilles $ +# $Id: archive_per_month,v 1.6 2013/04/18 15:08:18 gilles Exp gilles $ # Translate Jan to 01, Feb to 02 etc. month_number() { @@ -50,12 +50,12 @@ archive_year_month() { # -for year_archive in 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012; do +for year_archive in 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013; do for month_archive in "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"; do archive_year_month $year_archive $month_archive done done -# End of $Id: archive_per_month,v 1.5 2012/08/12 16:41:22 gilles Exp gilles $ +# End of $Id: archive_per_month,v 1.6 2013/04/18 15:08:18 gilles Exp gilles $ diff --git a/examples/install_modules.bat b/examples/install_modules.bat new file mode 100644 index 0000000..64b4518 --- /dev/null +++ b/examples/install_modules.bat @@ -0,0 +1,30 @@ + +REM $Id: install_modules.bat,v 1.2 2013/05/06 08:26:39 gilles Exp gilles $ +REM hi + +ECHO Installing Perl modules for imapsync +CD C:\msys\1.0\home\Admin\imapsync + +perl -mMail::IMAPClient -e "" +IF ERRORLEVEL 0 GOTO install_01 +perl -MCPAN -e "install Mail::IMAPClient" + +:install_01 + +FOR %%M in ( Mail::IMAPClient ^ + IO::Socket IO::Socket::SSL ^ + Digest::MD5 Digest::HMAC_MD5 ^ + Term::ReadKey File::Spec ^ + Time::HiRes ^ + Data::Uniqid URI::Escape ^ + Authen::NTLM ^ + Time::Local ^ + PAR::Packer ) DO ECHO Testing %%M ^ + & perl -m%%M -e "" || perl -MCPAN -e "install %%M" + + +ECHO Perl modules for imapsync installed + +PAUSE + + diff --git a/examples/sync_loop_windows.bat b/examples/sync_loop_windows.bat index 466bf68..006899f 100644 --- a/examples/sync_loop_windows.bat +++ b/examples/sync_loop_windows.bat @@ -1,5 +1,5 @@ REM -REM $Id: sync_loop_windows.bat,v 1.4 2012/12/23 08:02:34 gilles Exp gilles $ +REM $Id: sync_loop_windows.bat,v 1.5 2013/04/18 14:53:56 gilles Exp gilles $ REM REM imapsync massive sync example batch for Windows users REM lines beginning with REM are just comments @@ -9,10 +9,25 @@ REM in order to make it a batch command file that your system will recognize and REM REM Replace "imap.side1.org" and "imap.side2.org" with your own values REM +REM ==== Log file ==== REM This loop will also create a log file called log_%%I.txt for each account transfer REM where %%I is just a variable containing the user2 account name. REM and %mydate%_%mytime% is date and time formatted for a filename. -REM Since "date /t" is localy dependent you may have to adapt mydate=%%c_%%a_%%b_%%d +REM Since "date /t" is localy dependent you may have to adapt the +REM order of %%x variables (a b c d) in mydate=%%c_%%a_%%b_%%d +REM It is not important, just sugar to a useful listing of LOG directory + +REM ==== Parallel executions ==== +REM If you want to do parallel runs of imapsync then this current script is a good start. +REM Just copy it several times and replace, on each copy, the csvfile variable value. +REM Instead of SET csvfile=file.txt write for example +REM SET csvfile=file01.txt in the first copy +REM then also +REM SET csvfile=file02.txt in the second copy etc. +REM Of course you also have to split the data contained in file.txt +REM into file01.txt file02.txt etc. +REM After that, just double-clic on each batch file to launch each process + REM @echo off @@ -24,8 +39,10 @@ FOR /f "tokens=1-4 delims=-/: " %%a IN ('DATE /t') DO (SET mydate=%%c_%%a_%%b_%% FOR /f "tokens=1-2 delims=-/: " %%a IN ('TIME /t') DO (SET mytime=%%a_%%b) ECHO %mydate%_%mytime% +SET csvfile=file.txt + if not exist LOG mkdir LOG -FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO ECHO syncing to user %%I & imapsync ^ +FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (%csvfile%) DO ECHO syncing to user %%I & imapsync ^ --host1 imap.side1.org --user1 %%G --password1 %%H ^ --host2 imap.side2.org --user2 %%I --password2 %%J ^ > LOG\log_%%I_%mydate%_%mytime%.txt 2>&1 diff --git a/imapsync b/imapsync index edab73c..e80b13f 100755 --- a/imapsync +++ b/imapsync @@ -20,7 +20,7 @@ Synchronises mailboxes between two imap servers. Good at IMAP migration. More than 52 different IMAP server softwares supported with success, few failures. -$Revision: 1.536 $ +$Revision: 1.542 $ =head1 SYNOPSIS @@ -230,6 +230,11 @@ When working on Sun/iPlanet/Netscape IMAP servers you must use --proxyauth1 to enable administrative user to masquerade as another user. Can also be used on destination server with --proxyauth2 +You can authenticate with OAUTH when transfering from Google Apps. +The consumer key will be the domain part of the --user, and the +--password will be used as the consumer secret. It does not work +with Google Apps free edition. + =head1 EXIT STATUS imapsync will exit with a 0 status (return code) if everything went good. @@ -399,8 +404,8 @@ Success stories reported with the following 52 imap servers - Kerio 7.2.0 Patch 1 [host1] [host2] - Mail2World IMAP4 Server 2.5 [host1] (http://www.mail2world.com/) - MailEnable 4.23 [host1] [host2], 4.26 [host1][host2], 5 [host1] - - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), 12 [host2], - 12.0.3 [host1], 12.5.5 [host1], + - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), + 9.6.5 [host1], 12 [host2], 12.0.3 [host1], 12.5.5 [host1], - Mercury 4.1 (Windows server 2000 platform) - Microsoft Exchange Server 5.5, 6.0.6249.0[host1], 6.0.6487.0[host1], 6.5.7638.1 [host2], 6.5 [host1], Exchange 2007 SP1 (with Update Rollup 2), @@ -422,7 +427,7 @@ Success stories reported with the following 52 imap servers - Softalk Workgroup Mail 7.6.4 [host1]. - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) - Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 - - Surgemail 3.6f5-5 + - Surgemail 3.6f5-5, 6.3d-72 [host2] - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) (http://www.washington.edu/imap/) @@ -526,20 +531,21 @@ Entries for imapsync: Feedback (good or bad) will often be welcome. -$Id: imapsync,v 1.536 2013/04/17 14:33:12 gilles Exp gilles $ +$Id: imapsync,v 1.542 2013/05/06 08:30:35 gilles Exp gilles $ =cut # pragmas +use strict; use warnings; ++$|; -use strict; use Carp; use Getopt::Long; use Mail::IMAPClient; -use Digest::MD5 qw(md5_base64); +use Digest::MD5 qw( md5 md5_hex md5_base64 ); +use Digest::HMAC_SHA1 qw( hmac_sha1 ) ; #use Term::ReadKey; #use IO::Socket::SSL; use MIME::Base64; @@ -556,8 +562,7 @@ use IO::File; use Time::Local ; use Time::HiRes qw( time ) ; use Test::More 'no_plan'; - -eval { require 'usr/include/sysexits.ph' }; +#use Unix::Sysexits ; use constant { Unconnected => 0, @@ -657,7 +662,7 @@ my( # global variables initialisation -$rcs = '$Id: imapsync,v 1.536 2013/04/17 14:33:12 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.542 2013/05/06 08:30:35 gilles Exp gilles $ '; $total_bytes_transferred = 0; $total_bytes_skipped = 0; @@ -695,9 +700,10 @@ my %month_abrev = ( Dec => 11, ); -unless(defined(&_SYSEXITS_H)) { +unless( defined( &EX_USAGE ) ) { # 64 on my linux box. - eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE); + # See http://search.cpan.org/~jmates/Unix-Sysexits-0.02/lib/Unix/Sysexits.pm + eval { sub EX_USAGE { 64 ; } } ; } @@ -774,7 +780,7 @@ write_pidfile($pidfile) if ($pidfile); $modules_version and print "Modules version list:\n", modules_VERSION(), "\n"; check_lib_version() or - die "imapsync needs perl lib Mail::IMAPClient release 2.2.9, or 3.25 or superior \n"; + die "imapsync needs perl lib Mail::IMAPClient release 3.25 or superior \n"; exit_clean(0) if ($justbanner); @@ -1741,48 +1747,69 @@ sub keyval { sub check_lib_version { $debug and print "IMAPClient $Mail::IMAPClient::VERSION\n"; if ($Mail::IMAPClient::VERSION eq '2.2.9') { - override_imapclient(); - return(1); + print "imapsync no longer supports Mail::IMAPClient 2.2.9, upgrade it" ; + return( 0 ) ; } else{ # 3.x.x is no longer buggy with imapsync. - if ($allow3xx) { - return(1); - }else{ - return(0); - } + return( 1 ) ; } } +sub module_version_str { + my( $module, $version ) = @_ ; + my $str = sprintf( "%-20s %s\n", $module, $version ) ; + return( $str ) ; +} + sub modules_VERSION { my @list_version; - foreach my $module (qw( -Mail::IMAPClient -IO::Socket -IO::Socket::INET -IO::Socket::SSL -Digest::MD5 -Digest::HMAC_MD5 -Term::ReadKey -Authen::NTLM)) - { - my $v = "?"; - - if (eval "require $module") { - # module is here - $v = eval "\$${module}::VERSION"; - }else{ - # no module - $v = "?"; - } - #print ("$module ", $v, "\n"); - push (@list_version, sprintf("%-20s %s\n", $module, $v)); - } - return(@list_version); + my $v ; + eval { require Mail::IMAPClient; $v = $Mail::IMAPClient::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Mail::IMAPClient', $v ) ) ; + + eval { require IO::Socket; $v = $IO::Socket::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'IO::Socket', $v ) ) ; + + eval { require IO::Socket::INET; $v = $IO::Socket::INET::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'IO::Socket::INET', $v ) ) ; + + eval { require IO::Socket::SSL ; $v = $IO::Socket::SSL::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'IO::Socket::SSL ', $v ) ) ; + + eval { require Digest::MD5; $v = $Digest::MD5::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Digest::MD5', $v ) ) ; + + eval { require Digest::HMAC_MD5; $v = $Digest::HMAC_MD5::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Digest::HMAC_MD5', $v ) ) ; + + eval { require Digest::HMAC_SHA1; $v = $Digest::HMAC_SHA1::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Digest::HMAC_SHA1', $v ) ) ; + + eval { require Term::ReadKey; $v = $Term::ReadKey::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Term::ReadKey', $v ) ) ; + + eval { require Authen::NTLM; $v = $Authen::NTLM::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Authen::NTLM', $v ) ) ; + + eval { require File::Spec; $v = $File::Spec::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'File::Spec', $v ) ) ; + + eval { require Time::HiRes; $v = $Time::HiRes::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Time::HiRes', $v ) ) ; + + eval { require URI::Escape; $v = $URI::Escape::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'URI::Escape', $v ) ) ; + + eval { require Data::Uniqid; $v = $Data::Uniqid::VERSION } or $v = "?" ; + push ( @list_version, module_version_str( 'Data::Uniqid', $v ) ) ; + + return( @list_version ) ; } + # Construct a command line copy with passwords replaced by MASKED. sub command_line_nopassword { my @argv_copy = @_; @@ -1864,7 +1891,7 @@ sub myconnect { $@ = "$@"; carp "$@" unless defined wantarray; - return undef; + return ; } $sock->autoflush(1); @@ -2061,7 +2088,8 @@ sub login_imap { } else { $imap->Authmechanism( $authmech ) unless ( $authmech eq 'LOGIN' or $authmech eq 'PREAUTH' ) ; } - + + $imap->Authcallback(\&xoauth) if $authmech eq "XOAUTH"; $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; @@ -2100,7 +2128,7 @@ sub login_imap { } -sub plainauth() { +sub plainauth { my $code = shift; my $imap = shift; @@ -2109,6 +2137,77 @@ sub plainauth() { return encode_base64("$string", ""); } +# 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 = sprintf("https://mail.google.com/mail/b/%s/imap/", $imap->User); + my $URLparm = sprintf("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(/@/, $imap->User); + $debug and print "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) . "&"; + + # The parameters must be in dictionary order before signing + my $baseparms = ""; + foreach my $key (sort keys %hash) { + if(length($baseparms)>0) { + $baseparms .= "&"; + } + + $baseparms .= "$key=$hash{$key}"; + } + + $base .= URI::Escape::uri_escape($baseparms); + $debug and print "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) . "&"); + + # The parameters signed become a parameter and... + $hash { 'oauth_signature' } = URI::Escape::uri_escape(substr(encode_base64($digest),0,-1)); + + # ... we don't need the requestor_id anymore. + delete $hash{'xoauth_requestor_id'}; + + # Create the final authentication string + my $string = $method . " " . $URL . "?" . $URLparm ." "; + + # All the parameters must be sorted + $baseparms = ""; + foreach my $key (sort keys %hash) { + if(length($baseparms)>0) { + $baseparms .= ","; + } + + $baseparms .= "$key=\"$hash{$key}\""; + } + + $string .= $baseparms; + + $debug and print "XOAUTH: authentication string: $string\n"; + + # It must be base64 encoded + return encode_base64("$string", ""); +} sub server_banner { my $imap = shift; @@ -2122,8 +2221,8 @@ sub banner_imapsync { my @argv_copy = @_; my $banner_imapsync = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.536 $ ', - '$Date: 2013/04/17 14:33:12 $ ', + '$Revision: 1.542 $ ', + '$Date: 2013/05/06 08:30:35 $ ', "\n",localhost_info(), "\n", "Command line used:\n", "$0 ", command_line_nopassword(@argv_copy), "\n", @@ -2150,14 +2249,16 @@ sub write_pidfile { } if ( -e $pidfile ) { print "$pidfile already exists, overwriting it\n" ; - } - open( PIDFILE, ">$pidfile" ) or do { + } + my $PIDFILE ; + open( $PIDFILE, '>', $pidfile ) or do { print "Could not open $pidfile for writing" ; - return undef ; + return ; } ; - print PIDFILE $PROCESS_ID ; - close PIDFILE ; + print $PIDFILE $PROCESS_ID ; + close $PIDFILE ; + return( $PROCESS_ID ) ; } @@ -2438,7 +2539,7 @@ sub help_to_guess_prefix { . "the folowing listing of folders may help you to find it:\n" . folders_list_to_help($imap) . "Most of the time it is INBOX. or an empty string\n" - . "so try $prefix_opt INBOX. or $prefix_opt ''\n"; + . "so try $prefix_opt INBOX. or $prefix_opt" . '""' . "\n" ; return($help); } @@ -2543,6 +2644,25 @@ sub imap2_folder_name { return($h2_fold); } +sub tests_decompose_regex { + ok( 1, 'decompose_regex 1' ) ; + my( $left, $right ) ; + ok( 0 == compare_lists( [ '', '' ], [ decompose_regex( '' ) ] ), 'decompose_regex empty string' ) ; + ok( 0 == compare_lists( [ '.*', 'lala' ], [ decompose_regex( 's/.*/lala/' ) ] ), 'decompose_regex s/.*/lala/' ) ; + +} + +sub decompose_regex { + my $regex = shift ; + my( $left, $right ) ; + + ( $left, $right ) = $regex =~ m#^s/((?:[^/]|\\/)+)/((?:[^/]|\\/)+)/#; + return( '', '' ) if not $left ; + return( $left, $right ) ; +} + + + sub foldersizes { @@ -2882,7 +3002,7 @@ sub select_msgs { $debugdev and print "Done fetch_hash()\n" ; } - return undef if ( $#msgs_all == 0 && !defined( $msgs_all[0] ) ) ; + return if ( $#msgs_all == 0 && !defined( $msgs_all[0] ) ) ; if ( defined( $msgs_all_hash_ref ) ) { @{ $msgs_all_hash_ref }{ @msgs_all } = () ; @@ -4058,24 +4178,24 @@ sub parse_header_msg { sub firstline { # extract the first line of a file (without \n) - my($file) = @_; - my $line = ""; + my($file) = @_ ; + my $line = "" ; - open FILE, $file or die_clean("error [$file]: $! "); - chomp($line = ); - close FILE; - $line = ($line) ? $line: "error !EMPTY! [$file]"; - return $line; + open( my $FILE, '<', $file ) or die_clean( "error [$file]: $! " ) ; + chomp( $line = <$FILE> ) ; + close $FILE ; + $line = ( $line ) ? $line: "error !EMPTY! [$file]" ; + return $line ; } sub file_to_string { - my($file) = @_; - my @string; - open FILE, $file or die_clean("error [$file]: $! "); - @string = ; - close FILE; - return join("", @string); + my( $file ) = @_ ; + my @string ; + open( my $FILE, '<', $file ) or die_clean( "error [$file]: $! " ) ; + @string = <$FILE> ; + close $FILE ; + return join('', @string) ; } @@ -4102,7 +4222,7 @@ sub is_a_release_number { sub check_last_release { - my $public_release = not_long('imapsync_version_lfo'); + my $public_release = not_long_imapsync_version_public( ) ; #print "check_last_release: [$public_release]\n" ; return('unknown') if ($public_release eq 'unknown'); return('timeout') if ($public_release eq 'timeout'); @@ -4118,7 +4238,7 @@ sub check_last_release { } sub imapsync_version { - my $rcs = '$Id: imapsync,v 1.536 2013/04/17 14:33:12 gilles Exp gilles $ '; + my $rcs = '$Id: imapsync,v 1.542 2013/05/06 08:30:35 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; my $VERSION = ($1) ? $1: "UNKNOWN"; return($VERSION); @@ -4136,7 +4256,7 @@ sub imapsync_basename { } -sub imapsync_version_lfo { +sub imapsync_version_public { my $local_version = imapsync_version(); my $imapsync_basename = imapsync_basename(); @@ -4160,9 +4280,9 @@ sub imapsync_version_lfo { return($last_release); } -sub not_long { - #print "Entering not_long\n"; - my ($func) = @_; +sub not_long_imapsync_version_public { + #print "Entering not_long_imapsync_version_public\n"; + my $val; # Doesn't work with gethostbyname (see perlipc) @@ -4180,11 +4300,9 @@ sub not_long { eval { alarm(3); - #print $func, "\n"; { - no strict "refs"; - #print "Calling $func\n"; - $val = &$func(); + $val = imapsync_version_public( ) ; + #sleep 4; #print "End of $func\n"; } alarm(0); @@ -4955,7 +5073,7 @@ sub tests_debug { SKIP: { skip "No test in normal run" if ( not $tests_debug ); - tests_imap2_folder_name( ) ; + tests_decompose_regex( ) ; } } @@ -4999,975 +5117,8 @@ sub tests { } } -# IMAPClient 2.2.9 overrides -sub override_imapclient { -no warnings 'redefine'; -no strict 'subs'; - -use constant Unconnected => 0; -use constant Connected => 1; # connected; not logged in -use constant Authenticated => 2; # logged in; no mailbox selected -use constant Selected => 3; # mailbox selected -use constant INDEX => 0; # Array index for output line number -use constant TYPE => 1; # Array index for line type - # (either OUTPUT, INPUT, or LITERAL) -use constant DATA => 2; # Array index for output line data -use constant NonFolderArg => 1; # Value to pass to Massage to - # indicate non-folder argument - - -*Mail::IMAPClient::_transaction_literals = sub { - my $self = shift; - my $string = ""; - - foreach my $result (@{$self->{"History"}{$self->Transaction}}) { - $string .= $result->[DATA] - if defined($result) and $self->_is_literal($result) ; - } - return $string; -}; - -# Got from 3.25 -*Mail::IMAPClient::append_string = sub { - my $self = shift; - my $folder = $self->Massage(shift); - my ( $text, $flags, $date ) = @_; - defined $text or $text = ''; - - if ( defined $flags ) { - $flags =~ s/^\s+//g; - $flags =~ s/\s+$//g; - $flags = "($flags)" if $flags !~ /^\(.*\)$/; - } - - if ( defined $date ) { - $date =~ s/^\s+//g; - $date =~ s/\s+$//g; - $date = qq("$date") if $date !~ /^"/; - } - - $text =~ s/\r?\n/$CRLF/og; - - my $command = - "APPEND $folder " - . ( $flags ? "$flags " : "" ) - . ( $date ? "$date " : "" ) . "{" - . length($text) - . "}$CRLF"; - - $command .= $text . $CRLF; - $self->_imap_command( $command ) or return undef; - - my $data = join '', $self->Results; - #print "ZZZ|$data|ZZZ\n"; - # look for something like return size or self if no size found: - # OK [APPENDUID ] APPEND completed - # 18 OK [APPENDUID 1286144680 1539] APPEND Ok. - my $ret = $data =~ m#^\d+ OK \[APPEND.*\s+(\d+)\].*\Z#m ? $1 : $self; - - return $ret; -}; - - -*Mail::IMAPClient::fetch_hash = sub { - # taken from above *Mail::IMAPClient::fetch_hash - # if last arg is a ref then the fetch is done only - # on the messages listed as the keys of this hash. - # Init an "empty" $hash_ref by value can be done this way: - # @$hash_ref{2, 3, 4, 55} = (undef); - - my $self = shift; - my $hash_ref = ref($_[-1]) ? pop @_ : {}; - my @words = @_; - for (@words) { - s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i ; - s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i ; - } - - my $msgs_ref_all; - if (scalar %$hash_ref) { - $msgs_ref_all = [ sort { $a <=> $b } keys (%$hash_ref) ]; - #print "ZZZZ 1 [@$msgs_ref_all]\n"; - }else{ - $msgs_ref_all = scalar($self->messages); - #print "ZZZZ 2 [@$msgs_ref_all]\n"; - } - - my $split = $self->Split() || scalar(@$msgs_ref_all); - while(my @msgs = splice(@$msgs_ref_all, 0, $split)) { - #print "SPLIT: @msgs\n"; - my $msgs_ref = \@msgs; - my $output = scalar($self->fetch($msgs_ref,"(" . join(" ",@_) . ")")) - ; # unless grep(/\b(?:FAST|FULL)\b/i,@words); - my $x; - for ($x = 0; $x <= $#$output ; $x++) { - my $entry = {}; - my $l = $output->[$x]; - if ($self->Uid) { - my($uid) = $l =~ /\((?:.* )?UID (\d+).*\)/i; - next unless $uid; - if ( defined $hash_ref->{$uid} ) { - $entry = $hash_ref->{$uid} ; - } - else { - $hash_ref->{$uid} ||= $entry; - } - } - else { - my($mid) = $l =~ /^\* (\d+) FETCH/i; - next unless $mid; - if ( defined $hash_ref->{$mid} ) { - $entry = $hash_ref->{$mid} ; - } - else { - $hash_ref->{$mid} ||= $entry; - } - } - - foreach my $w (@words) { - if ( $l =~ /\Q$w\E\s*$/i ) { - $entry->{$w} = $output->[$x+1]; - $entry->{$w} =~ s/(?:\x0a?\x0d)+$//g; - chomp $entry->{$w}; - } - else { - $l =~ /\( # open paren followed by ... - (?:.*\s)? # ...optional stuff and a space - \Q$w\E\s # escaped fetch field - (?:" # then: a dbl-quote - (\\.| # then bslashed anychar(s) or ... - [^"]+) # ... nonquote char(s) - "| # then closing quote; or ... - \( # ...an open paren - (\\.| # then bslashed anychar or ... - [^\)]*) # ... non-close-paren char - \)| # then closing paren; or ... - (\S+)) # unquoted string - (?:\s.*)? # possibly followed by space-stuff - \) # close paren - /xi; - $entry->{$w}=defined($1)?$1:defined($2)?$2:$3; - } - } - } -} - return wantarray ? %$hash_ref : $hash_ref; -}; - - - -*Mail::IMAPClient::login = sub { - my $self = shift; - return $self->authenticate($self->Authmechanism,$self->Authcallback) - if $self->{Authmechanism}; - - my $id = $self->User; - my $has_quotes = $id =~ /^".*"$/ ? 1 : 0; - my $string = "Login " . ( $has_quotes ? $id : qq("$id") ) . - " " . $self->Password . "\r\n"; - $self->_imap_command($string) - and $self->State(Authenticated); - # $self->folders and $self->separator unless $self->NoAutoList; - unless ( $self->IsAuthenticated) { - my($carp) = $self->LastError; - $carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/; - carp $carp unless defined wantarray; - return undef; - }; - return $self; -}; - - -*Mail::IMAPClient::get_header = sub { - my($self , $msg, $header ) = @_; - my $val; - - #eval { $val = $self->parse_headers([$msg],$header)->{$header}[0] }; - my $h = $self->parse_headers([$msg],$header); - #require Data::Dumper; - #print Data::Dumper->Dump([$h]); - #$val = $self->parse_headers([$msg],$header)->{$header}[0]; - - $val = $h->{$msg}{$header}[0]; - return defined($val)? $val : undef; -}; - - -*Mail::IMAPClient::parse_headers = sub { - my($self,$msgspec_all,@fields) = @_; - my(%fieldmap) = map { ( lc($_),$_ ) } @fields; - my $msg; my $string; my $field; - #print ref($msgspec_all), "\n"; - #if(ref($msgspec_all) eq 'HASH') { - # print ref($msgspec_all), "\n"; - #$msgspec_all = [$msgspec_all]; - #} - - unless(ref($msgspec_all) eq 'ARRAY') { - print "parse_headers want an ARRAY ref\n"; - #exit 1; - return undef; - } - - my $headers = {}; # hash from message ids to header hash - my $split = $self->Split() || scalar(@$msgspec_all); - while(my @msgs = splice(@$msgspec_all, 0, $split)) { - #$debug and print "SPLIT: @msgs\n"; - my $msgspec = \@msgs; - - # Make $msg a comma separated list, of messages we want - $msg = $self->Range($msgspec); - - if ($fields[0] =~ /^[Aa][Ll]{2}$/ ) { - - $string = "$msg body" . - # use ".peek" if Peek parameter is a) defined and true, - # or b) undefined, but not if it's defined and untrue: - - ( defined($self->Peek) ? - ( $self->Peek ? ".peek" : "" ) : - ".peek" - ) . "[header]" ; - - }else { - $string = "$msg body" . - # use ".peek" if Peek parameter is a) defined and true, or - # b) undefined, but not if it's defined and untrue: - - ( defined($self->Peek) ? - ( $self->Peek ? ".peek" : "" ) : - ".peek" - ) . "[header.fields (" . join(" ",@fields) . ')]' ; - } - - my @raw=$self->fetch( $string ) or return undef; - - - my $h = 0; # reference to hash of current msgid, or 0 between msgs - - for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) { - - no warnings; - if ( $header =~ /^\*\s+\d+\s+FETCH\s+\(.*BODY\[HEADER(?:\]|\.FIELDS)/i) { - if ($self->Uid) { - if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) { - $h = {}; - $headers->{$msgid} = $h; - } - else { - $h = {}; - } - } - else { - if ( my($msgid) = $header =~ /^\*\s+(\d+)/ ) { - #start of new message header: - $h = {}; - $headers->{$msgid} = $h; - } - } - } - next if $header =~ /^\s+$/; - - # ( for vi - if ($header =~ /^\)/) { # end of this message - $h = 0; # set to be between messages - next; - } - # check for 'UID)' - # when parsing headers by UID. - if ($self->Uid and my($msgid) = $header =~ /^\s*UID\s+(\d+)\s*\)/) { - $headers->{$msgid} = $h; # store in results against this message - $h = 0; # set to be between messages - next; - } - - if ($h != 0) { # do we expect this to be a header? - my $hdr = $header; - chomp $hdr; - $hdr =~ s/\r$//; - #print "W[$hdr]", ref($hdr), "!\n"; - #next if ( ! defined($hdr)); - #print "X[$hdr]\n"; - - if (defined($hdr) and ($hdr =~ s/^(\S+):\s*//)) { - # if ($hdr =~ s/^(\S+):\s*//) { - #print "X1\n"; - $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; - push @{$h->{$field}} , $hdr ; - } elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) { - #print "X2\n"; - $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; - push @{$h->{$field}} , $hdr ; - } elsif ( ref($h->{$field}) eq 'ARRAY') { - #print "X3\n"; - - $hdr =~ s/^\s+/ /; - $h->{$field}[-1] .= $hdr ; - } - } - } - use warnings; -# my $candump = 0; -# if ($self->Debug) { -# eval { -# require Data::Dumper; -# Data::Dumper->import; -# }; -# $candump++ unless $@; -# } - - } - # if we asked for one message, just return its hash, - # otherwise, return hash of numbers => header hash - # if (ref($msgspec) eq 'ARRAY') { - - return $headers; - -}; - - -*Mail::IMAPClient::authenticate = sub { - - my $self = shift; - my $scheme = shift; - my $response = shift; - - $scheme ||= $self->Authmechanism; - $response ||= $self->Authcallback; - my $clear = $self->Clear; - - $self->Clear($clear) - if $self->Count >= $clear and $clear > 0; - - my $count = $self->Count($self->Count+1); - - - my $string = "$count AUTHENTICATE $scheme"; - - $self->_record($count,[ $self->_next_index($self->Transaction), - "INPUT", "$string\x0d\x0a"] ); - - my $feedback = $self->_send_line("$string"); - - unless ($feedback) { - $self->LastError("Error sending '$string' to IMAP: $!\n"); - return undef; - } - - my ($code, $output); - - until ($code) { - $output = $self->_read_line or return undef; - - foreach my $o (@$output) { - $self->_record($count,$o); # $o is a ref - ($code) = $o->[DATA] =~ /^\+(.*)$/ ; - if ($o->[DATA] =~ /^\*\s+BYE/) { - $self->State(Unconnected); - return undef ; - } - if ($o->[DATA]=~ /^\d+\s+(NO|BAD)/i) { - return undef ; - } - } - } - - if ('CRAM-MD5' eq $scheme && ! $response) { - if ($Mail::IMAPClient::_CRAM_MD5_ERR) { - $self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR); - carp $Mail::IMAPClient::_CRAM_MD5_ERR; - } - else { - $response = \&Mail::IMAPClient::_cram_md5; - } - } - - $feedback = $self->_send_line($response->($code, $self)); - - unless ($feedback) { - $self->LastError("Error sending append msg text to IMAP: $!\n"); - return undef; - } - - $code = ""; # clear code - until ($code) { - $output = $self->_read_line or return undef; - foreach my $o (@$output) { - $self->_record($count,$o); # $o is a ref - if ( ($code) = $o->[DATA] =~ /^\+ (.*)$/ ) { - $feedback = $self->_send_line($response->($code,$self)); - unless ($feedback) { - $self->LastError("Error sending append msg text to IMAP: $!\n"); - return undef; - } - $code = "" ; # Clear code; we're still not finished - } else { - $o->[DATA] =~ /^$count (OK|NO|BAD)/ and $code = $1; - if ($o->[DATA] =~ /^\*\s+BYE/) { - $self->State(Unconnected); - return undef ; - } - } - } - } - - $code =~ /^OK/ and $self->State(Authenticated) ; - return $code =~ /^OK/ ? $self : undef ; - -}; - - - -*Mail::IMAPClient::_cram_md5 = sub { - my ($code, $client) = @_; - my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($code), - $client->Password()); - return MIME::Base64::encode($client->User() . " $hmac", ""); -}; - -*Mail::IMAPClient::message_string = sub { - my $self = shift; - my $msg = shift; - my $expected_size = $self->size($msg); - return undef unless(defined $expected_size); # unable to get size - my $cmd = $self->has_capability('IMAP4REV1') ? - "BODY" . ( $self->Peek ? '.PEEK[]' : '[]' ) : - "RFC822" . ( $self->Peek ? '.PEEK' : '' ) ; - - #print "Message_string Beg fetch:\n", memory_consumption(); - $self->fetch($msg,$cmd) or return undef; - #print "Message_string End fetch:\n", memory_consumption(); - - my $string = ""; - - - foreach my $result (@{$self->{"History"}{$self->Transaction}}) { - $string .= $result->[DATA] - if defined($result) and $self->_is_literal($result) ; - } - #print "Message_string End string:\n", memory_consumption(); - - # BUG? should probably return undef if length != expected - # No bug, somme servers are buggy. - - if (! $self->Ignoresizeerrors ) { - if ( length($string) != $expected_size ) { - print "message_string: " . - "expected $expected_size bytes but received " . - length($string) . "\n"; - $self->LastError("message_string: expected ". - "$expected_size bytes but received " . - length($string)."\n"); - } - } - return $string; -}; - - - -{ -no warnings 'once'; - -*Mail::IMAPClient::Ssl = sub { - my $self = shift; - - if (@_) { $self->{SSL} = shift } - return $self->{SSL}; -}; - -*Mail::IMAPClient::Starttls = sub { - my $self = shift; - - if (@_) { $self->{Starttls} = shift } - return $self->{Starttls}; -}; - - - -*Mail::IMAPClient::exists = sub { - # Bad implementation STATUS fails and can close the connexion - # Exchange does this after 10 failures - my ( $self, $folder ) = @_; - $self->status($folder) ? $self : undef; -}; - - - -*Mail::IMAPClient::Authuser = sub { - my $self = shift; - - if (@_) { $self->{AUTHUSER} = shift } - return $self->{AUTHUSER}; -}; - - -*Mail::IMAPClient::Ignoresizeerrors = sub { - my $self = shift; - - if (@_) { $self->{IGNORESIZEERRORS} = shift } - return $self->{IGNORESIZEERRORS}; -}; - -*Mail::IMAPClient::Reconnectretry = sub { - my $self = shift; - - if (@_) { $self->{RECONNECTRETRY} = shift } - return $self->{RECONNECTRETRY}; -}; - - -*Mail::IMAPClient::reconnect = sub { - my $self = shift; - - if ( $self->IsAuthenticated ) { - $self->_debug("reconnect called but already authenticated"); - return $self; - } - - my $einfo = $self->LastError || ""; - $self->_debug( "reconnecting to ", $self->Server, ", last error: $einfo" ); - - # reconnect and select appropriate folder - $self->connect or return undef; - - return ( defined $self->Folder ) ? $self->select( $self->Folder ) : $self; -}; - - -# wrapper for _imap_command_do to enable retrying on lost connections -*Mail::IMAPClient::_imap_command = sub { - my $self = shift; - - my $tries = 0; - my $retry = $self->Reconnectretry || 0; - my ( $rc, @err ); - - #print "@_ Beg _imap_command:\n", memory_consumption(); - - # LastError (if set) will be overwritten masking any earlier errors - while ( $tries++ <= $retry ) { - # do command on the first try or if Connected (reconnect ongoing) - if ( $tries == 1 or $self->IsConnected ) { - #print "call @_\n"; - $rc = $self->_imap_command_do(@_); - push( @err, $self->LastError ) if $self->LastError; - #print "call @_ done [", $rc || '', "] [$tries/$retry][" . $self->IsUnconnected . "]\n"; - } - - if ( !defined($rc) - and $retry and $self->IsUnconnected - and ( $self->LastIMAPCommand !~ /LOGOUT/ ) - - ) { - print "\nWarning: disconnected. "; - if ( $self->reconnect ) { - print "Reconnect successful on try #$tries\n"; - $self->Reconnect_counter($self->Reconnect_counter() + 1); - } - else { - print "Reconnect failed on try #$tries\n"; - push( @err, $self->LastError ) if $self->LastError; - } - } - else { - last; - } - } - - unless ($rc) { - my ( %seen, @keep, @info ); - - foreach my $str (@err) { - my ( $sz, $len ) = ( 96, length($str) ); - $str =~ s/$CR?$LF$/\\n/omg; - if ( !$self->Debug and $len > $sz * 2 ) { - my $beg = substr( $str, 0, $sz ); - my $end = substr( $str, -$sz, $sz ); - $str = $beg . "..." . $end; - } - next if $seen{$str}++; - push( @keep, $str ); - } - foreach my $msg (@keep) { - push( @info, $msg . ( $seen{$msg} > 1 ? " ($seen{$msg}x)" : "" ) ); - } - $self->LastError( join( "; ", @info ) ); - } - #print "@_ End _imap_command:\n", memory_consumption(); - return $rc; -}; - - -*Mail::IMAPClient::_imap_command_do = sub { - - my $self = shift; - my $string = shift or return undef; - my $good = shift || 'GOOD'; - - my $qgood = quotemeta($good); - - my $clear = ""; - $clear = $self->Clear; - - $self->Clear($clear) - if $self->Count >= $clear and $clear > 0; - - my $count = $self->Count($self->Count+1); - - $string = "$count $string" ; - - #print "$string\n", memory_consumption(); - $self->_record($count,[ 0, "INPUT", "$string\x0d\x0a"] ); - #print "\n2 $count\n", memory_consumption(); - my $feedback = $self->_send_line("$string"); - - unless ($feedback) { - $self->LastError( "Error sending '$string' to IMAP: $!\n"); - $@ = "Error sending '$string' to IMAP: $!"; - carp "Error sending '$string' to IMAP: $!"; - return undef; - } - - my ($code, $output); - $output = ""; - - READ: until ( $code) { - # escape infinite loop if read_line never returns any data: - $output = $self->_read_line or return undef; - - for my $o (@$output) { - - $self->_record($count,$o); # $o is a ref - # $self->_debug("Received from readline: ${\($o->[DATA])}<>\n"); - next unless $self->_is_output($o); - if ( $good eq '+' ) { - $o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)|^($qgood)/mi ; - $code = $1||$2 ; - } else { - ($code) = $o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)/mi ; - } - if ($o->[DATA] =~ /^\*\s+BYE/im) { - $self->State(Unconnected); - return undef ; - } - } - } - #print "$string: returned $code\n", memory_consumption(); - # $self->_debug("Command $string: returned $code\n"); - return $code =~ /^OK|$qgood/im ? $self : undef ; - -}; - -# capability 2.2.9 is stupid: it caches and return first imap CAPABILITY call -# but call imap CAPABILITY each time. -# Copy/paste from 3.25 -*Mail::IMAPClient::capability = sub { - my $self = shift; - - if ( $self->{CAPABILITY} ) { - my @caps = keys %{ $self->{CAPABILITY} }; - return wantarray ? @caps : \@caps; - } - - $self->_imap_command('CAPABILITY') - or return undef; - - my @caps = map { split } grep s/^\*\s+CAPABILITY\s+//, $self->History; - foreach (@caps) { - $self->{CAPABILITY}{ uc $_ }++; - $self->{ uc $1 } = uc $2 if /(.*?)\=(.*)/; - } - - return wantarray ? @caps : \@caps; -}; - -*Mail::IMAPClient::_read_line = sub { - my $self = shift; - my $sh = $self->Socket; - my $literal_callback = shift; - my $output_callback = shift; - - unless ($self->IsConnected and $self->Socket) { - $self->LastError("NO Not connected.\n"); - carp "Not connected" if $^W; - return undef; - } - - my $iBuffer = ""; - my $oBuffer = []; - my $count = 0; - my $index = $self->_next_index($self->Transaction); - my $rvec = my $ready = my $errors = 0; - my $timeout = $self->Timeout; - - my $readlen = 1; - my $fast_io = $self->Fast_io; # Remember setting to reduce future method calls - - if ( $fast_io ) { - - # set fcntl if necessary: - exists $self->{_fcntl} or $self->Fast_io($fast_io); - $readlen = $self->{Buffer}||4096; - } - until ( - # there's stuff in output buffer: - scalar(@$oBuffer) and - - # the last thing there has cr-lf: - $oBuffer->[-1][DATA] =~ /\x0d\x0a$/ and - - # that thing is an output line: - $oBuffer->[-1][TYPE] eq "OUTPUT" and - - # and the input buffer has been MT'ed: - $iBuffer eq "" - - ) { - #print memory_consumption(); - my $transno = $self->Transaction; # used below in several places - if ($timeout) { - vec($rvec, fileno($self->Socket), 1) = 1; - my @ready = $self->{_select}->can_read($timeout) ; - unless ( @ready ) { - $self->LastError("Tag $transno: " . - "Timeout after $timeout seconds " . - "waiting for data from server\n"); - $self->_record($transno, - [ $self->_next_index($transno), - "ERROR", - "$transno * NO Timeout after ". - "$timeout seconds " . - "during read from " . - "server\x0d\x0a" - ] - ); - $self->LastError( - "Timeout after $timeout seconds " . - "during read from server\x0d\x0a" - ); - return undef; - } - } - - #local($^W) = undef; # Now quiet down warnings - - # read "$readlen" bytes (or less): - # need to check return code from $self->_sysread - # in case other end has shut down!!! - my $ret = $self->_sysread( $sh, \$iBuffer, $readlen, length($iBuffer)) ; - # $self->_debug("Read so far: $iBuffer<>\n"); - redo if(! defined($ret)) ; - if(($timeout and ! defined($ret))) { # Blocking read error... - my $msg = "Error while reading data from server: $!\x0d\x0a"; - $self->LastError('Error while reading data from server'); - $self->State(Unconnected); - print $msg; - $self->_record($transno, - [ $self->_next_index($transno), - "ERROR", "$transno * NO $msg " - ]); - $@ = "$msg"; - - return undef; - } - elsif(defined($ret) and $ret == 0) { # Caught EOF... - my $msg="Socket closed while reading data from server [$!]\x0d\x0a"; - print "$msg"; - $self->LastError('Socket closed while reading data from server'); - $self->State(Unconnected); - $self->_record($transno, - [ $self->_next_index($transno), - "ERROR", "$transno * NO $msg " - ]); - $@ = "$msg"; - return undef; - } - - # successfully wrote to other end, keep going... - $count += $ret; - LINES: while ( $iBuffer =~ s/^(.*?\x0d?\x0a)// ) { - my $current_line = $1; - #print memory_consumption(); - - # $self->_debug("BUFFER: pulled from buffer: ${current_line}\n" . - # "and left with buffer contents of: ${iBuffer}\n"); - - LITERAL: if ($current_line =~ s/\{(\d+)\}\x0d\x0a$//) { - # This part handles IMAP "Literals", - # which according to rfc2060 look something like this: - # [tag]|* BLAH BLAH {nnn}\r\n - # [nnn bytes of literally transmitted stuff] - # [part of line that follows literal data]\r\n - - # Set $len to be length of impending literal: - my $len = $1 ; - - $self->_debug("LITERAL: received literal in line ". - "$current_line of length $len; ". - "attempting to ". - "retrieve from the " . length($iBuffer) . - " bytes in: $iBuffer\n"); - - # Xfer up to $len bytes from front of $iBuffer to $litstring: - my $litstring = substr($iBuffer, 0, $len); - $iBuffer = substr($iBuffer, length($litstring), - length($iBuffer) - length($litstring) ) ; - - # Figure out what's left to read (i.e. what part of - # literal wasn't in buffer): - my $remainder_count = $len - length($litstring); - my $callback_value = ""; - - if ( defined($literal_callback) ) { - if ( $literal_callback =~ /GLOB/) { - print $literal_callback $litstring ; - $litstring = ""; - } elsif ($literal_callback =~ /CODE/ ) { - # Don't do a thing - - } else { - $self->LastError( - ref($literal_callback) . - " is an invalid callback type; " . - "must be a filehandle or coderef\n" - ); - } - - - } - if ($remainder_count > 0 and $timeout) { - # If we're doing timeouts then here we set up select - # and wait for data from the the IMAP socket. - vec($rvec, fileno($self->Socket), 1) = 1; - unless ( CORE::select( $ready = $rvec, - undef, - $errors = $rvec, - $timeout) - ) { - # Select failed; that means bad news. - # Better tell someone. - $self->LastError("Tag " . $transno . - ": Timeout waiting for literal data " . - "from server\n"); - carp "Tag " . $transno . - ": Timeout waiting for literal data " . - "from server\n" - if $self->Debug or $^W; - return undef; - } - } - - fcntl($sh, F_SETFL, $self->{_fcntl}) - if $fast_io and defined($self->{_fcntl}); - while ( $remainder_count > 0 ) { # As long as not done, - $self->_debug("Still need $remainder_count to " . - "complete literal string\n"); - my $ret = $self->_sysread( # bytes read - $sh, # IMAP handle - \$litstring, # place to read into - $remainder_count, # bytes left to read - length($litstring) # offset to read into - ) ; - $self->_debug("Received ret=$ret and buffer = " . - "\n$litstring\nwhile processing LITERAL\n"); - if ( $timeout and !defined($ret)) { # possible timeout - $self->_record($transno, [ - $self->_next_index($transno), - "ERROR", - "$transno * NO Error reading data " . - "from server: $!\n" - ] - ); - return undef; - } elsif ( $ret == 0 and eof($sh) ) { - $self->_record($transno, [ - $self->_next_index($transno), - "ERROR", - "$transno * ". - "BYE Server unexpectedly " . - "closed connection: $!\n" - ] - ); - $self->State(Unconnected); - return undef; - } - # decrement remaining bytes by amt read: - $remainder_count -= $ret; - - if ( length($litstring) > $len ) { - # copy the extra struff into the iBuffer: - $iBuffer = substr( - $litstring, - $len, - length($litstring) - $len - ); - $litstring = substr($litstring, 0, $len) ; - } - - if ( defined($literal_callback) ) { - if ( $literal_callback =~ /GLOB/ ) { - print $literal_callback $litstring; - $litstring = ""; - } - } - - } - $literal_callback->($litstring) - if defined($litstring) and - defined($literal_callback) and $literal_callback =~ /CODE/; - - $self->Fast_io($fast_io) if $fast_io; - - # Now let's make sure there are no IMAP server output lines - # (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string - # (There shouldn't be but I've seen it done!), but only if - # EnableServerResponseInLiteral is set to true - - my $embedded_output = 0; - my $lastline = ( split(/\x0d?\x0a/,$litstring))[-1] - if $litstring; - - if ( $self->EnableServerResponseInLiteral and - $lastline and - $lastline =~ /^(?:\*|(\d+))\s(BAD|NO|OK)/i - ) { - $litstring =~ s/\Q$lastline\E\x0d?\x0a//; - $embedded_output++; - - $self->_debug("Got server output mixed in " . - "with literal: $lastline\n" - ) if $self->Debug; - - } - # Finally, we need to stuff the literal onto the - # end of the oBuffer: - push @$oBuffer, [ $index++, "OUTPUT" , $current_line], - [ $index++, "LITERAL", $litstring ]; - push @$oBuffer, [ $index++, "OUTPUT", $lastline ] - if $embedded_output; - - } else { - push @$oBuffer, [ $index++, "OUTPUT" , $current_line ]; - } - - } - #$self->_debug("iBuffer is now: $iBuffer<>\n"); - } - # _debug $self, "Buffer is now $buffer\n"; - _debug $self, "Read: " . join("",map {$_->[DATA]} @$oBuffer) ."\n" - if $self->Debug; - return scalar(@$oBuffer) ? $oBuffer : undef ; -}; - - - -} - -# End of sub override_imapclient (yes, very bad indentation) -} - -# IMAPClient 2.2.9 3.xx ads +# IMAPClient 3.xx ads package Mail::IMAPClient; diff --git a/index.shtml b/index.shtml index 6a8d627..2727e8b 100644 --- a/index.shtml +++ b/index.shtml @@ -5,7 +5,7 @@ Imapsync: an IMAP migration and backup tool ( release <!--#exec cmd="cat ./VERSION"--> ) - + @@ -128,9 +128,20 @@ total is 93 millions for 2011, 91 millions for 2012.
  • Bug fix:
  • Bug fix:
  • Bug fix:
    • +
  • Refactoring:
    • +
  • Refactoring:
    • +
  • Refactoring:
    • +
  • Refactoring:
    • --> +
      +
    • 1.542
      • +
    • Enhancement: Added XOAUTH authentication. Thanks to Eduardo Bortoluzzi Junior.
      • +
    • Refactoring: Removed old 2.2.9 Mail::IMAPClient patch stuff.
      • +
    • Refactoring: Started perlcritic corrections. Left 4 eval at level 5.
      • +
    +
    • 1.536
    • Enhancement: Added --search1 and --search2 to allow different searches on each host.
      • @@ -629,7 +640,8 @@ I like it.
    • Mail2World IMAP4 Server 2.5 [host1] (http://www.mail2world.com/)
    • MailEnable 4.23 [host1][host2], 4.26 [host1][host2], 5 [host1] (http://www.mailenable.com/)
      • -
    • MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), 12 [host2], 12.0.3 [host1], 12.5.5 [host1] +
    • MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), 9.6.5 [host1], + 12 [host2], 12.0.3 [host1], 12.5.5 [host1] (http://www.altn.com/)
    • Mercury 4.1 (Windows server 2000 platform) (http://www.pmail.com/)
    • Microsoft Exchange Server 5.5, 6.0.6249.0[host1], 6.0.6487.0[host1], @@ -655,10 +667,10 @@ I like it.
    • Softalk Workgroup Mail 7.6.4 [host1] (http://www.softalkltd.com/products/download_wm_v7.asp).
    • SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) (http://www.oracle.com/)
    • Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 (http://www.oracle.com/)
      • -
    • Surgemail 3.6f5-5 (http://netwinsite.com/surgemail/)
      • +
    • Surgemail 3.6f5-5, 6.3d-72 [host2] (http://netwinsite.com/surgemail/)
    • UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 - (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) - (http://www.washington.edu/imap/)
      • + (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) + (http://www.washington.edu/imap/)
    • VMS, Imap part of TCP/IP suite of VMS 7.3.2 (http://h71000.www7.hp.com/openvms/)
    • Yahoo [host1] (http://www.yahoo.com/)
    • Zarafa 6,40,0,20653 [host1] (http://www.zarafa.com/)
      • @@ -731,7 +743,7 @@ alt="Viewable With Any Browser" /> This document last modified on -($Id: index.shtml,v 1.160 2013/04/17 17:20:01 gilles Exp gilles $) +($Id: index.shtml,v 1.162 2013/05/14 07:46:14 gilles Exp gilles $)

      diff --git a/perlcritic.out b/perlcritic.out new file mode 100644 index 0000000..daeab63 --- /dev/null +++ b/perlcritic.out @@ -0,0 +1,20 @@ +Expression form of "eval" at line 705, column 2. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 1781, column 7. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 1783, column 9. See page 161 of PBP. (Severity: 5) +"return" statement with explicit "undef" at line 1875, column 3. See page 199 of PBP. (Severity: 5) +Subroutine prototypes used at line 2112, column 1. See page 194 of PBP. (Severity: 5) +Subroutine prototypes used at line 2122, column 1. See page 194 of PBP. (Severity: 5) +Bareword file handle opened at line 2234, column 2. See pages 202,204 of PBP. (Severity: 5) +Two-argument "open" used at line 2234, column 2. See page 207 of PBP. (Severity: 5) +"return" statement with explicit "undef" at line 2236, column 3. See page 199 of PBP. (Severity: 5) +Expression form of "eval" at line 2619, column 3. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 2813, column 3. See page 161 of PBP. (Severity: 5) +"return" statement with explicit "undef" at line 2965, column 17. See page 199 of PBP. (Severity: 5) +Expression form of "eval" at line 3788, column 3. See page 161 of PBP. (Severity: 5) +Bareword file handle opened at line 4144, column 9. See pages 202,204 of PBP. (Severity: 5) +Two-argument "open" used at line 4144, column 9. See page 207 of PBP. (Severity: 5) +Bareword file handle opened at line 4155, column 2. See pages 202,204 of PBP. (Severity: 5) +Two-argument "open" used at line 4155, column 2. See page 207 of PBP. (Severity: 5) +Stricture disabled at line 4265, column 4. See page 429 of PBP. (Severity: 5) +Expression form of "eval" at line 4828, column 43. See page 161 of PBP. (Severity: 5) +Expression form of "eval" at line 4832, column 45. See page 161 of PBP. (Severity: 5) diff --git a/tests.sh b/tests.sh index 0915149..4a19725 100644 --- a/tests.sh +++ b/tests.sh @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: tests.sh,v 1.214 2013/04/17 12:49:41 gilles Exp gilles $ +# $Id: tests.sh,v 1.218 2013/05/06 08:36:38 gilles Exp gilles $ # Example 1: # CMD_PERL='perl -I./Mail-IMAPClient-3.32/lib' sh -x tests.sh @@ -55,7 +55,6 @@ run_test() { run_tests() { for t in "$@"; do - test X"$t" = X2 && CMD_PERL=$CMD_PERL_2xx && continue test X"$t" = X3 && CMD_PERL=$CMD_PERL_3xx && continue test_count=`expr 1 + $test_count` run_test "$t" @@ -155,7 +154,7 @@ first_sync_dry() { --passfile1 ../../var/pass/secret.toto \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --noauthmd5 --dry + --dry } first_sync() { @@ -163,8 +162,7 @@ first_sync() { --host1 $HOST1 --user1 toto \ --passfile1 ../../var/pass/secret.toto \ --host2 $HOST2 --user2 titi \ - --passfile2 ../../var/pass/secret.titi \ - --noauthmd5 + --passfile2 ../../var/pass/secret.titi } @@ -606,25 +604,14 @@ ll_prefix12() { ll_nosyncinternaldates() { - can_send && sendtestmessage toto - $CMD_PERL_2xx ./imapsync \ - --host1 $HOST1 --user1 toto \ - --passfile1 ../../var/pass/secret.toto \ - --host2 $HOST2 --user2 titi \ - --passfile2 ../../var/pass/secret.titi \ - --folder INBOX --noauthmd5 \ - --nosyncinternaldates --delete2 --expunge2 - #--debugimap2 - can_send && sendtestmessage toto $CMD_PERL_3xx ./imapsync \ --host1 $HOST1 --user1 toto \ --passfile1 ../../var/pass/secret.toto \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --folder INBOX --noauthmd5 \ + --folder INBOX \ --nosyncinternaldates --delete2 --expunge2 - #--debugimap2 } # bug: # $d=""; # no bug with $d=undef @@ -1187,7 +1174,7 @@ ll_regextrans2() --justfolders \ --nofoldersizes \ --regextrans2 's/yop/yoX/' \ - --folder 'INBOX.yop.yap' + --folder 'INBOX.yop.yap' --debug } ll_regextrans2_downcase() @@ -1637,9 +1624,7 @@ ll_tls_justlogin() { ll_tls_devel() { - CMD_PERL=$CMD_PERL_2xx ll_justlogin ll_ssl_justlogin \ -&& CMD_PERL=$CMD_PERL_3xx ll_justlogin ll_ssl_justlogin \ -&& CMD_PERL=$CMD_PERL_2xx ll_tls_justconnect ll_tls_justlogin \ + CMD_PERL=$CMD_PERL_3xx ll_justlogin ll_ssl_justlogin \ && CMD_PERL=$CMD_PERL_3xx ll_tls_justconnect ll_tls_justlogin } @@ -1705,9 +1690,21 @@ ll_authmech_PLAIN() { --passfile2 ../../var/pass/secret.titi \ --justfoldersizes --nofoldersizes \ --authmech1 PLAIN --authmech2 PLAIN - } + +ll_authmech_XOAUTH_gmail() { + ! ping -c1 imap.gmail.com || $CMD_PERL ./imapsync \ + --host1 imap.gmail.com --ssl1 --user1 imapsync@lab3.dedalusprime.com.br \ + --passfile1 ../../var/pass/secret.xoauth \ + --host2 imap.gmail.com --ssl2 --user2 imapsync@lab3.dedalusprime.com.br \ + --passfile2 ../../var/pass/secret.xoauth \ + --justfoldersizes --nofoldersizes \ + --authmech1 XOAUTH --authmech2 XOAUTH +} + + + ll_authmech_NTLM() { $CMD_PERL -I./W/NTLM-1.09/blib/lib ./imapsync \ --host1 mail.freshgrillfoods.com --user1 ktraster \ @@ -2325,7 +2322,7 @@ allow3xx() { } noallow3xx() { - ! $CMD_PERL_3xx ./imapsync \ + $CMD_PERL_3xx ./imapsync \ --host1 $HOST1 --user1 tata \ --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ @@ -2356,7 +2353,7 @@ dkimap_1() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --folder INBOX/dkimap --regextrans2 's/INBOX.INBOX./INBOX./' \ - --noauthmd5 --foldersize --nouid1 + --foldersize --nouid1 } ll_justlogin() { @@ -2365,7 +2362,7 @@ ll_justlogin() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --justlogin --noauthmd5 + --justlogin } ll_justlogin_backslash_char() { @@ -2376,7 +2373,7 @@ ll_justlogin_backslash_char() { --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 tptp@est.belle \ --passfile2 ../../var/pass/secret.tptp \ - --justlogin --noauthmd5 + --justlogin } ll_justlogin_dollar_char() { @@ -3109,7 +3106,6 @@ dprof_justfoldersizes() --passfile1 ../../var/pass/secret.gilles_mbox \ --host2 $HOST2 --user2 tete@est.belle \ --passfile2 ../../var/pass/secret.tete \ - --noauthmd5 \ --justfoldersizes --folder INBOX.Junk || \ true } @@ -3129,7 +3125,6 @@ dprof_bigfolder() --passfile1 ../../var/pass/secret.gilles_mbox \ --host2 $HOST2 --user2 tete@est.belle \ --passfile2 ../../var/pass/secret.tete \ - --noauthmd5 \ --nofoldersizes --folder INBOX.15_imapsync.imapsync-list || \ true } @@ -3236,6 +3231,7 @@ ll_tls_justconnect ll_tls_justlogin ll_tls ll_authmech_PLAIN +ll_authmech_XOAUTH_gmail ll_authmech_LOGIN ll_authmech_CRAMMD5 ll_authuser