diff --git a/CREDITS b/CREDITS index 1acafef..a59cece 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.150 2010/10/24 23:54:09 gilles Exp gilles $ +# $Id: CREDITS,v 1.154 2011/01/18 01:52:25 gilles Exp gilles $ If you want to make a donation to the author, Gilles LAMIRAL, use any of the following ways: @@ -13,7 +13,7 @@ b) If you can read french, please use the following wishlist : (books will be send with free postal cost) c) its paypal account : gilles.lamiral@laposte.net -http://www.linux-france.org/prj/imapsync/paypal.html +http://www.linux-france.org/prj/imapsync/paypal.shtml d) If you prefer making your donation with cash or cheque then my postal address is: @@ -27,6 +27,33 @@ Here are the persons who helped me to develop and maintain imapsync. Feel free to tell me if a name is missing or if you want to remove one. 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. + +Daniel Melnechuk +Contributed by giving the book +10.02 "The Design of Everyday Things" + +Pratch Pakpinpetch +Contributed by giving the book +17.95 "Life and How to Survive It" + +Edward Helvund +Contributed by giving the book +9.84 "Satan, Cantor and Infinity: Mind-Boggling Puzzles" + +Andrea Provaglio +Contributed by giving the book +24.95 "Salsa, Further Adventures In Afro Cuban Music For Piano" + +Eric Busalacchi +Contributed by giving money 84 USD + +Jorge López Pérez +Gave patch proxyauth-v2_1.366.patch + +Jeffrey Allison +Contributed by giving money 30 USD Roger Schmid Contributed by giving money 100 USD @@ -946,7 +973,13 @@ Eric Yung Total amount of book prices : c \ -29.95 +10.02+\ +\ +17.95+\ +9.84+\ +\ +24.95+\ +29.95+\ \ 11.20+\ 24.95+\ @@ -1058,4 +1091,4 @@ c \ 31.20+\ 40.00 = -2618.10 +2710.81 diff --git a/ChangeLog b/ChangeLog index b2e7178..925f1dc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,155 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.366 +head: 1.398 branch: locks: strict - gilles: 1.366 + gilles: 1.398 access list: symbolic names: keyword substitution: kv -total revisions: 366; selected revisions: 366 +total revisions: 398; selected revisions: 398 description: ---------------------------- -revision 1.366 locked by: gilles; +revision 1.398 locked by: gilles; +date: 2011/01/18 03:03:24; author: gilles; state: Exp; lines: +7 -6 +Fix. Removed too much about buffersize. +---------------------------- +revision 1.397 +date: 2011/01/18 02:39:12; author: gilles; state: Exp; lines: +25 -19 +Changed --delete2foldersnot option name to --delete2foldersbutnot +---------------------------- +revision 1.396 +date: 2011/01/18 02:03:49; author: gilles; state: Exp; lines: +23 -11 +Added --authmd51 and --authmd52 options to allow CRAM-MD5 authentication per host. +---------------------------- +revision 1.395 +date: 2011/01/15 04:57:28; author: gilles; state: Exp; lines: +8 -8 +--debugimap* implies --debug now. +---------------------------- +revision 1.394 +date: 2011/01/15 04:46:16; author: gilles; state: Exp; lines: +21 -11 +Added info about biggest messages. +---------------------------- +revision 1.393 +date: 2011/01/15 03:40:43; author: gilles; state: Exp; lines: +7 -7 +*** empty log message *** +---------------------------- +revision 1.392 +date: 2011/01/15 03:29:37; author: gilles; state: Exp; lines: +17 -8 +Added --delete2foldersnot option: do not delete folders matching regex. +---------------------------- +revision 1.391 +date: 2011/01/10 23:11:49; author: gilles; state: Exp; lines: +7 -7 +*** empty log message *** +---------------------------- +revision 1.390 +date: 2011/01/10 05:47:43; author: gilles; state: Exp; lines: +403 -94 +Added --usecache option. Goal: speed up the synchronisation. +---------------------------- +revision 1.389 +date: 2011/01/06 04:28:58; author: gilles; state: Exp; lines: +7 -6 +Mirapoint host1 success +---------------------------- +revision 1.388 +date: 2010/12/29 22:46:08; author: gilles; state: Exp; lines: +44 -10 +Added help to guess separator and prefix when NAMESPACE is not available. +---------------------------- +revision 1.387 +date: 2010/12/22 02:27:39; author: gilles; state: Exp; lines: +13 -8 +Added option --delete2foldersonly : delete only folders matching regex. +---------------------------- +revision 1.386 +date: 2010/12/09 22:34:25; author: gilles; state: Exp; lines: +7 -7 +hMailServer 4.4.1 +---------------------------- +revision 1.385 +date: 2010/12/03 23:40:12; author: gilles; state: Exp; lines: +34 -25 +Changed default behaviour: now --delete implies --expunge +It is safer with multiples runs. +---------------------------- +revision 1.384 +date: 2010/12/02 01:07:48; author: gilles; state: Exp; lines: +48 -34 +Code cleanup. +Wrote create_folder() +Wrote select_folder() +Simplified folder loop (a beginning) +---------------------------- +revision 1.383 +date: 2010/11/28 04:28:52; author: gilles; state: Exp; lines: +14 -12 +Allow size mismatch by default. +Use --useheader 'Message-Id' by default. +Use --noauthmd5 by default. +Why? Because users don't have to spend time or mine reading or not +reading the documentation, spend time turning on options to success. +or speed. +---------------------------- +revision 1.382 +date: 2010/11/19 21:31:35; author: gilles; state: Exp; lines: +23 -12 +Added a way to handle no headers in messages: take first 2Ko body. +---------------------------- +revision 1.381 +date: 2010/11/19 20:48:27; author: gilles; state: Exp; lines: +7 -7 +Fixed 'ps' call for Solaris. +---------------------------- +revision 1.380 +date: 2010/11/19 20:44:25; author: gilles; state: Exp; lines: +12 -11 +updated success list. +---------------------------- +revision 1.379 +date: 2010/11/12 00:44:02; author: gilles; state: Exp; lines: +7 -7 +dkimap is now a success story! +---------------------------- +revision 1.378 +date: 2010/11/12 00:22:59; author: gilles; state: Exp; lines: +19 -11 +Added --nouid1 --nouid2 options to support dkimap and other imap server without uid capability. +---------------------------- +revision 1.377 +date: 2010/11/09 02:12:40; author: gilles; state: Exp; lines: +8 -7 +Added Authen::NTLM in modules_VERSION() +---------------------------- +revision 1.376 +date: 2010/11/09 01:14:33; author: gilles; state: Exp; lines: +17 -10 +Added --domain1 --domain2 options for NTLM authentication. +---------------------------- +revision 1.375 +date: 2010/11/07 23:26:01; author: gilles; state: Exp; lines: +12 -15 +Adapted documentation to new distribution rule. +---------------------------- +revision 1.374 +date: 2010/11/07 18:31:06; author: gilles; state: Exp; lines: +10 -7 +imapsync is no longer gratis on the homepage. +---------------------------- +revision 1.373 +date: 2010/11/07 18:23:13; author: gilles; state: Exp; lines: +7 -7 + Smarter Mail 5.5 +---------------------------- +revision 1.372 +date: 2010/11/03 00:10:29; author: gilles; state: Exp; lines: +9 -8 +No thanks for *.bin and *.exe +---------------------------- +revision 1.371 +date: 2010/11/02 07:37:35; author: gilles; state: Exp; lines: +9 -7 +hMailServer 5.3.3 [host2] success +Oracle Beehive [host1] success +---------------------------- +revision 1.370 +date: 2010/10/31 23:07:12; author: gilles; state: Exp; lines: +7 -7 +Prepare to move from linux-france.org with independant name. +---------------------------- +revision 1.369 +date: 2010/10/31 23:03:22; author: gilles; state: Exp; lines: +9 -6 +No thanks with imapsync.exe just homepage link. +---------------------------- +revision 1.368 +date: 2010/10/31 22:17:52; author: gilles; state: Exp; lines: +9 -3 +Applied proxyauth-v2_1.366.patch on 1.366 +---------------------------- +revision 1.367 +date: 2010/10/31 00:01:44; author: gilles; state: Exp; lines: +44 -13 +Applied patch patches/proxyauth_1.366.patch from Jorge López Pérez. +---------------------------- +revision 1.366 date: 2010/10/25 17:15:52; author: gilles; state: Exp; lines: +11 -12 Permit host* to have change the case of headers. ---------------------------- diff --git a/FAQ b/FAQ index a571592..32a8f69 100644 --- a/FAQ +++ b/FAQ @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ,v 1.75 2010/10/19 23:31:10 gilles Exp gilles $ +# $Id: FAQ,v 1.82 2011/01/15 06:32:12 gilles Exp gilles $ +------------------+ | FAQ for imapsync | @@ -450,7 +450,7 @@ R. try to transfer the mails without SSL connection. SSL code outside ====================================================================== Q. I want to exclude a folder hierarchy like "public" -R. Use +R. Use: --exclude '^public\.' or maybe @@ -462,6 +462,18 @@ output line : From folders list : [INBOX] [public.dreams] [etc.] +====================================================================== +Q. I want to exclude only INBOX + +R. Use: + + imapsync ... --exclude '^INBOX$' + +A good way to see what will be done is to first use: + + imapsync ... --exclude '^INBOX$' --justfolders --nofoldersizes --dry + + ====================================================================== Q. I want the --folder 'MyFolder' option be recursive. @@ -477,6 +489,19 @@ R. Do not use the --folder option. and only them. +====================================================================== +Q. How to migrate from or to Exchange 2007/2010 with an + admin/authuser account? + +R. The trick comes from Michele Marcionelli: + +This doesn't work: +imapsync ... --user2 user2 --authuser2 admin2 --password2 adminpassword2 ... + +This works: +imapsync ... --user2 'domain\admin2\user2' --password2 adminpassword2 ... + + ====================================================================== Q. How to migrate from uw-imap with an admin/authuser account? @@ -513,6 +538,34 @@ Here is an example: --password2 joespassonserver2 \ --exclude '^user\.' +====================================================================== +Q: How to migrate from Sun Java Enterprise System / Sun One / iPlanet / +Netscape servers with an admin account? + +R: Those imap servers don't allow the typical use of --authuser1 to use an +administrative account. They expect the use of an IMAP command called +proxyauth that is issued after login in as an administrative account. + +For example, consider the administrative account 'administrator' and your +real user 'real_user'. The IMAP sequence would be: + + OK [CAPABILITY IMAP4 IMAP4rev1 ACL QUOTA LITERAL+ NAMESPACE UIDPLUS + CHILDREN BINARY UNSELECT LANGUAGE STARTTLS XSENDER X-NETSCAPE XSERVERINFO + AUTH=PLAIN] imap.server IMAP4 service (Sun Java(tm) System Messaging + Server ...)) + 1 LOGIN administrator password + 1 OK User logged in + 2 PROXYAUTH real_user + 2 OK Completed + +In imapsync, you can achieve this by using the following options: + + --host1 source.imap.server \ + --user1 real_user \ + --authuser1 administrator \ + --proxyauth1 \ + --passfile admin.txt + ====================================================================== Q. Is there anyway of making imapsync purge the destination folder when the source folder is deleted? @@ -550,8 +603,8 @@ imapsync \ ====================================================================== Q. I have moved from Braunschweig to Graz, so I would like to have my - whole Braunschweig mail sorted into a folder INBOX.Braunschweig of my - new mail account. + whole Braunschweig mail sorted into a subfolder INBOX.Braunschweig + of my new mail account. R. 1) First try (safe mode): @@ -581,16 +634,32 @@ Examples: happy with the output remove the --dry --justfolders options. 1) To remove INBOX. in the name of destination folders: + --regextrans2 's/^INBOX\.(.+)/$1/' 2) To sync a complete account in a subfolder called FOO: a) Seperator is dot character "." and "INBOX" prefixes every folder + --regextrans2 's/^INBOX(.*)/INBOX.FOO$1/' - Or - b) Seperator is slash character "/" + or: + + b) Seperator is slash character "/" and there is no prefix + --regextrans2 's#(.*)#FOO/$1#' + + or: + + + c) Any separator, any prefix solution, FOO is the subfolder: + + It is a complicated line because every case is taken into account. + Type it in one line (or with the \ at the end of first line on Unix shells. + + --regextrans2 's,${h1_prefix}(.*),${h2_prefix}FOO${h2_sep}$1,' \ + --regextrans2 's,^INBOX$,${h2_prefix}NEW${h2_sep}INBOX,' + 3) to substitute all characters dot "." by underscores "_" --regextrans2 's/\./_/g' @@ -736,6 +805,34 @@ format issues. And now it works fine. (Thanks to Hansjoerg.Maurer) Server specific issues and solutions ======================================================================= +Q. From or to HMailServer version 4.4.1. + +R. You have to add prefix and separator manually because 4.4.1 doesn't +honor the NAMESPACE imap command. + +Example for host1: + +imapsync ... \ + --prefix1 "" --sep1 . + +No specific option for HMailServer 5.3.3 since NAMESPACE is supported. + +Maybe --subscribe_all will help you to see all migrated folders. + + +======================================================================= +Q. Synchronising from SmarterMail to XXX + +imapsync --host1 imap.d1.org --user1 joe --password1 secret1 --sep1 "/" \ + --host2 imap.d2.org --user2 joe --password2 secret2 \ + --noauthmd5 \ + --prefix1 "Inbox/" \ + --regextrans2 's#^Inbox$#INBOX#' \ + --regextrans2 's#Sent Items$#Sent#' \ + --dry --justfolders + +Maybe add other --regextrans2 to change folder names and see the result. +When satisfied, run without --dry --justfolders ======================================================================= Q. Synchronising from XXX to Gmail @@ -747,15 +844,15 @@ R. There are some details to get the special [Gmail] sub-folders imapsync --host1 mail.oldhost.com \ --user1 my_email@oldhost.com \ --password1 password \ - --host2 imap.gmail.com --port2 993 --ssl2 \ + --host2 imap.gmail.com --ssl2 \ --user2 my_email@gmail.com \ --password2 password \ - --useheader 'Message-Id' --skipsize \ + --useheader 'Message-Id' \ --prefix2 '[Gmail]/' \ --folder 'INBOX.Sent' \ --regextrans2 's/Sent/Sent Mail/' -The same goes for the "All Mail" archive psuedo-folder. +The same goes for the "All Mail" archive pseudo-folder. ======================================================================= Q. Synchronising from Gmail to XXX @@ -783,7 +880,9 @@ option: Q. migrate email from gmail to google apps R. Take a look at: -http://biasecurities.com/2009/migrate-email-from-gmail-to-google-apps/ +http://www.linux-france.org/prj/imapsync_list/msg00639.html + +http://biasecurities.com/blog/2009/migrate-email-from-gmail-to-google-apps/ http://www.thamtech.com/blog/2008/03/29/gmail-to-google-apps-email-migration/ ======================================================================= diff --git a/INSTALL b/INSTALL index bd1b070..037f8e6 100644 --- a/INSTALL +++ b/INSTALL @@ -1,4 +1,4 @@ -# $Id: INSTALL,v 1.18 2010/10/25 09:32:49 gilles Exp gilles $ +# $Id: INSTALL,v 1.19 2010/11/09 02:52:18 gilles Exp gilles $ # # INSTALL file for imapsync # imapsync : IMAP sync or copy tool. @@ -93,9 +93,13 @@ Here is some individual module help: - Perl Digest::HMAC_MD5 module Good for non plain text password over network. +- Perl Authen::NTLM + perl -mAuthen::NTLM -e '' + Everything in one command: - perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mFile::Spec -mDigest::HMAC_MD5 -e '' + perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL \ + -mFile::Spec -mDigest::HMAC_MD5 -mAuthen::NTLM -e '' INSTALLING ---------- diff --git a/Makefile b/Makefile index 932d96f..db0809e 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.42 2010/10/24 23:52:31 gilles Exp gilles $ +# $Id: Makefile,v 1.57 2011/01/12 00:59:12 gilles Exp gilles $ .PHONY: help usage all @@ -12,10 +12,11 @@ usage: @echo "make testv # run tests verbosely" @echo "make test3xx # run tests with (last) Mail-IMAPClient-3.xy" @echo "make test229 # run tests with Mail-IMAPClient-2.2.9" + @echo "make tests_win32 # run tests on win32" @echo "make all " @echo "make upload_index" @echo "make imapsync.exe" - @echo "make upload_imapsync_exe" + @echo "make imapsync_elf_x86.bin" DIST_NAME=imapsync-$(VERSION) @@ -24,42 +25,8 @@ DEB_FILE=$(DIST_NAME).deb VERSION=$(shell perl -I./Mail-IMAPClient-2.2.9 ./imapsync --version) -all: ChangeLog README VERSION VERSION_EXE +all: ChangeLog README VERSION -.PHONY: test tests testp testf test3xx - -.test: imapsync tests.sh - /usr/bin/time sh tests.sh 1>/dev/null - touch .test - -test_quick : test_quick_229 test_quick_3xx - -test_quick_229: imapsync tests.sh - CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' /usr/bin/time sh tests.sh locallocal 1>/dev/null - -test_quick_3xx: imapsync tests.sh - CMD_PERL='perl -I./Mail-IMAPClient-3.25/lib' /usr/bin/time sh tests.sh locallocal 1>/dev/null - -testv: - nice -40 sh -x tests.sh - -test: .test_229 .test_3xx - -tests: test - -test3xx: .test_3xx - -test229: .test_229 - -.test_229: imapsync tests.sh - CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' /usr/bin/time sh tests.sh 1>/dev/null - touch .test_229 - -.test_3xx: imapsync tests.sh - CMD_PERL='perl -I./Mail-IMAPClient-3.25/lib' /usr/bin/time sh tests.sh 1>/dev/null - touch .test_3xx - -testf: clean_test test testp : perl -c imapsync @@ -95,42 +62,59 @@ imapsync.1: imapsync pod2man imapsync > imapsync.1 install: testp imapsync.1 - install -D imapsync $(DESTDIR)/usr/bin/imapsync - install -D imapsync.1 $(DESTDIR)/usr/share/man/man1/imapsync.1 + install imapsync $(DESTDIR)/usr/bin/imapsync + install imapsync.1 $(DESTDIR)/usr/share/man/man1/imapsync.1 chmod 755 $(DESTDIR)/usr/bin/imapsync -dist: cidone test clean clean_dist all INSTALL tarball - - -tarball: - echo making tarball $(DIST_FILE) - mkdir -p dist - mkdir -p ../prepa_dist/$(DIST_NAME) - rsync -aCv --delete --omit-dir-times --exclude dist/ ./ ../prepa_dist/$(DIST_NAME) - cd ../prepa_dist && (tar czfv $(DIST_FILE) $(DIST_NAME) || tar czfv $(DIST_FILE) $(DIST_NAME)) - ln -f ../prepa_dist/$(DIST_FILE) dist/ - cd dist && md5sum $(DIST_FILE) > $(DIST_FILE).md5.txt - cd dist && md5sum -c $(DIST_FILE).md5.txt - - deb: echo making debball $(DEB_FILE) mkdir -p ../prepa_deb cd ../prepa_deb && tar xzvf ../prepa_dist/$(DIST_FILE) &&\ cd ../prepa_dist/$(DIST_NAME) -.PHONY: cidone clean_dist +.PHONY: cidone cidone: rcsdiff RCS/* -clean_dist: - echo Used to be 'rm -f dist/*' - +############### # Local goals +############### -.PHONY: lfo upload_lfo niouze_lfo niouze_fm public dosify_bat imapsync_cidone + +.PHONY: test tests testp testf test3xx + +test_quick : test_quick_229 test_quick_3xx + +test_quick_229: imapsync tests.sh + CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' /usr/bin/time sh tests.sh locallocal 1>/dev/null + +test_quick_3xx: imapsync tests.sh + CMD_PERL='perl -I./Mail-IMAPClient-3.25/lib' /usr/bin/time sh tests.sh locallocal 1>/dev/null + +testv: + nice -40 sh -x tests.sh + +test: .test_229 .test_3xx + +tests: test + +test3xx: .test_3xx + +test229: .test_229 + +.test_229: imapsync tests.sh + CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' /usr/bin/time sh tests.sh 1>/dev/null + touch .test_229 + +.test_3xx: imapsync tests.sh + CMD_PERL='perl -I./Mail-IMAPClient-3.25/lib' /usr/bin/time sh tests.sh 1>/dev/null + touch .test_3xx + +testf: clean_test test + +.PHONY: lfo upload_lfo niouze_lfo niouze_fm public imapsync_cidone upload_index: index.shtml rcsdiff index.shtml @@ -138,67 +122,103 @@ upload_index: index.shtml ../../public_html/www.linux-france.org/html/prj/imapsync/ sh $(HOME)/memo/lfo-rsync - - - .dosify_bat: build_exe.bat test_exe.bat test.bat unix2dos build_exe.bat test.bat test_exe.bat touch .dosify_bat dosify_bat: .dosify_bat -.imapsync_cidone: dosify_bat - rcsdiff imapsync - touch .imapsync_cidone - -imapsync_cidone: .imapsync_cidone - copy_win32: scp imapsync Admin@c:'C:/msys/1.0/home/Admin/imapsync/' tests_win32: dosify_bat scp imapsync test.bat Admin@c:'C:/msys/1.0/home/Admin/imapsync/' - ssh Admin@c 'perl C:/msys/1.0/home/Admin/imapsync/imapsync --tests_debug' -# ssh Admin@c 'perl C:/msys/1.0/home/Admin/imapsync/imapsync' -# ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test.bat' +# ssh Admin@c 'perl C:/msys/1.0/home/Admin/imapsync/imapsync --tests_debug' + ssh Admin@c 'perl C:/msys/1.0/home/Admin/imapsync/imapsync --tests' + ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test.bat' # ssh Admin@c 'tasklist /FI "PID eq 0"' # ssh Admin@c 'tasklist /NH /FO CSV' -upload_imapsync_exe: - rsync -avH imapsync.exe \ - ../../public_html/www.linux-france.org/html/prj/imapsync/ - #sh $(HOME)/memo/lfo-rsync - test_imapsync_exe: dosify_bat scp 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' -imapsync.exe: imapsync imapsync_cidone dosify_bat + +imapsync.exe: imapsync build_exe.bat test_exe.bat .dosify_bat + rcsdiff imapsync + ssh Admin@c 'perl -V' (date "+%s"| tr "\n" " "; echo -n "BEGIN " $(VERSION) ": "; date) >> .BUILD_EXE_TIME scp imapsync build_exe.bat test_exe.bat \ Admin@c:'C:/msys/1.0/home/Admin/imapsync/' - time ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/build_exe.bat' - time ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test_exe.bat' + ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/build_exe.bat' + ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/test_exe.bat' scp Admin@c:'C:/msys/1.0/home/Admin/imapsync/imapsync.exe' . ssh Admin@c 'C:/msys/1.0/home/Admin/imapsync/imapsync.exe --version' > VERSION_EXE (date "+%s"| tr "\n" " "; echo -n "END " $(VERSION) ": "; date) >> .BUILD_EXE_TIME -zzz: - (date "+%s"| tr "\n" " "; echo -n "BEGIN " $(VERSION) ": "; date) >> .BUILD_EXE_TIME - (date "+%s"| tr "\n" " "; echo -n "END " $(VERSION) ": "; date) >> .BUILD_EXE_TIME + +# vadrouille or petite +imapsync_elf_x86.bin: imapsync + rcsdiff imapsync + { test 'vadrouille' = "`hostname`" && \ + pp -o imapsync_elf_x86.bin -I Mail-IMAPClient-3.25/lib \ + -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL \ + -M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey \ + -M Authen::NTLM \ + imapsync ; \ + } || : + { test 'petite' = "`hostname`" && \ + pp -o imapsync_elf_x86.bin -I Mail-IMAPClient-3.25/lib \ + -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL \ + -M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey \ + -M Authen::NTLM \ + -M Tie::Hash::NamedCapture \ + -a '/usr/lib/perl/5.10.0/auto/POSIX/SigAction;auto/POSIX/SigAction' \ + imapsync ; \ + } || : + { test 'ks200821.kimsufi.com' = "`hostname`" && \ + pp -o imapsync_elf_x86.bin -I Mail-IMAPClient-3.25/lib \ + -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL \ + -M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey \ + -M Authen::NTLM \ + -M Tie::Hash::NamedCapture \ + -a '/usr/lib/perl/5.10.1/auto/POSIX/SigAction;auto/POSIX/SigAction' \ + imapsync ; \ + } || : + ./imapsync_elf_x86.bin -lfo: dist niouze_lfo upload_lfo +lfo: cidone niouze_lfo upload_lfo -upload_lfo: - rsync -avH --delete . \ +dist: cidone test clean all INSTALL tarball + +tarball: cidone all imapsync_elf_x86.bin imapsync.exe + echo making tarball $(DIST_FILE) + mkdir -p dist + mkdir -p ../prepa_dist/$(DIST_NAME) + rsync -aCv --delete --omit-dir-times --exclude dist/ ./ ../prepa_dist/$(DIST_NAME)/ + rsync -av ./imapsync.exe ../prepa_dist/$(DIST_NAME)/ + cd ../prepa_dist && (tar czfv $(DIST_FILE) $(DIST_NAME) || tar czfv $(DIST_FILE) $(DIST_NAME)) + #ln -f ../prepa_dist/$(DIST_FILE) dist/ + cd ../prepa_dist && md5sum $(DIST_FILE) > $(DIST_FILE).md5.txt + cd ../prepa_dist && md5sum -c $(DIST_FILE).md5.txt + ls -l ../prepa_dist/$(DIST_FILE) + + +upload_lfo: + #rm -rf /home/gilles/public_html/www.linux-france.org/html/prj/imapsync/ + #rm -rf /home/gilles/public_html/www.linux-france.org/ftp/prj/imapsync/ + rsync -avH ./ChangeLog ./COPYING ./CREDITS ./FAQ \ + ./index.shtml ./INSTALL \ + ./logo_imapsync.png ./logo_imapsync_s.png \ + ./paypal.shtml ./README ./style.css ./TODO ./VERSION ./VERSION_EXE \ /home/gilles/public_html/www.linux-france.org/html/prj/imapsync/ - rsync -avH --delete ../prepa_dist/imapsync-*tgz \ - /home/gilles/public_html/www.linux-france.org/ftp/prj/imapsync/ + rsync -avH ./dist/index.shtml \ + /home/gilles/public_html/www.linux-france.org/html/prj/imapsync/dist/ sh ~/memo/lfo-rsync niouze_lfo : VERSION - . ./memo && lfo_announce + echo "CORRECT ME: . ./memo && lfo_announce" niouze_fm: VERSION . ./memo && fm_announce diff --git a/NTLM-1.05/Changes b/NTLM-1.05/Changes new file mode 100644 index 0000000..115231e --- /dev/null +++ b/NTLM-1.05/Changes @@ -0,0 +1,24 @@ +Revision history for Perl NTLM authentication suite + +1.05 19 Jun 2008 + - implement OO interface - thanks to Dmitry Karasik + - fix minor bug in last release - thanks to Dmitry Karasik + +1.04 29 May 2008 + - implement NTLMv2 - thanks to Andrew Hobson + +1.03 Thur Aug 09 09:13:00 2007 + - fixes bug from 2001 - http://rt.cpan.org/Public/Bug/Display.html?id=9521 + - fixes minor doco bug also reported in same place. + +1.02 Mon Oct 29 19:01:00 2001 + - fixed package names due to a source code mixup! + - added a test suite + +1.01 Sun Oct 28 11:01:00 2001 + - added ntlm_domain() to set initial domain + - added ntlm_reset() to reset state machine for multiple use + - added fuller documentation + +1.00 Sat Oct 27 13:31:53 2001 + - original version; diff --git a/NTLM-1.05/DES/DES.pm b/NTLM-1.05/DES/DES.pm new file mode 100644 index 0000000..04ab365 --- /dev/null +++ b/NTLM-1.05/DES/DES.pm @@ -0,0 +1,294 @@ +#!/usr/local/bin/perl +# +# This is an implementation of part of the DES specification. According +# to the code this is ported from, this code does NOT enable 2-way +# encryption and is, hence, not a cypher and does not appear to come +# under any export restrictions on such. +# +package Authen::NTLM::DES; + +use vars qw($VERSION @ISA @EXPORT); +require Exporter; + +$VERSION = "1.02"; +@ISA = qw(Exporter); +@EXPORT = qw(E_P16 E_P24); + +my ($loop, $loop2); +$loop = 0; +$loop2 = 0; + +my $perm1 = [57, 49, 41, 33, 25, 17, 9, + 1, 58, 50, 42, 34, 26, 18, + 10, 2, 59, 51, 43, 35, 27, + 19, 11, 3, 60, 52, 44, 36, + 63, 55, 47, 39, 31, 23, 15, + 7, 62, 54, 46, 38, 30, 22, + 14, 6, 61, 53, 45, 37, 29, + 21, 13, 5, 28, 20, 12, 4]; +my $perm2 = [14, 17, 11, 24, 1, 5, + 3, 28, 15, 6, 21, 10, + 23, 19, 12, 4, 26, 8, + 16, 7, 27, 20, 13, 2, + 41, 52, 31, 37, 47, 55, + 30, 40, 51, 45, 33, 48, + 44, 49, 39, 56, 34, 53, + 46, 42, 50, 36, 29, 32]; +my $perm3 = [58, 50, 42, 34, 26, 18, 10, 2, + 60, 52, 44, 36, 28, 20, 12, 4, + 62, 54, 46, 38, 30, 22, 14, 6, + 64, 56, 48, 40, 32, 24, 16, 8, + 57, 49, 41, 33, 25, 17, 9, 1, + 59, 51, 43, 35, 27, 19, 11, 3, + 61, 53, 45, 37, 29, 21, 13, 5, + 63, 55, 47, 39, 31, 23, 15, 7]; +my $perm4 = [32, 1, 2, 3, 4, 5, + 4, 5, 6, 7, 8, 9, + 8, 9, 10, 11, 12, 13, + 12, 13, 14, 15, 16, 17, + 16, 17, 18, 19, 20, 21, + 20, 21, 22, 23, 24, 25, + 24, 25, 26, 27, 28, 29, + 28, 29, 30, 31, 32, 1]; +my $perm5 = [16, 7, 20, 21, 29, 12, 28, 17, + 1, 15, 23, 26, 5, 18, 31, 10, + 2, 8, 24, 14, 32, 27, 3, 9, + 19, 13, 30, 6, 22, 11, 4, 25]; +my $perm6 = [40, 8, 48, 16, 56, 24, 64, 32, + 39, 7, 47, 15, 55, 23, 63, 31, + 38, 6, 46, 14, 54, 22, 62, 30, + 37, 5, 45, 13, 53, 21, 61, 29, + 36, 4, 44, 12, 52, 20, 60, 28, + 35, 3, 43, 11, 51, 19, 59, 27, + 34, 2, 42, 10, 50, 18, 58, 26, + 33, 1, 41, 9, 49, 17, 57, 25]; +my $sc = [1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1]; +my $sbox = [ +[ +[14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7], +[0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8], +[4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0], +[15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13] +], +[ +[15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10], +[3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5], +[0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15], +[13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9] +], +[ +[10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8], +[13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1], +[13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7], +[1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12] +], +[ +[7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15], +[13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9], +[10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4], +[3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14] +], +[ +[2,12,4,1,7,10,11,6,8,5,3,15,13,0,14,9], +[14,11,2,12,4,7,13,1,5,0,15,10,3,9,8,6], +[4,2,1,11,10,13,7,8,15,9,12,5,6,3,0,14], +[11,8,12,7,1,14,2,13,6,15,0,9,10,4,5,3] +], +[ +[12,1,10,15,9,2,6,8,0,13,3,4,14,7,5,11], +[10,15,4,2,7,12,9,5,6,1,13,14,0,11,3,8], +[9,14,15,5,2,8,12,3,7,0,4,10,1,13,11,6], +[4,3,2,12,9,5,15,10,11,14,1,7,6,0,8,13] +], +[ +[4,11,2,14,15,0,8,13,3,12,9,7,5,10,6,1], +[13,0,11,7,4,9,1,10,14,3,5,12,2,15,8,6], +[1,4,11,13,12,3,7,14,10,15,6,8,0,5,9,2], +[6,11,13,8,1,4,10,7,9,5,0,15,14,2,3,12] +], +[ +[13,2,8,4,6,15,11,1,10,9,3,14,5,0,12,7], +[1,15,13,8,10,3,7,4,12,5,6,11,0,14,9,2], +[7,11,4,1,9,12,14,2,0,6,10,13,15,3,5,8], +[2,1,14,7,4,10,8,13,15,12,9,0,3,5,6,11] +] +]; + +sub E_P16 +{ + my ($p14) = @_; + my $sp8 = [0x4b, 0x47, 0x53, 0x21, 0x40, 0x23, 0x24, 0x25]; + + my $p7 = substr($p14, 0, 7); + my $p16 = smbhash($sp8, $p7); + $p7 = substr($p14, 7, 7); + $p16 .= smbhash($sp8, $p7); + return $p16; +} + +sub E_P24 +{ + my ($p21, $c8_str) = @_; + my @c8 = map {ord($_)} split(//, $c8_str); + my $p24 = smbhash(\@c8, substr($p21, 0, 7)); + $p24 .= smbhash(\@c8, substr($p21, 7, 7)); + $p24 .= smbhash(\@c8, substr($p21, 14, 7)); +} + +sub permute +{ + my ($out, $in, $p, $n) = @_; + my $i; + + foreach $i (0..($n-1)) + { + $out->[$i] = $in->[$p->[$i]-1]; + } +} + +sub lshift +{ + my ($d, $count, $n) = @_; + my (@out, $i); + + foreach $i (0..($n-1)) + { + $out[$i] = $d->[($i+$count)%$n]; + } + foreach $i (0..($n-1)) + { + $d->[$i] = $out[$i]; + } +} + +sub xor +{ + my ($out, $in1, $in2, $n) = @_; + my $i; + + foreach $i (0..($n-1)) + { + $out->[$i] = $in1->[$i]^$in2->[$i]; + } +} + +sub dohash +{ + my ($out, $in, $key) = @_; + my ($i, $j, $k, @pk1, @c, @d, @cd, + @ki, @pd1, @l, @r, @rl); + + &permute(\@pk1, $key, $perm1, 56); + + foreach $i (0..27) + { + $c[$i] = $pk1[$i]; + $d[$i] = $pk1[$i+28]; + } + foreach $i (0..15) + { + my @array; + &lshift(\@c, $sc->[$i], 28); + &lshift(\@d, $sc->[$i], 28); + @cd = (@c, @d); + &permute(\@array, \@cd, $perm2, 48); + $ki[$i] = \@array; + } + &permute(\@pd1, $in, $perm3, 64); + + foreach $j (0..31) + { + $l[$j] = $pd1[$j]; + $r[$j] = $pd1[$j+32]; + } + + foreach $i (0..15) + { + local (@er, @erk, @b, @cb, @pcb, @r2); + permute(\@er, \@r, $perm4, 48); + &xor(\@erk, \@er, $ki[$i], 48); + foreach $j (0..7) + { + foreach $k (0..5) + { + $b[$j][$k] = $erk[$j*6+$k]; + } + } + foreach $j (0..7) + { + local ($m, $n); + $m = ($b[$j][0]<<1) | $b[$j][5]; + $n = ($b[$j][1]<<3) | ($b[$j][2]<<2) | ($b[$j][3]<<1) | $b[$j][4]; + foreach $k (0..3) + { + $b[$j][$k] = ($sbox->[$j][$m][$n] & (1<<(3-$k)))? 1: 0; + } + } + foreach $j (0..7) + { + foreach $k (0..3) + { + $cb[$j*4+$k] = $b[$j][$k]; + } + } + &permute(\@pcb, \@cb, $perm5, 32); + &xor(\@r2, \@l, \@pcb, 32); + foreach $j (0..31) + { + $l[$j] = $r[$j]; + $r[$j] = $r2[$j]; + } + } + @rl = (@r, @l); + &permute($out, \@rl, $perm6, 64); +} + +sub str_to_key +{ + my ($str) = @_; + my $i; + my @key; + my $out; + my @str = map {ord($_)} split(//, $str); + $key[0] = $str[0]>>1; + $key[1] = (($str[0]&0x01)<<6) | ($str[1]>>2); + $key[2] = (($str[1]&0x03)<<5) | ($str[2]>>3); + $key[3] = (($str[2]&0x07)<<4) | ($str[3]>>4); + $key[4] = (($str[3]&0x0f)<<3) | ($str[4]>>5); + $key[5] = (($str[4]&0x1f)<<2) | ($str[5]>>6); + $key[6] = (($str[5]&0x3f)<<1) | ($str[6]>>7); + $key[7] = $str[6]&0x7f; + foreach $i (0..7) + { + $key[$i] = 0xff&($key[$i]<<1); + } + return \@key; +} + +sub smbhash +{ + my ($in, $key) = @_; + + my $key2 = &str_to_key($key); + my ($i, $div, $mod, @in, @outb, @inb, @keyb, @out); + foreach $i (0..63) + { + $div = int($i/8); $mod = $i%8; + $inb[$i] = ($in->[$div] & (1<<(7-($mod))))? 1: 0; + $keyb[$i] = ($key2->[$div] & (1<<(7-($mod))))? 1: 0; + $outb[$i] = 0; + } + &dohash(\@outb, \@inb, \@keyb); + foreach $i (0..7) + { + $out[$i] = 0; + } + foreach $i (0..63) + { + $out[int($i/8)] |= (1<<(7-($i%8))) if ($outb[$i]); + } + my $out = pack("C8", @out); + return $out; +} + +1; diff --git a/NTLM-1.05/DES/Makefile b/NTLM-1.05/DES/Makefile new file mode 100644 index 0000000..747da8d --- /dev/null +++ b/NTLM-1.05/DES/Makefile @@ -0,0 +1,580 @@ +# This Makefile is for the Authen::NTLM::DES extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.30_01 (Revision: Revision: 4535 ) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: () +# +# MakeMaker Parameters: + +# AUTHOR => q[David (Buzz) Bussenschutt , Mark Bush ] +# NAME => q[Authen::NTLM::DES] +# VERSION_FROM => q[DES.pm] + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm) + +# They may have been overridden via Makefile.PL or on the command line +AR = ar +CC = cc +CCCDLFLAGS = -fPIC +CCDLFLAGS = -Wl,-E +DLEXT = so +DLSRC = dl_dlopen.xs +LD = cc +LDDLFLAGS = -shared -L/usr/local/lib +LDFLAGS = -L/usr/local/lib +LIBC = /lib/libc-2.7.so +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 2.6.24-19-server +RANLIB = : +SITELIBEXP = /usr/local/share/perl/5.8.8 +SITEARCHEXP = /usr/local/lib/perl/5.8.8 +SO = so +EXE_EXT = +FULL_AR = /usr/bin/ar +VENDORARCHEXP = /usr/lib/perl5 +VENDORLIBEXP = /usr/share/perl5 + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +DFSEP = $(DIRFILESEP) +NAME = Authen::NTLM::DES +NAME_SYM = Authen_NTLM_DES +VERSION = 1.02 +VERSION_MACRO = VERSION +VERSION_SYM = 1_02 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 1.02 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = ../blib/arch +INST_SCRIPT = ../blib/script +INST_BIN = ../blib/bin +INST_LIB = ../blib/lib +INST_MAN1DIR = ../blib/man1 +INST_MAN3DIR = ../blib/man3 +MAN1EXT = 1p +MAN3EXT = 3pm +INSTALLDIRS = site +DESTDIR = +PREFIX = /usr +PERLPREFIX = $(PREFIX) +SITEPREFIX = $(PREFIX)/local +VENDORPREFIX = $(PREFIX) +INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.8.8 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5 +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8 +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.8.8 +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5 +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = $(PERLPREFIX)/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = $(SITEPREFIX)/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = $(VENDORPREFIX)/bin +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = $(PERLPREFIX)/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLSITESCRIPT = $(SITEPREFIX)/bin +DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) +INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin +DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) +INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1 +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3 +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/share/perl/5.8 +PERL_ARCHLIB = /usr/lib/perl/5.8 +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = Makefile.old +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib/perl/5.8/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm +MM_VERSION = 6.30_01 +MM_REVISION = Revision: 4535 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = Authen/NTLM/DES +BASEEXT = DES +PARENT_NAME = Authen::NTLM +DLBASE = $(BASEEXT) +VERSION_FROM = DES.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic +BOOTDEP = + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = +MAN3PODS = + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/Authen/NTLM +INST_ARCHLIBDIR = $(INST_ARCHLIB)/Authen/NTLM + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = DES.pm + +PM_TO_BLIB = DES.pm \ + $(INST_LIB)/Authen/NTLM/DES.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 1.50_01 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(SHELL) -c true +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath +EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');' +DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install +UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist +MACROSTART = +MACROEND = +USEMAKEFILE = -f +FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)" + + +# --- MakeMaker makemakerdflt section: +makemakerdflt: all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section skipped. + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)" + + +# --- MakeMaker special_targets section: +.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) blibdirs + $(NOECHO) $(NOOP) + +help : + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker blibdirs section: +blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP) + +# Backwards compat with 6.18 through 6.25 +blibdirs.ts : blibdirs + $(NOECHO) $(NOOP) + +$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR) + $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists + +$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHLIB) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB) + $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists + +$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR) + $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists + +$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR) + $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists + +$(INST_BIN)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_BIN) + $(NOECHO) $(CHMOD) 755 $(INST_BIN) + $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists + +$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_SCRIPT) + $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT) + $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists + +$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN1DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR) + $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists + +$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR) + $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists + + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all + $(NOECHO) $(NOOP) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + - $(RM_F) \ + *$(LIB_EXT) core \ + core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \ + core.[0-9][0-9] $(BASEEXT).bso \ + pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \ + $(BASEEXT).x $(BOOTSTRAP) \ + perl$(EXE_EXT) tmon.out \ + *$(OBJ_EXT) pm_to_blib \ + $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \ + core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ + core.*perl.*.? $(MAKE_APERL_FILE) \ + perl $(BASEEXT).def \ + core.[0-9][0-9][0-9] mon.out \ + lib$(BASEEXT).def perlmain.c \ + perl.exe so_locations \ + $(BASEEXT).exp + - $(RM_RF) \ + blib + - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: +# Delete temporary files (via clean) and also delete dist files +realclean purge :: clean realclean_subdirs + - $(RM_F) \ + $(MAKEFILE_OLD) $(FIRST_MAKEFILE) + - $(RM_RF) \ + $(DISTVNAME) + + +# --- MakeMaker metafile section: +metafile : create_distdir + $(NOECHO) $(ECHO) Generating META.yml + $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META_new.yml + $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META_new.yml + $(NOECHO) $(ECHO) 'name: Authen-NTLM-DES' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 1.02' >> META_new.yml + $(NOECHO) $(ECHO) 'version_from: DES.pm' >> META_new.yml + $(NOECHO) $(ECHO) 'installdirs: site' >> META_new.yml + $(NOECHO) $(ECHO) 'requires:' >> META_new.yml + $(NOECHO) $(ECHO) '' >> META_new.yml + $(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml + $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.30_01' >> META_new.yml + -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml + + +# --- MakeMaker signature section: +signature : + cpansign -s + + +# --- MakeMaker dist_basics section skipped. + +# --- MakeMaker dist_core section skipped. + +# --- MakeMaker distdir section skipped. + +# --- MakeMaker dist_test section skipped. + +# --- MakeMaker dist_ci section skipped. + +# --- MakeMaker distmeta section: +distmeta : create_distdir metafile + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' + + + +# --- MakeMaker distsignature section: +distsignature : create_distdir + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' + $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s + + + +# --- MakeMaker install section skipped. + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE: + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) + -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) + $(PERLRUN) Makefile.PL + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" + false + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = ../perl +FULLPERL = /usr/bin/perl + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) + $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.' + +test_dynamic :: pure_all + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd: + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' David (Buzz) Bussenschutt <davidbuzz@gmail.com>, Mark Bush <Mark.Bush@bushnet.demon.co.uk>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib : $(TO_INST_PM) + $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \ + DES.pm $(INST_LIB)/Authen/NTLM/DES.pm + $(NOECHO) $(TOUCH) pm_to_blib + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/NTLM-1.05/DES/Makefile.PL b/NTLM-1.05/DES/Makefile.PL new file mode 100644 index 0000000..d3ee1c0 --- /dev/null +++ b/NTLM-1.05/DES/Makefile.PL @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +use ExtUtils::MakeMaker; + +# + +WriteMakefile( + 'NAME' => 'Authen::NTLM::DES', + 'VERSION_FROM' => 'DES.pm', + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + ('AUTHOR' => 'David (Buzz) Bussenschutt , Mark Bush ') : ()), +); diff --git a/NTLM-1.05/DES/pm_to_blib b/NTLM-1.05/DES/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/MANIFEST b/NTLM-1.05/MANIFEST new file mode 100644 index 0000000..45a643c --- /dev/null +++ b/NTLM-1.05/MANIFEST @@ -0,0 +1,15 @@ +Changes +Makefile.PL +MANIFEST +README +NTLM.pm +DES/DES.pm +DES/Makefile.PL +MD4/MD4.pm +MD4/Makefile.PL +t/01_load.t +t/02_ntlm.t +t/03_oo.t +t/04_v2.t +t/99_pod.t +META.yml Module meta-data (added by MakeMaker) diff --git a/NTLM-1.05/MD4/MD4.pm b/NTLM-1.05/MD4/MD4.pm new file mode 100644 index 0000000..ba8f735 --- /dev/null +++ b/NTLM-1.05/MD4/MD4.pm @@ -0,0 +1,197 @@ +#!/usr/local/bin/perl +# +# This is a partial implentation of the MD4 checksum code. +# +# NOTE +# +# The function &add() in this module is required as we need to be +# able to add 32bit integers ignoring overflow. The C code this is +# based on does this because it uses the underlying hardware to +# perform the required addition however we need to be more careful +# as Perl will overflow an int and produce a result of 0xffffffff +# which is not very useful. The &add() function splits its arguments +# into two shorts and adds these carrying overflow from the low short +# to the high short and ignoring carry from the high short. Not +# exactly efficient, but it works and is fast enough for the purposes +# of this implementation +# + +package Authen::NTLM::MD4; + +use vars qw($VERSION @ISA @EXPORT); +require Exporter; + +$VERSION = "1.02"; +@ISA = qw(Exporter); +@EXPORT = qw(mdfour); + +my ($A, $B, $C, $D); +my (@X, $M); + +sub mdfour +{ + my ($in) = @_; + + my ($i, $pos); + my $len = length($in); + my $b = $len * 8; + $in .= "\0"x128; + $A = 0x67452301; + $B = 0xefcdab89; + $C = 0x98badcfe; + $D = 0x10325476; + $pos = 0; + while ($len > 64) + { + ©64(substr($in, $pos, 64)); + &mdfour64; + $pos += 64; + $len -= 64; + } + my $buf = substr($in, $pos, $len); + $buf .= sprintf "%c", 0x80; + if ($len <= 55) + { + $buf .= "\0"x(55-$len); + $buf .= pack("V", $b); + $buf .= "\0"x4; + ©64($buf); + &mdfour64; + } + else + { + $buf .= "\0"x(120-$len); + $buf .= pack("V", $b); + $buf .= "\0"x4; + ©64(substr($buf, 0, 64)); + &mdfour64; + ©64(substr($buf, 64, 64)); + &mdfour64; + } + my $out = pack("VVVV", $A, $B, $C, $D); + return $out; +} + +sub F +{ + my ($X, $Y, $Z) = @_; + my $res = ($X&$Y) | ((~$X)&$Z); + return $res; +} + +sub G +{ + my ($X, $Y, $Z) = @_; + + return ($X&$Y) | ($X&$Z) | ($Y&$Z); +} + +sub H +{ + my ($X, $Y, $Z) = @_; + + return $X^$Y^$Z; +} + +sub lshift +{ + my ($x, $s) = @_; + + $x &= 0xffffffff; + return (($x<<$s)&0xffffffff) | ($x>>(32-$s)); +} + +sub ROUND1 +{ + my ($a, $b, $c, $d, $k, $s) = @_; + my $e = &add($a, &F($b, $c, $d), $X[$k]); + return &lshift($e, $s); +} + +sub ROUND2 +{ + my ($a, $b, $c, $d, $k, $s) = @_; + + my $e = &add($a, &G($b, $c, $d), $X[$k], 0x5a827999); + return &lshift($e, $s); +} + +sub ROUND3 +{ + my ($a, $b, $c, $d, $k, $s) = @_; + + my $e = &add($a, &H($b, $c, $d), $X[$k], 0x6ed9eba1); + return &lshift($e, $s); +} + +sub mdfour64 +{ + my ($i, $AA, $BB, $CC, $DD); + @X = unpack("N16", $M); + $AA = $A; + $BB = $B; + $CC = $C; + $DD = $D; + + $A = &ROUND1($A,$B,$C,$D, 0, 3); $D = &ROUND1($D,$A,$B,$C, 1, 7); + $C = &ROUND1($C,$D,$A,$B, 2,11); $B = &ROUND1($B,$C,$D,$A, 3,19); + $A = &ROUND1($A,$B,$C,$D, 4, 3); $D = &ROUND1($D,$A,$B,$C, 5, 7); + $C = &ROUND1($C,$D,$A,$B, 6,11); $B = &ROUND1($B,$C,$D,$A, 7,19); + $A = &ROUND1($A,$B,$C,$D, 8, 3); $D = &ROUND1($D,$A,$B,$C, 9, 7); + $C = &ROUND1($C,$D,$A,$B,10,11); $B = &ROUND1($B,$C,$D,$A,11,19); + $A = &ROUND1($A,$B,$C,$D,12, 3); $D = &ROUND1($D,$A,$B,$C,13, 7); + $C = &ROUND1($C,$D,$A,$B,14,11); $B = &ROUND1($B,$C,$D,$A,15,19); + + $A = &ROUND2($A,$B,$C,$D, 0, 3); $D = &ROUND2($D,$A,$B,$C, 4, 5); + $C = &ROUND2($C,$D,$A,$B, 8, 9); $B = &ROUND2($B,$C,$D,$A,12,13); + $A = &ROUND2($A,$B,$C,$D, 1, 3); $D = &ROUND2($D,$A,$B,$C, 5, 5); + $C = &ROUND2($C,$D,$A,$B, 9, 9); $B = &ROUND2($B,$C,$D,$A,13,13); + $A = &ROUND2($A,$B,$C,$D, 2, 3); $D = &ROUND2($D,$A,$B,$C, 6, 5); + $C = &ROUND2($C,$D,$A,$B,10, 9); $B = &ROUND2($B,$C,$D,$A,14,13); + $A = &ROUND2($A,$B,$C,$D, 3, 3); $D = &ROUND2($D,$A,$B,$C, 7, 5); + $C = &ROUND2($C,$D,$A,$B,11, 9); $B = &ROUND2($B,$C,$D,$A,15,13); + + $A = &ROUND3($A,$B,$C,$D, 0, 3); $D = &ROUND3($D,$A,$B,$C, 8, 9); + $C = &ROUND3($C,$D,$A,$B, 4,11); $B = &ROUND3($B,$C,$D,$A,12,15); + $A = &ROUND3($A,$B,$C,$D, 2, 3); $D = &ROUND3($D,$A,$B,$C,10, 9); + $C = &ROUND3($C,$D,$A,$B, 6,11); $B = &ROUND3($B,$C,$D,$A,14,15); + $A = &ROUND3($A,$B,$C,$D, 1, 3); $D = &ROUND3($D,$A,$B,$C, 9, 9); + $C = &ROUND3($C,$D,$A,$B, 5,11); $B = &ROUND3($B,$C,$D,$A,13,15); + $A = &ROUND3($A,$B,$C,$D, 3, 3); $D = &ROUND3($D,$A,$B,$C,11, 9); + $C = &ROUND3($C,$D,$A,$B, 7,11); $B = &ROUND3($B,$C,$D,$A,15,15); + + $A = &add($A, $AA); $B = &add($B, $BB); + $C = &add($C, $CC); $D = &add($D, $DD); + $A &= 0xffffffff; $B &= 0xffffffff; + $C &= 0xffffffff; $D &= 0xffffffff; + map {$_ = 0} @X; +} + +sub copy64 +{ + my ($in) = @_; + + $M = pack("V16", unpack("N16", $in)); +} + +# see note at top of this file about this function +sub add +{ + my (@nums) = @_; + my ($r_low, $r_high, $n_low, $l_high); + my $num; + $r_low = $r_high = 0; + foreach $num (@nums) + { + $n_low = $num & 0xffff; + $n_high = ($num&0xffff0000)>>16; + $r_low += $n_low; + ($r_low&0xf0000) && $r_high++; + $r_low &= 0xffff; + $r_high += $n_high; + $r_high &= 0xffff; + } + return ($r_high<<16)|$r_low; +} + +1; diff --git a/NTLM-1.05/MD4/Makefile b/NTLM-1.05/MD4/Makefile new file mode 100644 index 0000000..bbf9732 --- /dev/null +++ b/NTLM-1.05/MD4/Makefile @@ -0,0 +1,580 @@ +# This Makefile is for the Authen::NTLM::MD4 extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.30_01 (Revision: Revision: 4535 ) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: () +# +# MakeMaker Parameters: + +# AUTHOR => q[David (Buzz) Bussenschutt , Mark Bush ] +# NAME => q[Authen::NTLM::MD4] +# VERSION_FROM => q[MD4.pm] + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm) + +# They may have been overridden via Makefile.PL or on the command line +AR = ar +CC = cc +CCCDLFLAGS = -fPIC +CCDLFLAGS = -Wl,-E +DLEXT = so +DLSRC = dl_dlopen.xs +LD = cc +LDDLFLAGS = -shared -L/usr/local/lib +LDFLAGS = -L/usr/local/lib +LIBC = /lib/libc-2.7.so +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 2.6.24-19-server +RANLIB = : +SITELIBEXP = /usr/local/share/perl/5.8.8 +SITEARCHEXP = /usr/local/lib/perl/5.8.8 +SO = so +EXE_EXT = +FULL_AR = /usr/bin/ar +VENDORARCHEXP = /usr/lib/perl5 +VENDORLIBEXP = /usr/share/perl5 + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +DFSEP = $(DIRFILESEP) +NAME = Authen::NTLM::MD4 +NAME_SYM = Authen_NTLM_MD4 +VERSION = 1.02 +VERSION_MACRO = VERSION +VERSION_SYM = 1_02 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 1.02 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = ../blib/arch +INST_SCRIPT = ../blib/script +INST_BIN = ../blib/bin +INST_LIB = ../blib/lib +INST_MAN1DIR = ../blib/man1 +INST_MAN3DIR = ../blib/man3 +MAN1EXT = 1p +MAN3EXT = 3pm +INSTALLDIRS = site +DESTDIR = +PREFIX = /usr +PERLPREFIX = $(PREFIX) +SITEPREFIX = $(PREFIX)/local +VENDORPREFIX = $(PREFIX) +INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.8.8 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5 +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8 +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.8.8 +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5 +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = $(PERLPREFIX)/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = $(SITEPREFIX)/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = $(VENDORPREFIX)/bin +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = $(PERLPREFIX)/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLSITESCRIPT = $(SITEPREFIX)/bin +DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) +INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin +DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) +INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1 +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3 +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/share/perl/5.8 +PERL_ARCHLIB = /usr/lib/perl/5.8 +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = Makefile.old +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib/perl/5.8/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm +MM_VERSION = 6.30_01 +MM_REVISION = Revision: 4535 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = Authen/NTLM/MD4 +BASEEXT = MD4 +PARENT_NAME = Authen::NTLM +DLBASE = $(BASEEXT) +VERSION_FROM = MD4.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic +BOOTDEP = + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = +MAN3PODS = + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/Authen/NTLM +INST_ARCHLIBDIR = $(INST_ARCHLIB)/Authen/NTLM + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = MD4.pm + +PM_TO_BLIB = MD4.pm \ + $(INST_LIB)/Authen/NTLM/MD4.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 1.50_01 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(SHELL) -c true +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath +EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');' +DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install +UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist +MACROSTART = +MACROEND = +USEMAKEFILE = -f +FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)" + + +# --- MakeMaker makemakerdflt section: +makemakerdflt: all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section skipped. + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)" + + +# --- MakeMaker special_targets section: +.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) blibdirs + $(NOECHO) $(NOOP) + +help : + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker blibdirs section: +blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP) + +# Backwards compat with 6.18 through 6.25 +blibdirs.ts : blibdirs + $(NOECHO) $(NOOP) + +$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR) + $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists + +$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHLIB) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB) + $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists + +$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR) + $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists + +$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR) + $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists + +$(INST_BIN)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_BIN) + $(NOECHO) $(CHMOD) 755 $(INST_BIN) + $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists + +$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_SCRIPT) + $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT) + $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists + +$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN1DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR) + $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists + +$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR) + $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists + + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all + $(NOECHO) $(NOOP) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + - $(RM_F) \ + *$(LIB_EXT) core \ + core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \ + core.[0-9][0-9] $(BASEEXT).bso \ + pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \ + $(BASEEXT).x $(BOOTSTRAP) \ + perl$(EXE_EXT) tmon.out \ + *$(OBJ_EXT) pm_to_blib \ + $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \ + core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ + core.*perl.*.? $(MAKE_APERL_FILE) \ + $(BASEEXT).def perl \ + core.[0-9][0-9][0-9] mon.out \ + lib$(BASEEXT).def perl.exe \ + perlmain.c so_locations \ + $(BASEEXT).exp + - $(RM_RF) \ + blib + - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: +# Delete temporary files (via clean) and also delete dist files +realclean purge :: clean realclean_subdirs + - $(RM_F) \ + $(MAKEFILE_OLD) $(FIRST_MAKEFILE) + - $(RM_RF) \ + $(DISTVNAME) + + +# --- MakeMaker metafile section: +metafile : create_distdir + $(NOECHO) $(ECHO) Generating META.yml + $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META_new.yml + $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META_new.yml + $(NOECHO) $(ECHO) 'name: Authen-NTLM-MD4' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 1.02' >> META_new.yml + $(NOECHO) $(ECHO) 'version_from: MD4.pm' >> META_new.yml + $(NOECHO) $(ECHO) 'installdirs: site' >> META_new.yml + $(NOECHO) $(ECHO) 'requires:' >> META_new.yml + $(NOECHO) $(ECHO) '' >> META_new.yml + $(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml + $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.30_01' >> META_new.yml + -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml + + +# --- MakeMaker signature section: +signature : + cpansign -s + + +# --- MakeMaker dist_basics section skipped. + +# --- MakeMaker dist_core section skipped. + +# --- MakeMaker distdir section skipped. + +# --- MakeMaker dist_test section skipped. + +# --- MakeMaker dist_ci section skipped. + +# --- MakeMaker distmeta section: +distmeta : create_distdir metafile + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' + + + +# --- MakeMaker distsignature section: +distsignature : create_distdir + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' + $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s + + + +# --- MakeMaker install section skipped. + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE: + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) + -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) + $(PERLRUN) Makefile.PL + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" + false + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = ../perl +FULLPERL = /usr/bin/perl + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) + $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.' + +test_dynamic :: pure_all + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd: + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' David (Buzz) Bussenschutt <davidbuzz@gmail.com>, Mark Bush <Mark.Bush@bushnet.demon.co.uk>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib : $(TO_INST_PM) + $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \ + MD4.pm $(INST_LIB)/Authen/NTLM/MD4.pm + $(NOECHO) $(TOUCH) pm_to_blib + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/NTLM-1.05/MD4/Makefile.PL b/NTLM-1.05/MD4/Makefile.PL new file mode 100644 index 0000000..5687fff --- /dev/null +++ b/NTLM-1.05/MD4/Makefile.PL @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +use ExtUtils::MakeMaker; + +# + +WriteMakefile( + 'NAME' => 'Authen::NTLM::MD4', + 'VERSION_FROM' => 'MD4.pm', + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + ('AUTHOR' => 'David (Buzz) Bussenschutt , Mark Bush ') : ()), +); diff --git a/NTLM-1.05/MD4/pm_to_blib b/NTLM-1.05/MD4/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/META.yml b/NTLM-1.05/META.yml new file mode 100644 index 0000000..df2d97b --- /dev/null +++ b/NTLM-1.05/META.yml @@ -0,0 +1,15 @@ +--- #YAML:1.0 +name: Authen-NTLM +version: 1.05 +abstract: ~ +license: ~ +author: + - David (Buzz) Bussenschutt , Mark Bush +generated_by: ExtUtils::MakeMaker version 6.42 +distribution_type: module +requires: + Digest::HMAC_MD5: 0 + MIME::Base64: 0 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.3.html + version: 1.3 diff --git a/NTLM-1.05/Makefile b/NTLM-1.05/Makefile new file mode 100644 index 0000000..a2f96da --- /dev/null +++ b/NTLM-1.05/Makefile @@ -0,0 +1,793 @@ +# This Makefile is for the Authen::NTLM extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.30_01 (Revision: Revision: 4535 ) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: () +# +# MakeMaker Parameters: + +# AUTHOR => q[David (Buzz) Bussenschutt , Mark Bush ] +# DIR => [q[DES], q[MD4]] +# NAME => q[Authen::NTLM] +# PREREQ_PM => { Digest::HMAC_MD5=>q[0], MIME::Base64=>q[0] } +# VERSION_FROM => q[NTLM.pm] + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm) + +# They may have been overridden via Makefile.PL or on the command line +AR = ar +CC = cc +CCCDLFLAGS = -fPIC +CCDLFLAGS = -Wl,-E +DLEXT = so +DLSRC = dl_dlopen.xs +LD = cc +LDDLFLAGS = -shared -L/usr/local/lib +LDFLAGS = -L/usr/local/lib +LIBC = /lib/libc-2.7.so +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 2.6.24-19-server +RANLIB = : +SITELIBEXP = /usr/local/share/perl/5.8.8 +SITEARCHEXP = /usr/local/lib/perl/5.8.8 +SO = so +EXE_EXT = +FULL_AR = /usr/bin/ar +VENDORARCHEXP = /usr/lib/perl5 +VENDORLIBEXP = /usr/share/perl5 + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +DFSEP = $(DIRFILESEP) +NAME = Authen::NTLM +NAME_SYM = Authen_NTLM +VERSION = 1.05 +VERSION_MACRO = VERSION +VERSION_SYM = 1_05 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 1.05 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = blib/arch +INST_SCRIPT = blib/script +INST_BIN = blib/bin +INST_LIB = blib/lib +INST_MAN1DIR = blib/man1 +INST_MAN3DIR = blib/man3 +MAN1EXT = 1p +MAN3EXT = 3pm +INSTALLDIRS = site +DESTDIR = +PREFIX = /usr +PERLPREFIX = $(PREFIX) +SITEPREFIX = $(PREFIX)/local +VENDORPREFIX = $(PREFIX) +INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.8.8 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5 +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8 +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.8.8 +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5 +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = $(PERLPREFIX)/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = $(SITEPREFIX)/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = $(VENDORPREFIX)/bin +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = $(PERLPREFIX)/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLSITESCRIPT = $(SITEPREFIX)/bin +DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) +INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin +DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) +INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1 +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3 +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/share/perl/5.8 +PERL_ARCHLIB = /usr/lib/perl/5.8 +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = Makefile.old +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib/perl/5.8/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm +MM_VERSION = 6.30_01 +MM_REVISION = Revision: 4535 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = Authen/NTLM +BASEEXT = NTLM +PARENT_NAME = Authen +DLBASE = $(BASEEXT) +VERSION_FROM = NTLM.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic +BOOTDEP = + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = +MAN3PODS = NTLM.pm + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/Authen +INST_ARCHLIBDIR = $(INST_ARCHLIB)/Authen + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = NTLM.pm + +PM_TO_BLIB = NTLM.pm \ + $(INST_LIB)/Authen/NTLM.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 1.50_01 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(SHELL) -c true +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath +EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');' +DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install +UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist +MACROSTART = +MACROEND = +USEMAKEFILE = -f +FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)" + + +# --- MakeMaker makemakerdflt section: +makemakerdflt: all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section: +TAR = tar +TARFLAGS = cvf +ZIP = zip +ZIPFLAGS = -r +COMPRESS = gzip --best +SUFFIX = .gz +SHAR = shar +PREOP = $(NOECHO) $(NOOP) +POSTOP = $(NOECHO) $(NOOP) +TO_UNIX = $(NOECHO) $(NOOP) +CI = ci -u +RCS_LABEL = rcs -Nv$(VERSION_SYM): -q +DIST_CP = best +DIST_DEFAULT = tardist +DISTNAME = Authen-NTLM +DISTVNAME = Authen-NTLM-1.05 + + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)" + + +# --- MakeMaker special_targets section: +.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) blibdirs + $(NOECHO) $(NOOP) + +help : + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker blibdirs section: +blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP) + +# Backwards compat with 6.18 through 6.25 +blibdirs.ts : blibdirs + $(NOECHO) $(NOOP) + +$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR) + $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists + +$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHLIB) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB) + $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists + +$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR) + $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists + +$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR) + $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists + +$(INST_BIN)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_BIN) + $(NOECHO) $(CHMOD) 755 $(INST_BIN) + $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists + +$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_SCRIPT) + $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT) + $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists + +$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN1DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR) + $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists + +$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR) + $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists + + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all \ + NTLM.pm \ + NTLM.pm + $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \ + NTLM.pm $(INST_MAN3DIR)/Authen::NTLM.$(MAN3EXT) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# The default clean, realclean and test targets in this Makefile +# have automatically been given entries for each subdir. + + +subdirs :: + $(NOECHO) cd DES && $(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU) + +subdirs :: + $(NOECHO) cd MD4 && $(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU) + + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(ABSPERLRUN) -e 'chdir '\''DES'\''; system '\''$(MAKE) clean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' + $(ABSPERLRUN) -e 'chdir '\''MD4'\''; system '\''$(MAKE) clean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + - $(RM_F) \ + *$(LIB_EXT) core \ + core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \ + core.[0-9][0-9] $(BASEEXT).bso \ + pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \ + $(BASEEXT).x $(BOOTSTRAP) \ + perl$(EXE_EXT) tmon.out \ + *$(OBJ_EXT) pm_to_blib \ + $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \ + core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ + core.*perl.*.? $(MAKE_APERL_FILE) \ + $(BASEEXT).def perl \ + core.[0-9][0-9][0-9] mon.out \ + lib$(BASEEXT).def perl.exe \ + perlmain.c so_locations \ + $(BASEEXT).exp + - $(RM_RF) \ + blib + - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + - $(ABSPERLRUN) -e 'chdir '\''DES'\''; system '\''$(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) realclean'\'' if -f '\''$(MAKEFILE_OLD)'\'';' + - $(ABSPERLRUN) -e 'chdir '\''DES'\''; system '\''$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) realclean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' + - $(ABSPERLRUN) -e 'chdir '\''MD4'\''; system '\''$(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) realclean'\'' if -f '\''$(MAKEFILE_OLD)'\'';' + - $(ABSPERLRUN) -e 'chdir '\''MD4'\''; system '\''$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) realclean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' + + +# --- MakeMaker realclean section: +# Delete temporary files (via clean) and also delete dist files +realclean purge :: clean realclean_subdirs + - $(RM_F) \ + $(MAKEFILE_OLD) $(FIRST_MAKEFILE) + - $(RM_RF) \ + $(DISTVNAME) + + +# --- MakeMaker metafile section: +metafile : create_distdir + $(NOECHO) $(ECHO) Generating META.yml + $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META_new.yml + $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META_new.yml + $(NOECHO) $(ECHO) 'name: Authen-NTLM' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 1.05' >> META_new.yml + $(NOECHO) $(ECHO) 'version_from: NTLM.pm' >> META_new.yml + $(NOECHO) $(ECHO) 'installdirs: site' >> META_new.yml + $(NOECHO) $(ECHO) 'requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' Digest::HMAC_MD5: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' MIME::Base64: 0' >> META_new.yml + $(NOECHO) $(ECHO) '' >> META_new.yml + $(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml + $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.30_01' >> META_new.yml + -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml + + +# --- MakeMaker signature section: +signature : + cpansign -s + + +# --- MakeMaker dist_basics section: +distclean :: realclean distcheck + $(NOECHO) $(NOOP) + +distcheck : + $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck + +skipcheck : + $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck + +manifest : + $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest + +veryclean : realclean + $(RM_F) *~ *.orig */*~ */*.orig + + + +# --- MakeMaker dist_core section: + +dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) + $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ + -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' + +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +zipdist : $(DISTVNAME).zip + $(NOECHO) $(NOOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) + + +# --- MakeMaker distdir section: +create_distdir : + $(RM_RF) $(DISTVNAME) + $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" + +distdir : create_distdir distmeta + $(NOECHO) $(NOOP) + + + +# --- MakeMaker dist_test section: +disttest : distdir + cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL + cd $(DISTVNAME) && $(MAKE) $(PASTHRU) + cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) + + + +# --- MakeMaker dist_ci section: + +ci : + $(PERLRUN) "-MExtUtils::Manifest=maniread" \ + -e "@all = keys %{ maniread() };" \ + -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \ + -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" + + +# --- MakeMaker distmeta section: +distmeta : create_distdir metafile + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' + + + +# --- MakeMaker distsignature section: +distsignature : create_distdir + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' + $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s + + + +# --- MakeMaker install section: + +install :: all pure_install doc_install + $(NOECHO) $(NOOP) + +install_perl :: all pure_perl_install doc_perl_install + $(NOECHO) $(NOOP) + +install_site :: all pure_site_install doc_site_install + $(NOECHO) $(NOOP) + +install_vendor :: all pure_vendor_install doc_vendor_install + $(NOECHO) $(NOOP) + +pure_install :: pure_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +doc_install :: doc_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +pure__install : pure_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: + $(NOECHO) umask 022; $(MOD_INSTALL) \ + $(INST_LIB) $(DESTINSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ + $(INST_BIN) $(DESTINSTALLBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(SITEARCHEXP)/auto/$(FULLEXT) + + +pure_site_install :: + $(NOECHO) umask 02; $(MOD_INSTALL) \ + read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLSITELIB) \ + $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ + $(INST_BIN) $(DESTINSTALLSITEBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(PERL_ARCHLIB)/auto/$(FULLEXT) + +pure_vendor_install :: + $(NOECHO) umask 022; $(MOD_INSTALL) \ + $(INST_LIB) $(DESTINSTALLVENDORLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ + $(INST_BIN) $(DESTINSTALLVENDORBIN) \ + $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) + +doc_perl_install :: + +doc_site_install :: + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod + -$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH) + -$(NOECHO) umask 02; $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLSITEARCH)/perllocal.pod + +doc_vendor_install :: + + +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + $(NOECHO) $(NOOP) + +uninstall_from_perldirs :: + +uninstall_from_sitedirs :: + $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist + +uninstall_from_vendordirs :: + + + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE: + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) + -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) + $(PERLRUN) Makefile.PL + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" + false + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = perl +FULLPERL = /usr/bin/perl + +$(MAP_TARGET) :: static $(MAKE_APERL_FILE) + $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib + $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + $(NOECHO) $(PERLRUNINST) \ + Makefile.PL DIR=DES:MD4 \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = t/*.t +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) + $(NOECHO) $(ABSPERLRUN) -e 'chdir '\''DES'\''; ' \ + -e 'system '\''$(MAKE) test $(PASTHRU)'\'' ' \ + -e ' if -f '\''$(FIRST_MAKEFILE)'\'';' + $(NOECHO) $(ABSPERLRUN) -e 'chdir '\''MD4'\''; ' \ + -e 'system '\''$(MAKE) test $(PASTHRU)'\'' ' \ + -e ' if -f '\''$(FIRST_MAKEFILE)'\'';' + +test_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd: + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' David (Buzz) Bussenschutt <davidbuzz@gmail.com>, Mark Bush <Mark.Bush@bushnet.demon.co.uk>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib : $(TO_INST_PM) + $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \ + NTLM.pm $(INST_LIB)/Authen/NTLM.pm + $(NOECHO) $(TOUCH) pm_to_blib + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/NTLM-1.05/Makefile.PL b/NTLM-1.05/Makefile.PL new file mode 100644 index 0000000..86dddcb --- /dev/null +++ b/NTLM-1.05/Makefile.PL @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use ExtUtils::MakeMaker; + +# + +WriteMakefile( + 'NAME' => 'Authen::NTLM', + 'DIR' => ['DES', 'MD4'], + 'VERSION_FROM' => 'NTLM.pm', + 'PREREQ_PM' => { 'MIME::Base64' => 0, 'Digest::HMAC_MD5' => 0 }, + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + ('AUTHOR' => 'David (Buzz) Bussenschutt , Mark Bush ') : ()), +); diff --git a/NTLM-1.05/NTLM.pm b/NTLM-1.05/NTLM.pm new file mode 100644 index 0000000..5587f54 --- /dev/null +++ b/NTLM-1.05/NTLM.pm @@ -0,0 +1,499 @@ +#!/usr/local/bin/perl + +package Authen::NTLM; +use strict; +use Authen::NTLM::DES; +use Authen::NTLM::MD4; +use MIME::Base64; +use Digest::HMAC_MD5; + +use vars qw($VERSION @ISA @EXPORT); +require Exporter; + +=head1 NAME + +Authen::NTLM - An NTLM authentication module + +=head1 SYNOPSIS + + use Mail::IMAPClient; + use Authen::NTLM; + my $imap = Mail::IMAPClient->new(Server=>'imaphost'); + ntlm_user($username); + ntlm_password($password); + $imap->authenticate("NTLM", Authen::NTLM::ntlm); + : + $imap->logout; + ntlm_reset; + : + +or + + ntlmv2(1); + ntlm_user($username); + ntlm_host($host); + ntlm_password($password); + : + +or + + my $ntlm = Authen::NTLM-> new( + host => $host, + user => $username, + domain => $domain, + password => $password, + version => 1, + ); + $ntlm-> challenge; + : + $ntlm-> challenge($challenge); + + + +=head1 DESCRIPTION + + This module provides methods to use NTLM authentication. It can + be used as an authenticate method with the Mail::IMAPClient module + to perform the challenge/response mechanism for NTLM connections + or it can be used on its own for NTLM authentication with other + protocols (eg. HTTP). + + The implementation is a direct port of the code from F + which, itself, has based its NTLM implementation on F. As + such, this code is not especially efficient, however it will still + take a fraction of a second to negotiate a login on a PII which is + likely to be good enough for most situations. + +=head2 FUNCTIONS + +=over 4 + +=item ntlm_domain() + + Set the domain to use in the NTLM authentication messages. + Returns the new domain. Without an argument, this function + returns the current domain entry. + +=item ntlm_user() + + Set the username to use in the NTLM authentication messages. + Returns the new username. Without an argument, this function + returns the current username entry. + +=item ntlm_password() + + Set the password to use in the NTLM authentication messages. + Returns the new password. Without an argument, this function + returns the current password entry. + +=item ntlm_reset() + + Resets the NTLM challenge/response state machine so that the next + call to C will produce an initial connect message. + +=item ntlm() + + Generate a reply to a challenge. The NTLM protocol involves an + initial empty challenge from the server requiring a message + response containing the username and domain (which may be empty). + The first call to C generates this first message ignoring + any arguments. + + The second time it is called, it is assumed that the argument is + the challenge string sent from the server. This will contain 8 + bytes of data which are used in the DES functions to generate the + response authentication strings. The result of the call is the + final authentication string. + + If C is called, then the next call to C will + start the process again allowing multiple authentications within + an application. + +=item ntlmv2() + + Use NTLM v2 authentication. + +=back + +=head2 OBJECT API + +=over + +=item new %options + +Creates an object that accepts the following options: C, C, +C, C, C. + +=item challenge [$challenge] + +If C<$challenge> is not supplied, first-stage challenge string is generated. +Otherwise, the third-stage challenge is generated, where C<$challenge> is +assumed to be extracted from the second stage of NTLM exchange. The result of +the call is the final authentication string. + +=back + +=head1 AUTHOR + + David (Buzz) Bussenschutt - current maintainer + Dmitry Karasik - nice ntlmv2 patch, OO extensions. + Andrew Hobson - initial ntlmv2 code + Mark Bush - perl port + Eric S. Raymond - author of fetchmail + Andrew Tridgell and Jeremy Allison for SMB/Netbios code + +=head1 SEE ALSO + +L, L, L + +=head1 HISTORY + + 1.05 - add OO interface by Dmitry Karasik + 1.04 - implementation of NTLMv2 by Andrew Hobson/Dmitry Karasik + 1.03 - fixes long-standing 1 line bug L - released by David Bussenschutt 9th Aug 2007 + 1.02 - released by Mark Bush 29th Oct 2001 + +=cut + +$VERSION = "1.05"; +@ISA = qw(Exporter); +@EXPORT = qw(ntlm ntlm_domain ntlm_user ntlm_password ntlm_reset ntlm_host ntlmv2); + +my $domain = ""; +my $user = ""; +my $password = ""; + +my $str_hdr = "vvV"; +my $hdr_len = 8; +my $ident = "NTLMSSP"; + +my $msg1_f = 0x0000b207; +my $msg1 = "Z8VV"; +my $msg1_hlen = 16 + ($hdr_len*2); + +my $msg2 = "Z8Va${hdr_len}Va8a8a${hdr_len}"; +my $msg2_hlen = 12 + $hdr_len + 20 + $hdr_len; + +my $msg3 = "Z8V"; +my $msg3_tl = "V"; +my $msg3_hlen = 12 + ($hdr_len*6) + 4; + +my $state = 0; + +my $host = ""; +my $ntlm_v2 = 0; +my $ntlm_v2_msg3_flags = 0x88205; + + +# Domain Name supplied on negotiate +use constant NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED => 0x00001000; +# Workstation Name supplied on negotiate +use constant NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED => 0x00002000; +# Try to use NTLMv2 +use constant NTLMSSP_NEGOTIATE_NTLM2 => 0x00080000; + + +# Object API + +sub new +{ + my ( $class, %opt) = @_; + for (qw(domain user password host)) { + $opt{$_} = "" unless defined $opt{$_}; + } + $opt{version} ||= 1; + return bless { %opt }, $class; +} + +sub challenge +{ + my ( $self, $challenge) = @_; + $state = defined $challenge; + ($user,$domain,$password,$host) = @{$self}{qw(user domain password host)}; + $ntlm_v2 = ($self-> {version} > 1) ? 1 : 0; + return ntlm($challenge); +} + +eval "sub $_ { \$#_ ? \$_[0]->{$_} = \$_[1] : \$_[0]->{$_} }" + for qw(user domain password host version); + +# Function API + +sub ntlm_domain +{ + if (@_) + { + $domain = shift; + } + return $domain; +} + +sub ntlm_user +{ + if (@_) + { + $user = shift; + } + return $user; +} + +sub ntlm_password +{ + if (@_) + { + $password = shift; + } + return $password; +} + +sub ntlm_reset +{ + $state = 0; +} + +sub ntlmv2 +{ + if (@_) { + $ntlm_v2 = shift; + } + return $ntlm_v2; +} + +sub ntlm_host { + if (@_) { + $host = shift; + } + return $host; +} + +sub ntlm +{ + my ($challenge) = @_; + + my ($flags, $user_hdr, $domain_hdr, + $u_off, $d_off, $c_info, $lmResp, $ntResp, $lm_hdr, + $nt_hdr, $wks_hdr, $session_hdr, $lm_off, $nt_off, + $wks_off, $s_off, $u_user, $msg1_host, $host_hdr, $u_host); + my $response; + if ($state) + { + + $challenge =~ s/^\s*//; + $challenge = decode_base64($challenge); + $c_info = &decode_challenge($challenge); + $u_user = &unicode($user); + if (!$ntlm_v2) { + $domain = substr($challenge, $c_info->{domain}{offset}, $c_info->{domain}{len}); + $lmResp = &lmEncrypt($c_info->{data}); + $ntResp = &ntEncrypt($c_info->{data}); + $flags = pack($msg3_tl, $c_info->{flags}); + } else { + $lmResp = &lmv2Encrypt($c_info->{data}); + $ntResp = &ntv2Encrypt($c_info->{data}, $c_info->{target_data}); + $flags = pack($msg3_tl, $ntlm_v2_msg3_flags); + } + $u_host = &unicode(($host ? $host : $user)); + $response = pack($msg3, $ident, 3); + + $lm_off = $msg3_hlen; + $nt_off = $lm_off + length($lmResp); + $d_off = $nt_off + length($ntResp); + $u_off = $d_off + length($domain); + $wks_off = $u_off + length($u_user); + $s_off = $wks_off + length($u_host); + $lm_hdr = &hdr($lmResp, $msg3_hlen, $lm_off); + $nt_hdr = &hdr($ntResp, $msg3_hlen, $nt_off); + $domain_hdr = &hdr($domain, $msg3_hlen, $d_off); + $user_hdr = &hdr($u_user, $msg3_hlen, $u_off); + $wks_hdr = &hdr($u_host, $msg3_hlen, $wks_off); + $session_hdr = &hdr("", $msg3_hlen, $s_off); + $response .= $lm_hdr . $nt_hdr . $domain_hdr . $user_hdr . + $wks_hdr . $session_hdr . $flags . + $lmResp . $ntResp . $domain . $u_user . $u_host; + } + else # first response; + { + my $f = $msg1_f; + if (!length $domain) { + $f &= ~NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED; + } + $msg1_host = $user; + if ($ntlm_v2) { + $f &= ~NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED; + $f |= NTLMSSP_NEGOTIATE_NTLM2; + $msg1_host = ""; + } + + $response = pack($msg1, $ident, 1, $f); + $u_off = $msg1_hlen; + $d_off = $u_off + length($msg1_host); + $host_hdr = &hdr($msg1_host, $msg1_hlen, $u_off); + $domain_hdr = &hdr($domain, $msg1_hlen, $d_off); + $response .= $host_hdr . $domain_hdr . $msg1_host . $domain; + $state = 1; + } + return encode_base64($response, ""); +} + +sub hdr +{ + my ($string, $h_len, $offset) = @_; + + my ($res, $len); + $len = length($string); + if ($string) + { + $res = pack($str_hdr, $len, $len, $offset); + } + else + { + $res = pack($str_hdr, 0, 0, $offset - $h_len); + } + return $res; +} + +sub decode_challenge +{ + my ($challenge) = @_; + + my $res; + my (@res, @hdr); + my $original = $challenge; + + $res->{buffer} = substr($challenge, $msg2_hlen); + $challenge = substr($challenge, 0, $msg2_hlen); + @res = unpack($msg2, $challenge); + $res->{ident} = $res[0]; + $res->{type} = $res[1]; + @hdr = unpack($str_hdr, $res[2]); + $res->{domain}{len} = $hdr[0]; + $res->{domain}{maxlen} = $hdr[1]; + $res->{domain}{offset} = $hdr[2]; + $res->{flags} = $res[3]; + $res->{data} = $res[4]; + $res->{reserved} = $res[5]; + $res->{empty_hdr} = $res[6]; + @hdr = unpack($str_hdr, $res[6]); + $res->{target}{len} = $hdr[0]; + $res->{target}{maxlen} = $hdr[1]; + $res->{target}{offset} = $hdr[2]; + $res->{target_data} = substr($original, $hdr[2], $hdr[1]); + + return $res; +} + +sub unicode +{ + my ($string) = @_; + my ($reply, $c, $z) = (''); + + $z = sprintf "%c", 0; + foreach $c (split //, $string) + { + $reply .= $c . $z; + } + return $reply; +} + +sub NTunicode +{ + my ($string) = @_; + my ($reply, $c); + + foreach $c (map {ord($_)} split(//, $string)) + { + $reply .= pack("v", $c); + } + return $reply; +} + +sub lmEncrypt +{ + my ($data) = @_; + + my $p14 = substr($password, 0, 14); + $p14 =~ tr/a-z/A-Z/; + $p14 .= "\0"x(14-length($p14)); + my $p21 = E_P16($p14); + $p21 .= "\0"x(21-length($p21)); + my $p24 = E_P24($p21, $data); + return $p24; +} + +sub ntEncrypt +{ + my ($data) = @_; + + my $p21 = &E_md4hash; + $p21 .= "\0"x(21-length($p21)); + my $p24 = E_P24($p21, $data); + return $p24; +} + +sub E_md4hash +{ + my $wpwd = &NTunicode($password); + my $p16 = mdfour($wpwd); + return $p16; +} + +sub lmv2Encrypt { + my ($data) = @_; + + my $u_pass = &unicode($password); + my $ntlm_hash = mdfour($u_pass); + + my $u_user = &unicode("\U$user\E"); + my $u_domain = &unicode("$domain"); + my $concat = $u_user . $u_domain; + + my $hmac = Digest::HMAC_MD5->new($ntlm_hash); + $hmac->add($concat); + my $ntlm_v2_hash = $hmac->digest; + + # Firefox seems to use this as its random challenge + my $random_challenge = "\0" x 8; + + my $concat2 = $data . $random_challenge; + + $hmac = Digest::HMAC_MD5->new($ntlm_v2_hash); + $hmac->add(substr($data, 0, 8) . $random_challenge); + my $r = $hmac->digest . $random_challenge; + + return $r; +} + +sub ntv2Encrypt { + my ($data, $target) = @_; + + my $u_pass = &unicode($password); + my $ntlm_hash = mdfour($u_pass); + + my $u_user = &unicode("\U$user\E"); + my $u_domain = &unicode("$domain"); + my $concat = $u_user . $u_domain; + + my $hmac = Digest::HMAC_MD5->new($ntlm_hash); + $hmac->add($concat); + my $ntlm_v2_hash = $hmac->digest; + + my $zero_long = "\000" x 4; + my $sig = pack("H8", "01010000"); + my $time = pack("VV", (time + 11644473600) + 10000000); + my $rand = "\0" x 8; + my $blob = $sig . $zero_long . $time . $rand . $zero_long . + $target . $zero_long; + + $concat = $data . $blob; + + $hmac = Digest::HMAC_MD5->new($ntlm_v2_hash); + $hmac->add($concat); + + my $d = $hmac->digest; + + my $r = $d . $blob; + + return $r; +} + +1; diff --git a/NTLM-1.05/README b/NTLM-1.05/README new file mode 100644 index 0000000..12c9c14 --- /dev/null +++ b/NTLM-1.05/README @@ -0,0 +1,65 @@ +NTLM Authentication Scheme +========================== + +This module implements the NTLM authentication mechanism. It can be +used to perform NTLM style authentication for any desired protocol. + +The module works well with the Mail::IMAPClient module in the +"authenticate" method, however I had to make a change to that method +for it to work. The following line (2511 in version 2.1.4): + + ($code) = $o->[DATA] =~ /^\+ (.*)$/ ; + +needed to be changed to: + + ($code) = $o->[DATA] =~ /^\+(.*)$/ ; + +as the initial NTLM challenge is empty. + +This module also works well with LWP::Authen::Ntlm , allowing LWP::UserAgent +and/or WWW::Mechanise to automate/browse/fetch/etc remote Microsoft Windows +servers running NTLM authentication. +Example use is like this(note the fact that NTLM.pm is NOT explicitly used!): + + use WWW::Mechanize; + $mech = WWW::Mechanize->new(keep_alive=>1); + $mech->no_proxy('my.server'); + $mech->credentials('my.server:80', '', "my_domain\\my_user", my_pass); + $response = $mech->get( $url ); + + +INSTALLATION + +To install this application: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires the MIME::Base64 module, and Digest::HMAC_MD5 + +COPYRIGHT AND LICENCE + +This application is free software. This code is distributed in the hope that +it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. You may freely use, +copy and distribute this software as long as all copyright notices, including +this notice, remain intact and that you do not try to claim it as your own or +try to sell it. You may alter the code as long as you send me any diffs (this +will ensure that you have an easier time of it when you upgrade ;). + +Parts of this code Copyright (C) 2007 David (Buzz) Bussenschutt. + + +Perl port of this code is Copyright (C) 2001 Mark Bush. + + +The code is originally based on fetchmail code which is Copyright (C) 1997 Eric +S. Raymond. + +Fetchmail uses SMB/Netbios code from samba which is Copyright (C) +Andrew Tridgell 1992-1998 with modifications from Jeremy Allison. + diff --git a/NTLM-1.05/blib/arch/.exists b/NTLM-1.05/blib/arch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/arch/auto/Authen/NTLM/.exists b/NTLM-1.05/blib/arch/auto/Authen/NTLM/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/arch/auto/Authen/NTLM/DES/.exists b/NTLM-1.05/blib/arch/auto/Authen/NTLM/DES/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/arch/auto/Authen/NTLM/MD4/.exists b/NTLM-1.05/blib/arch/auto/Authen/NTLM/MD4/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/bin/.exists b/NTLM-1.05/blib/bin/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/lib/Authen/.exists b/NTLM-1.05/blib/lib/Authen/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/lib/Authen/NTLM.pm b/NTLM-1.05/blib/lib/Authen/NTLM.pm new file mode 100644 index 0000000..5587f54 --- /dev/null +++ b/NTLM-1.05/blib/lib/Authen/NTLM.pm @@ -0,0 +1,499 @@ +#!/usr/local/bin/perl + +package Authen::NTLM; +use strict; +use Authen::NTLM::DES; +use Authen::NTLM::MD4; +use MIME::Base64; +use Digest::HMAC_MD5; + +use vars qw($VERSION @ISA @EXPORT); +require Exporter; + +=head1 NAME + +Authen::NTLM - An NTLM authentication module + +=head1 SYNOPSIS + + use Mail::IMAPClient; + use Authen::NTLM; + my $imap = Mail::IMAPClient->new(Server=>'imaphost'); + ntlm_user($username); + ntlm_password($password); + $imap->authenticate("NTLM", Authen::NTLM::ntlm); + : + $imap->logout; + ntlm_reset; + : + +or + + ntlmv2(1); + ntlm_user($username); + ntlm_host($host); + ntlm_password($password); + : + +or + + my $ntlm = Authen::NTLM-> new( + host => $host, + user => $username, + domain => $domain, + password => $password, + version => 1, + ); + $ntlm-> challenge; + : + $ntlm-> challenge($challenge); + + + +=head1 DESCRIPTION + + This module provides methods to use NTLM authentication. It can + be used as an authenticate method with the Mail::IMAPClient module + to perform the challenge/response mechanism for NTLM connections + or it can be used on its own for NTLM authentication with other + protocols (eg. HTTP). + + The implementation is a direct port of the code from F + which, itself, has based its NTLM implementation on F. As + such, this code is not especially efficient, however it will still + take a fraction of a second to negotiate a login on a PII which is + likely to be good enough for most situations. + +=head2 FUNCTIONS + +=over 4 + +=item ntlm_domain() + + Set the domain to use in the NTLM authentication messages. + Returns the new domain. Without an argument, this function + returns the current domain entry. + +=item ntlm_user() + + Set the username to use in the NTLM authentication messages. + Returns the new username. Without an argument, this function + returns the current username entry. + +=item ntlm_password() + + Set the password to use in the NTLM authentication messages. + Returns the new password. Without an argument, this function + returns the current password entry. + +=item ntlm_reset() + + Resets the NTLM challenge/response state machine so that the next + call to C will produce an initial connect message. + +=item ntlm() + + Generate a reply to a challenge. The NTLM protocol involves an + initial empty challenge from the server requiring a message + response containing the username and domain (which may be empty). + The first call to C generates this first message ignoring + any arguments. + + The second time it is called, it is assumed that the argument is + the challenge string sent from the server. This will contain 8 + bytes of data which are used in the DES functions to generate the + response authentication strings. The result of the call is the + final authentication string. + + If C is called, then the next call to C will + start the process again allowing multiple authentications within + an application. + +=item ntlmv2() + + Use NTLM v2 authentication. + +=back + +=head2 OBJECT API + +=over + +=item new %options + +Creates an object that accepts the following options: C, C, +C, C, C. + +=item challenge [$challenge] + +If C<$challenge> is not supplied, first-stage challenge string is generated. +Otherwise, the third-stage challenge is generated, where C<$challenge> is +assumed to be extracted from the second stage of NTLM exchange. The result of +the call is the final authentication string. + +=back + +=head1 AUTHOR + + David (Buzz) Bussenschutt - current maintainer + Dmitry Karasik - nice ntlmv2 patch, OO extensions. + Andrew Hobson - initial ntlmv2 code + Mark Bush - perl port + Eric S. Raymond - author of fetchmail + Andrew Tridgell and Jeremy Allison for SMB/Netbios code + +=head1 SEE ALSO + +L, L, L + +=head1 HISTORY + + 1.05 - add OO interface by Dmitry Karasik + 1.04 - implementation of NTLMv2 by Andrew Hobson/Dmitry Karasik + 1.03 - fixes long-standing 1 line bug L - released by David Bussenschutt 9th Aug 2007 + 1.02 - released by Mark Bush 29th Oct 2001 + +=cut + +$VERSION = "1.05"; +@ISA = qw(Exporter); +@EXPORT = qw(ntlm ntlm_domain ntlm_user ntlm_password ntlm_reset ntlm_host ntlmv2); + +my $domain = ""; +my $user = ""; +my $password = ""; + +my $str_hdr = "vvV"; +my $hdr_len = 8; +my $ident = "NTLMSSP"; + +my $msg1_f = 0x0000b207; +my $msg1 = "Z8VV"; +my $msg1_hlen = 16 + ($hdr_len*2); + +my $msg2 = "Z8Va${hdr_len}Va8a8a${hdr_len}"; +my $msg2_hlen = 12 + $hdr_len + 20 + $hdr_len; + +my $msg3 = "Z8V"; +my $msg3_tl = "V"; +my $msg3_hlen = 12 + ($hdr_len*6) + 4; + +my $state = 0; + +my $host = ""; +my $ntlm_v2 = 0; +my $ntlm_v2_msg3_flags = 0x88205; + + +# Domain Name supplied on negotiate +use constant NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED => 0x00001000; +# Workstation Name supplied on negotiate +use constant NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED => 0x00002000; +# Try to use NTLMv2 +use constant NTLMSSP_NEGOTIATE_NTLM2 => 0x00080000; + + +# Object API + +sub new +{ + my ( $class, %opt) = @_; + for (qw(domain user password host)) { + $opt{$_} = "" unless defined $opt{$_}; + } + $opt{version} ||= 1; + return bless { %opt }, $class; +} + +sub challenge +{ + my ( $self, $challenge) = @_; + $state = defined $challenge; + ($user,$domain,$password,$host) = @{$self}{qw(user domain password host)}; + $ntlm_v2 = ($self-> {version} > 1) ? 1 : 0; + return ntlm($challenge); +} + +eval "sub $_ { \$#_ ? \$_[0]->{$_} = \$_[1] : \$_[0]->{$_} }" + for qw(user domain password host version); + +# Function API + +sub ntlm_domain +{ + if (@_) + { + $domain = shift; + } + return $domain; +} + +sub ntlm_user +{ + if (@_) + { + $user = shift; + } + return $user; +} + +sub ntlm_password +{ + if (@_) + { + $password = shift; + } + return $password; +} + +sub ntlm_reset +{ + $state = 0; +} + +sub ntlmv2 +{ + if (@_) { + $ntlm_v2 = shift; + } + return $ntlm_v2; +} + +sub ntlm_host { + if (@_) { + $host = shift; + } + return $host; +} + +sub ntlm +{ + my ($challenge) = @_; + + my ($flags, $user_hdr, $domain_hdr, + $u_off, $d_off, $c_info, $lmResp, $ntResp, $lm_hdr, + $nt_hdr, $wks_hdr, $session_hdr, $lm_off, $nt_off, + $wks_off, $s_off, $u_user, $msg1_host, $host_hdr, $u_host); + my $response; + if ($state) + { + + $challenge =~ s/^\s*//; + $challenge = decode_base64($challenge); + $c_info = &decode_challenge($challenge); + $u_user = &unicode($user); + if (!$ntlm_v2) { + $domain = substr($challenge, $c_info->{domain}{offset}, $c_info->{domain}{len}); + $lmResp = &lmEncrypt($c_info->{data}); + $ntResp = &ntEncrypt($c_info->{data}); + $flags = pack($msg3_tl, $c_info->{flags}); + } else { + $lmResp = &lmv2Encrypt($c_info->{data}); + $ntResp = &ntv2Encrypt($c_info->{data}, $c_info->{target_data}); + $flags = pack($msg3_tl, $ntlm_v2_msg3_flags); + } + $u_host = &unicode(($host ? $host : $user)); + $response = pack($msg3, $ident, 3); + + $lm_off = $msg3_hlen; + $nt_off = $lm_off + length($lmResp); + $d_off = $nt_off + length($ntResp); + $u_off = $d_off + length($domain); + $wks_off = $u_off + length($u_user); + $s_off = $wks_off + length($u_host); + $lm_hdr = &hdr($lmResp, $msg3_hlen, $lm_off); + $nt_hdr = &hdr($ntResp, $msg3_hlen, $nt_off); + $domain_hdr = &hdr($domain, $msg3_hlen, $d_off); + $user_hdr = &hdr($u_user, $msg3_hlen, $u_off); + $wks_hdr = &hdr($u_host, $msg3_hlen, $wks_off); + $session_hdr = &hdr("", $msg3_hlen, $s_off); + $response .= $lm_hdr . $nt_hdr . $domain_hdr . $user_hdr . + $wks_hdr . $session_hdr . $flags . + $lmResp . $ntResp . $domain . $u_user . $u_host; + } + else # first response; + { + my $f = $msg1_f; + if (!length $domain) { + $f &= ~NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED; + } + $msg1_host = $user; + if ($ntlm_v2) { + $f &= ~NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED; + $f |= NTLMSSP_NEGOTIATE_NTLM2; + $msg1_host = ""; + } + + $response = pack($msg1, $ident, 1, $f); + $u_off = $msg1_hlen; + $d_off = $u_off + length($msg1_host); + $host_hdr = &hdr($msg1_host, $msg1_hlen, $u_off); + $domain_hdr = &hdr($domain, $msg1_hlen, $d_off); + $response .= $host_hdr . $domain_hdr . $msg1_host . $domain; + $state = 1; + } + return encode_base64($response, ""); +} + +sub hdr +{ + my ($string, $h_len, $offset) = @_; + + my ($res, $len); + $len = length($string); + if ($string) + { + $res = pack($str_hdr, $len, $len, $offset); + } + else + { + $res = pack($str_hdr, 0, 0, $offset - $h_len); + } + return $res; +} + +sub decode_challenge +{ + my ($challenge) = @_; + + my $res; + my (@res, @hdr); + my $original = $challenge; + + $res->{buffer} = substr($challenge, $msg2_hlen); + $challenge = substr($challenge, 0, $msg2_hlen); + @res = unpack($msg2, $challenge); + $res->{ident} = $res[0]; + $res->{type} = $res[1]; + @hdr = unpack($str_hdr, $res[2]); + $res->{domain}{len} = $hdr[0]; + $res->{domain}{maxlen} = $hdr[1]; + $res->{domain}{offset} = $hdr[2]; + $res->{flags} = $res[3]; + $res->{data} = $res[4]; + $res->{reserved} = $res[5]; + $res->{empty_hdr} = $res[6]; + @hdr = unpack($str_hdr, $res[6]); + $res->{target}{len} = $hdr[0]; + $res->{target}{maxlen} = $hdr[1]; + $res->{target}{offset} = $hdr[2]; + $res->{target_data} = substr($original, $hdr[2], $hdr[1]); + + return $res; +} + +sub unicode +{ + my ($string) = @_; + my ($reply, $c, $z) = (''); + + $z = sprintf "%c", 0; + foreach $c (split //, $string) + { + $reply .= $c . $z; + } + return $reply; +} + +sub NTunicode +{ + my ($string) = @_; + my ($reply, $c); + + foreach $c (map {ord($_)} split(//, $string)) + { + $reply .= pack("v", $c); + } + return $reply; +} + +sub lmEncrypt +{ + my ($data) = @_; + + my $p14 = substr($password, 0, 14); + $p14 =~ tr/a-z/A-Z/; + $p14 .= "\0"x(14-length($p14)); + my $p21 = E_P16($p14); + $p21 .= "\0"x(21-length($p21)); + my $p24 = E_P24($p21, $data); + return $p24; +} + +sub ntEncrypt +{ + my ($data) = @_; + + my $p21 = &E_md4hash; + $p21 .= "\0"x(21-length($p21)); + my $p24 = E_P24($p21, $data); + return $p24; +} + +sub E_md4hash +{ + my $wpwd = &NTunicode($password); + my $p16 = mdfour($wpwd); + return $p16; +} + +sub lmv2Encrypt { + my ($data) = @_; + + my $u_pass = &unicode($password); + my $ntlm_hash = mdfour($u_pass); + + my $u_user = &unicode("\U$user\E"); + my $u_domain = &unicode("$domain"); + my $concat = $u_user . $u_domain; + + my $hmac = Digest::HMAC_MD5->new($ntlm_hash); + $hmac->add($concat); + my $ntlm_v2_hash = $hmac->digest; + + # Firefox seems to use this as its random challenge + my $random_challenge = "\0" x 8; + + my $concat2 = $data . $random_challenge; + + $hmac = Digest::HMAC_MD5->new($ntlm_v2_hash); + $hmac->add(substr($data, 0, 8) . $random_challenge); + my $r = $hmac->digest . $random_challenge; + + return $r; +} + +sub ntv2Encrypt { + my ($data, $target) = @_; + + my $u_pass = &unicode($password); + my $ntlm_hash = mdfour($u_pass); + + my $u_user = &unicode("\U$user\E"); + my $u_domain = &unicode("$domain"); + my $concat = $u_user . $u_domain; + + my $hmac = Digest::HMAC_MD5->new($ntlm_hash); + $hmac->add($concat); + my $ntlm_v2_hash = $hmac->digest; + + my $zero_long = "\000" x 4; + my $sig = pack("H8", "01010000"); + my $time = pack("VV", (time + 11644473600) + 10000000); + my $rand = "\0" x 8; + my $blob = $sig . $zero_long . $time . $rand . $zero_long . + $target . $zero_long; + + $concat = $data . $blob; + + $hmac = Digest::HMAC_MD5->new($ntlm_v2_hash); + $hmac->add($concat); + + my $d = $hmac->digest; + + my $r = $d . $blob; + + return $r; +} + +1; diff --git a/NTLM-1.05/blib/lib/Authen/NTLM/.exists b/NTLM-1.05/blib/lib/Authen/NTLM/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/lib/Authen/NTLM/DES.pm b/NTLM-1.05/blib/lib/Authen/NTLM/DES.pm new file mode 100644 index 0000000..04ab365 --- /dev/null +++ b/NTLM-1.05/blib/lib/Authen/NTLM/DES.pm @@ -0,0 +1,294 @@ +#!/usr/local/bin/perl +# +# This is an implementation of part of the DES specification. According +# to the code this is ported from, this code does NOT enable 2-way +# encryption and is, hence, not a cypher and does not appear to come +# under any export restrictions on such. +# +package Authen::NTLM::DES; + +use vars qw($VERSION @ISA @EXPORT); +require Exporter; + +$VERSION = "1.02"; +@ISA = qw(Exporter); +@EXPORT = qw(E_P16 E_P24); + +my ($loop, $loop2); +$loop = 0; +$loop2 = 0; + +my $perm1 = [57, 49, 41, 33, 25, 17, 9, + 1, 58, 50, 42, 34, 26, 18, + 10, 2, 59, 51, 43, 35, 27, + 19, 11, 3, 60, 52, 44, 36, + 63, 55, 47, 39, 31, 23, 15, + 7, 62, 54, 46, 38, 30, 22, + 14, 6, 61, 53, 45, 37, 29, + 21, 13, 5, 28, 20, 12, 4]; +my $perm2 = [14, 17, 11, 24, 1, 5, + 3, 28, 15, 6, 21, 10, + 23, 19, 12, 4, 26, 8, + 16, 7, 27, 20, 13, 2, + 41, 52, 31, 37, 47, 55, + 30, 40, 51, 45, 33, 48, + 44, 49, 39, 56, 34, 53, + 46, 42, 50, 36, 29, 32]; +my $perm3 = [58, 50, 42, 34, 26, 18, 10, 2, + 60, 52, 44, 36, 28, 20, 12, 4, + 62, 54, 46, 38, 30, 22, 14, 6, + 64, 56, 48, 40, 32, 24, 16, 8, + 57, 49, 41, 33, 25, 17, 9, 1, + 59, 51, 43, 35, 27, 19, 11, 3, + 61, 53, 45, 37, 29, 21, 13, 5, + 63, 55, 47, 39, 31, 23, 15, 7]; +my $perm4 = [32, 1, 2, 3, 4, 5, + 4, 5, 6, 7, 8, 9, + 8, 9, 10, 11, 12, 13, + 12, 13, 14, 15, 16, 17, + 16, 17, 18, 19, 20, 21, + 20, 21, 22, 23, 24, 25, + 24, 25, 26, 27, 28, 29, + 28, 29, 30, 31, 32, 1]; +my $perm5 = [16, 7, 20, 21, 29, 12, 28, 17, + 1, 15, 23, 26, 5, 18, 31, 10, + 2, 8, 24, 14, 32, 27, 3, 9, + 19, 13, 30, 6, 22, 11, 4, 25]; +my $perm6 = [40, 8, 48, 16, 56, 24, 64, 32, + 39, 7, 47, 15, 55, 23, 63, 31, + 38, 6, 46, 14, 54, 22, 62, 30, + 37, 5, 45, 13, 53, 21, 61, 29, + 36, 4, 44, 12, 52, 20, 60, 28, + 35, 3, 43, 11, 51, 19, 59, 27, + 34, 2, 42, 10, 50, 18, 58, 26, + 33, 1, 41, 9, 49, 17, 57, 25]; +my $sc = [1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1]; +my $sbox = [ +[ +[14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7], +[0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8], +[4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0], +[15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13] +], +[ +[15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10], +[3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5], +[0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15], +[13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9] +], +[ +[10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8], +[13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1], +[13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7], +[1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12] +], +[ +[7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15], +[13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9], +[10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4], +[3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14] +], +[ +[2,12,4,1,7,10,11,6,8,5,3,15,13,0,14,9], +[14,11,2,12,4,7,13,1,5,0,15,10,3,9,8,6], +[4,2,1,11,10,13,7,8,15,9,12,5,6,3,0,14], +[11,8,12,7,1,14,2,13,6,15,0,9,10,4,5,3] +], +[ +[12,1,10,15,9,2,6,8,0,13,3,4,14,7,5,11], +[10,15,4,2,7,12,9,5,6,1,13,14,0,11,3,8], +[9,14,15,5,2,8,12,3,7,0,4,10,1,13,11,6], +[4,3,2,12,9,5,15,10,11,14,1,7,6,0,8,13] +], +[ +[4,11,2,14,15,0,8,13,3,12,9,7,5,10,6,1], +[13,0,11,7,4,9,1,10,14,3,5,12,2,15,8,6], +[1,4,11,13,12,3,7,14,10,15,6,8,0,5,9,2], +[6,11,13,8,1,4,10,7,9,5,0,15,14,2,3,12] +], +[ +[13,2,8,4,6,15,11,1,10,9,3,14,5,0,12,7], +[1,15,13,8,10,3,7,4,12,5,6,11,0,14,9,2], +[7,11,4,1,9,12,14,2,0,6,10,13,15,3,5,8], +[2,1,14,7,4,10,8,13,15,12,9,0,3,5,6,11] +] +]; + +sub E_P16 +{ + my ($p14) = @_; + my $sp8 = [0x4b, 0x47, 0x53, 0x21, 0x40, 0x23, 0x24, 0x25]; + + my $p7 = substr($p14, 0, 7); + my $p16 = smbhash($sp8, $p7); + $p7 = substr($p14, 7, 7); + $p16 .= smbhash($sp8, $p7); + return $p16; +} + +sub E_P24 +{ + my ($p21, $c8_str) = @_; + my @c8 = map {ord($_)} split(//, $c8_str); + my $p24 = smbhash(\@c8, substr($p21, 0, 7)); + $p24 .= smbhash(\@c8, substr($p21, 7, 7)); + $p24 .= smbhash(\@c8, substr($p21, 14, 7)); +} + +sub permute +{ + my ($out, $in, $p, $n) = @_; + my $i; + + foreach $i (0..($n-1)) + { + $out->[$i] = $in->[$p->[$i]-1]; + } +} + +sub lshift +{ + my ($d, $count, $n) = @_; + my (@out, $i); + + foreach $i (0..($n-1)) + { + $out[$i] = $d->[($i+$count)%$n]; + } + foreach $i (0..($n-1)) + { + $d->[$i] = $out[$i]; + } +} + +sub xor +{ + my ($out, $in1, $in2, $n) = @_; + my $i; + + foreach $i (0..($n-1)) + { + $out->[$i] = $in1->[$i]^$in2->[$i]; + } +} + +sub dohash +{ + my ($out, $in, $key) = @_; + my ($i, $j, $k, @pk1, @c, @d, @cd, + @ki, @pd1, @l, @r, @rl); + + &permute(\@pk1, $key, $perm1, 56); + + foreach $i (0..27) + { + $c[$i] = $pk1[$i]; + $d[$i] = $pk1[$i+28]; + } + foreach $i (0..15) + { + my @array; + &lshift(\@c, $sc->[$i], 28); + &lshift(\@d, $sc->[$i], 28); + @cd = (@c, @d); + &permute(\@array, \@cd, $perm2, 48); + $ki[$i] = \@array; + } + &permute(\@pd1, $in, $perm3, 64); + + foreach $j (0..31) + { + $l[$j] = $pd1[$j]; + $r[$j] = $pd1[$j+32]; + } + + foreach $i (0..15) + { + local (@er, @erk, @b, @cb, @pcb, @r2); + permute(\@er, \@r, $perm4, 48); + &xor(\@erk, \@er, $ki[$i], 48); + foreach $j (0..7) + { + foreach $k (0..5) + { + $b[$j][$k] = $erk[$j*6+$k]; + } + } + foreach $j (0..7) + { + local ($m, $n); + $m = ($b[$j][0]<<1) | $b[$j][5]; + $n = ($b[$j][1]<<3) | ($b[$j][2]<<2) | ($b[$j][3]<<1) | $b[$j][4]; + foreach $k (0..3) + { + $b[$j][$k] = ($sbox->[$j][$m][$n] & (1<<(3-$k)))? 1: 0; + } + } + foreach $j (0..7) + { + foreach $k (0..3) + { + $cb[$j*4+$k] = $b[$j][$k]; + } + } + &permute(\@pcb, \@cb, $perm5, 32); + &xor(\@r2, \@l, \@pcb, 32); + foreach $j (0..31) + { + $l[$j] = $r[$j]; + $r[$j] = $r2[$j]; + } + } + @rl = (@r, @l); + &permute($out, \@rl, $perm6, 64); +} + +sub str_to_key +{ + my ($str) = @_; + my $i; + my @key; + my $out; + my @str = map {ord($_)} split(//, $str); + $key[0] = $str[0]>>1; + $key[1] = (($str[0]&0x01)<<6) | ($str[1]>>2); + $key[2] = (($str[1]&0x03)<<5) | ($str[2]>>3); + $key[3] = (($str[2]&0x07)<<4) | ($str[3]>>4); + $key[4] = (($str[3]&0x0f)<<3) | ($str[4]>>5); + $key[5] = (($str[4]&0x1f)<<2) | ($str[5]>>6); + $key[6] = (($str[5]&0x3f)<<1) | ($str[6]>>7); + $key[7] = $str[6]&0x7f; + foreach $i (0..7) + { + $key[$i] = 0xff&($key[$i]<<1); + } + return \@key; +} + +sub smbhash +{ + my ($in, $key) = @_; + + my $key2 = &str_to_key($key); + my ($i, $div, $mod, @in, @outb, @inb, @keyb, @out); + foreach $i (0..63) + { + $div = int($i/8); $mod = $i%8; + $inb[$i] = ($in->[$div] & (1<<(7-($mod))))? 1: 0; + $keyb[$i] = ($key2->[$div] & (1<<(7-($mod))))? 1: 0; + $outb[$i] = 0; + } + &dohash(\@outb, \@inb, \@keyb); + foreach $i (0..7) + { + $out[$i] = 0; + } + foreach $i (0..63) + { + $out[int($i/8)] |= (1<<(7-($i%8))) if ($outb[$i]); + } + my $out = pack("C8", @out); + return $out; +} + +1; diff --git a/NTLM-1.05/blib/lib/Authen/NTLM/MD4.pm b/NTLM-1.05/blib/lib/Authen/NTLM/MD4.pm new file mode 100644 index 0000000..ba8f735 --- /dev/null +++ b/NTLM-1.05/blib/lib/Authen/NTLM/MD4.pm @@ -0,0 +1,197 @@ +#!/usr/local/bin/perl +# +# This is a partial implentation of the MD4 checksum code. +# +# NOTE +# +# The function &add() in this module is required as we need to be +# able to add 32bit integers ignoring overflow. The C code this is +# based on does this because it uses the underlying hardware to +# perform the required addition however we need to be more careful +# as Perl will overflow an int and produce a result of 0xffffffff +# which is not very useful. The &add() function splits its arguments +# into two shorts and adds these carrying overflow from the low short +# to the high short and ignoring carry from the high short. Not +# exactly efficient, but it works and is fast enough for the purposes +# of this implementation +# + +package Authen::NTLM::MD4; + +use vars qw($VERSION @ISA @EXPORT); +require Exporter; + +$VERSION = "1.02"; +@ISA = qw(Exporter); +@EXPORT = qw(mdfour); + +my ($A, $B, $C, $D); +my (@X, $M); + +sub mdfour +{ + my ($in) = @_; + + my ($i, $pos); + my $len = length($in); + my $b = $len * 8; + $in .= "\0"x128; + $A = 0x67452301; + $B = 0xefcdab89; + $C = 0x98badcfe; + $D = 0x10325476; + $pos = 0; + while ($len > 64) + { + ©64(substr($in, $pos, 64)); + &mdfour64; + $pos += 64; + $len -= 64; + } + my $buf = substr($in, $pos, $len); + $buf .= sprintf "%c", 0x80; + if ($len <= 55) + { + $buf .= "\0"x(55-$len); + $buf .= pack("V", $b); + $buf .= "\0"x4; + ©64($buf); + &mdfour64; + } + else + { + $buf .= "\0"x(120-$len); + $buf .= pack("V", $b); + $buf .= "\0"x4; + ©64(substr($buf, 0, 64)); + &mdfour64; + ©64(substr($buf, 64, 64)); + &mdfour64; + } + my $out = pack("VVVV", $A, $B, $C, $D); + return $out; +} + +sub F +{ + my ($X, $Y, $Z) = @_; + my $res = ($X&$Y) | ((~$X)&$Z); + return $res; +} + +sub G +{ + my ($X, $Y, $Z) = @_; + + return ($X&$Y) | ($X&$Z) | ($Y&$Z); +} + +sub H +{ + my ($X, $Y, $Z) = @_; + + return $X^$Y^$Z; +} + +sub lshift +{ + my ($x, $s) = @_; + + $x &= 0xffffffff; + return (($x<<$s)&0xffffffff) | ($x>>(32-$s)); +} + +sub ROUND1 +{ + my ($a, $b, $c, $d, $k, $s) = @_; + my $e = &add($a, &F($b, $c, $d), $X[$k]); + return &lshift($e, $s); +} + +sub ROUND2 +{ + my ($a, $b, $c, $d, $k, $s) = @_; + + my $e = &add($a, &G($b, $c, $d), $X[$k], 0x5a827999); + return &lshift($e, $s); +} + +sub ROUND3 +{ + my ($a, $b, $c, $d, $k, $s) = @_; + + my $e = &add($a, &H($b, $c, $d), $X[$k], 0x6ed9eba1); + return &lshift($e, $s); +} + +sub mdfour64 +{ + my ($i, $AA, $BB, $CC, $DD); + @X = unpack("N16", $M); + $AA = $A; + $BB = $B; + $CC = $C; + $DD = $D; + + $A = &ROUND1($A,$B,$C,$D, 0, 3); $D = &ROUND1($D,$A,$B,$C, 1, 7); + $C = &ROUND1($C,$D,$A,$B, 2,11); $B = &ROUND1($B,$C,$D,$A, 3,19); + $A = &ROUND1($A,$B,$C,$D, 4, 3); $D = &ROUND1($D,$A,$B,$C, 5, 7); + $C = &ROUND1($C,$D,$A,$B, 6,11); $B = &ROUND1($B,$C,$D,$A, 7,19); + $A = &ROUND1($A,$B,$C,$D, 8, 3); $D = &ROUND1($D,$A,$B,$C, 9, 7); + $C = &ROUND1($C,$D,$A,$B,10,11); $B = &ROUND1($B,$C,$D,$A,11,19); + $A = &ROUND1($A,$B,$C,$D,12, 3); $D = &ROUND1($D,$A,$B,$C,13, 7); + $C = &ROUND1($C,$D,$A,$B,14,11); $B = &ROUND1($B,$C,$D,$A,15,19); + + $A = &ROUND2($A,$B,$C,$D, 0, 3); $D = &ROUND2($D,$A,$B,$C, 4, 5); + $C = &ROUND2($C,$D,$A,$B, 8, 9); $B = &ROUND2($B,$C,$D,$A,12,13); + $A = &ROUND2($A,$B,$C,$D, 1, 3); $D = &ROUND2($D,$A,$B,$C, 5, 5); + $C = &ROUND2($C,$D,$A,$B, 9, 9); $B = &ROUND2($B,$C,$D,$A,13,13); + $A = &ROUND2($A,$B,$C,$D, 2, 3); $D = &ROUND2($D,$A,$B,$C, 6, 5); + $C = &ROUND2($C,$D,$A,$B,10, 9); $B = &ROUND2($B,$C,$D,$A,14,13); + $A = &ROUND2($A,$B,$C,$D, 3, 3); $D = &ROUND2($D,$A,$B,$C, 7, 5); + $C = &ROUND2($C,$D,$A,$B,11, 9); $B = &ROUND2($B,$C,$D,$A,15,13); + + $A = &ROUND3($A,$B,$C,$D, 0, 3); $D = &ROUND3($D,$A,$B,$C, 8, 9); + $C = &ROUND3($C,$D,$A,$B, 4,11); $B = &ROUND3($B,$C,$D,$A,12,15); + $A = &ROUND3($A,$B,$C,$D, 2, 3); $D = &ROUND3($D,$A,$B,$C,10, 9); + $C = &ROUND3($C,$D,$A,$B, 6,11); $B = &ROUND3($B,$C,$D,$A,14,15); + $A = &ROUND3($A,$B,$C,$D, 1, 3); $D = &ROUND3($D,$A,$B,$C, 9, 9); + $C = &ROUND3($C,$D,$A,$B, 5,11); $B = &ROUND3($B,$C,$D,$A,13,15); + $A = &ROUND3($A,$B,$C,$D, 3, 3); $D = &ROUND3($D,$A,$B,$C,11, 9); + $C = &ROUND3($C,$D,$A,$B, 7,11); $B = &ROUND3($B,$C,$D,$A,15,15); + + $A = &add($A, $AA); $B = &add($B, $BB); + $C = &add($C, $CC); $D = &add($D, $DD); + $A &= 0xffffffff; $B &= 0xffffffff; + $C &= 0xffffffff; $D &= 0xffffffff; + map {$_ = 0} @X; +} + +sub copy64 +{ + my ($in) = @_; + + $M = pack("V16", unpack("N16", $in)); +} + +# see note at top of this file about this function +sub add +{ + my (@nums) = @_; + my ($r_low, $r_high, $n_low, $l_high); + my $num; + $r_low = $r_high = 0; + foreach $num (@nums) + { + $n_low = $num & 0xffff; + $n_high = ($num&0xffff0000)>>16; + $r_low += $n_low; + ($r_low&0xf0000) && $r_high++; + $r_low &= 0xffff; + $r_high += $n_high; + $r_high &= 0xffff; + } + return ($r_high<<16)|$r_low; +} + +1; diff --git a/NTLM-1.05/blib/lib/auto/Authen/NTLM/.exists b/NTLM-1.05/blib/lib/auto/Authen/NTLM/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/lib/auto/Authen/NTLM/DES/.exists b/NTLM-1.05/blib/lib/auto/Authen/NTLM/DES/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/lib/auto/Authen/NTLM/MD4/.exists b/NTLM-1.05/blib/lib/auto/Authen/NTLM/MD4/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/man1/.exists b/NTLM-1.05/blib/man1/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/man3/.exists b/NTLM-1.05/blib/man3/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/blib/man3/Authen::NTLM.3pm b/NTLM-1.05/blib/man3/Authen::NTLM.3pm new file mode 100644 index 0000000..7e3bc1e --- /dev/null +++ b/NTLM-1.05/blib/man3/Authen::NTLM.3pm @@ -0,0 +1,281 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "NTLM 3pm" +.TH NTLM 3pm "2008-06-18" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Authen::NTLM \- An NTLM authentication module +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.Vb 10 +\& use Mail::IMAPClient; +\& use Authen::NTLM; +\& my $imap = Mail::IMAPClient\->new(Server=>\(aqimaphost\(aq); +\& ntlm_user($username); +\& ntlm_password($password); +\& $imap\->authenticate("NTLM", Authen::NTLM::ntlm); +\& : +\& $imap\->logout; +\& ntlm_reset; +\& : +.Ve +.PP +or +.PP +.Vb 5 +\& ntlmv2(1); +\& ntlm_user($username); +\& ntlm_host($host); +\& ntlm_password($password); +\& : +.Ve +.PP +or +.PP +.Vb 10 +\& my $ntlm = Authen::NTLM\-> new( +\& host => $host, +\& user => $username, +\& domain => $domain, +\& password => $password, +\& version => 1, +\& ); +\& $ntlm\-> challenge; +\& : +\& $ntlm\-> challenge($challenge); +.Ve +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.Vb 5 +\& This module provides methods to use NTLM authentication. It can +\& be used as an authenticate method with the Mail::IMAPClient module +\& to perform the challenge/response mechanism for NTLM connections +\& or it can be used on its own for NTLM authentication with other +\& protocols (eg. HTTP). +.Ve +.PP +.Vb 5 +\& The implementation is a direct port of the code from F +\& which, itself, has based its NTLM implementation on F. As +\& such, this code is not especially efficient, however it will still +\& take a fraction of a second to negotiate a login on a PII which is +\& likely to be good enough for most situations. +.Ve +.Sh "\s-1FUNCTIONS\s0" +.IX Subsection "FUNCTIONS" +.IP "\fIntlm_domain()\fR" 4 +.IX Item "ntlm_domain()" +.Vb 3 +\& Set the domain to use in the NTLM authentication messages. +\& Returns the new domain. Without an argument, this function +\& returns the current domain entry. +.Ve +.IP "\fIntlm_user()\fR" 4 +.IX Item "ntlm_user()" +.Vb 3 +\& Set the username to use in the NTLM authentication messages. +\& Returns the new username. Without an argument, this function +\& returns the current username entry. +.Ve +.IP "\fIntlm_password()\fR" 4 +.IX Item "ntlm_password()" +.Vb 3 +\& Set the password to use in the NTLM authentication messages. +\& Returns the new password. Without an argument, this function +\& returns the current password entry. +.Ve +.IP "\fIntlm_reset()\fR" 4 +.IX Item "ntlm_reset()" +.Vb 2 +\& Resets the NTLM challenge/response state machine so that the next +\& call to C will produce an initial connect message. +.Ve +.IP "\fIntlm()\fR" 4 +.IX Item "ntlm()" +.Vb 5 +\& Generate a reply to a challenge. The NTLM protocol involves an +\& initial empty challenge from the server requiring a message +\& response containing the username and domain (which may be empty). +\& The first call to C generates this first message ignoring +\& any arguments. +.Ve +.Sp +.Vb 5 +\& The second time it is called, it is assumed that the argument is +\& the challenge string sent from the server. This will contain 8 +\& bytes of data which are used in the DES functions to generate the +\& response authentication strings. The result of the call is the +\& final authentication string. +.Ve +.Sp +.Vb 3 +\& If C is called, then the next call to C will +\& start the process again allowing multiple authentications within +\& an application. +.Ve +.IP "\fIntlmv2()\fR" 4 +.IX Item "ntlmv2()" +.Vb 1 +\& Use NTLM v2 authentication. +.Ve +.Sh "\s-1OBJECT\s0 \s-1API\s0" +.IX Subsection "OBJECT API" +.ie n .IP "new %options" 4 +.el .IP "new \f(CW%options\fR" 4 +.IX Item "new %options" +Creates an object that accepts the following options: \f(CW\*(C`user\*(C'\fR, \f(CW\*(C`host\*(C'\fR, +\&\f(CW\*(C`domain\*(C'\fR, \f(CW\*(C`password\*(C'\fR, \f(CW\*(C`version\*(C'\fR. +.IP "challenge [$challenge]" 4 +.IX Item "challenge [$challenge]" +If \f(CW$challenge\fR is not supplied, first-stage challenge string is generated. +Otherwise, the third-stage challenge is generated, where \f(CW$challenge\fR is +assumed to be extracted from the second stage of \s-1NTLM\s0 exchange. The result of +the call is the final authentication string. +.SH "AUTHOR" +.IX Header "AUTHOR" +.Vb 6 +\& David (Buzz) Bussenschutt \- current maintainer +\& Dmitry Karasik \- nice ntlmv2 patch, OO extensions. +\& Andrew Hobson \- initial ntlmv2 code +\& Mark Bush \- perl port +\& Eric S. Raymond \- author of fetchmail +\& Andrew Tridgell and Jeremy Allison for SMB/Netbios code +.Ve +.SH "SEE ALSO" +.IX Header "SEE ALSO" +perl, Mail::IMAPClient, LWP::Authen::Ntlm +.SH "HISTORY" +.IX Header "HISTORY" +.Vb 4 +\& 1.05 \- add OO interface by Dmitry Karasik +\& 1.04 \- implementation of NTLMv2 by Andrew Hobson/Dmitry Karasik +\& 1.03 \- fixes long\-standing 1 line bug L \- released by David Bussenschutt 9th Aug 2007 +\& 1.02 \- released by Mark Bush 29th Oct 2001 +.Ve diff --git a/NTLM-1.05/blib/script/.exists b/NTLM-1.05/blib/script/.exists new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/pm_to_blib b/NTLM-1.05/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/NTLM-1.05/t/01_load.t b/NTLM-1.05/t/01_load.t new file mode 100644 index 0000000..3b38196 --- /dev/null +++ b/NTLM-1.05/t/01_load.t @@ -0,0 +1,9 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 1; + +use_ok('Authen::NTLM'); + diff --git a/NTLM-1.05/t/02_ntlm.t b/NTLM-1.05/t/02_ntlm.t new file mode 100644 index 0000000..e3c5d88 --- /dev/null +++ b/NTLM-1.05/t/02_ntlm.t @@ -0,0 +1,48 @@ +#! /usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 12; + +use Authen::NTLM; +use MIME::Base64; + +my $user = "test"; +my $domain = "test"; +my $passwd = "test"; +my $msg1 = "TlRMTVNTUAABAAAAB7IAAAQABAAgAAAABAAEACQAAAB0ZXN0dGVzdA=="; +my $challenge = "TlRMTVNTUAACAAAABAAEADAAAAAFggEAQUJDREVGR0gAAAAAAAAAAAAAAAAAAAAAdGVzdA=="; +my $msg2 = "TlRMTVNTUAADAAAAGAAYAEAAAAAYABgAWAAAAAQABABwAAAACAAIAHQAAAAIAAgAfAAAAAAAAABEAAAABYIBAJ7/TlMo4HLg0gOk6iKq4bv2vk35ozHEKKoqG8nTkQ5S82zyqpJzxPDJHUMynnKsBHRlc3R0AGUAcwB0AHQAZQBzAHQA"; + +# 2: username + +ok(ntlm_user($user) eq $user, 'ntlm_user'); + +# 3: domain + +ok(ntlm_domain($domain) eq $domain, 'ntlm_domain'); + +# 4: password + +ok(ntlm_password($passwd) eq $passwd, 'ntlm_password'); + +# 5: initial message + +my $reply1 = ntlm(); +ok($reply1 eq $msg1, 'reply 1'); + +# 6-12: decode challenge - not normally user accessed + +my $c = &Authen::NTLM::decode_challenge(decode_base64($challenge)); +ok($c->{ident} eq "NTLMSSP", 'header'); +ok($c->{type} == 2, 'type'); +ok($c->{flags} == 0x00018205, 'flags'); +ok($c->{data} eq "ABCDEFGH", 'data'); +ok($c->{domain}{len} == 4, 'domain length'); +ok($c->{domain}{offset} == 48, 'domain offset'); +ok($c->{buffer} eq "test", 'contents'); + +# 13: challenge response + +my $reply2 = ntlm($challenge); +ok($reply2 eq $msg2, 'reply 2'); diff --git a/NTLM-1.05/t/03_oo.t b/NTLM-1.05/t/03_oo.t new file mode 100644 index 0000000..6f710a8 --- /dev/null +++ b/NTLM-1.05/t/03_oo.t @@ -0,0 +1,54 @@ +#! /usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 12; + +use Authen::NTLM; +use MIME::Base64; + +my $user = "test"; +my $domain = "test"; +my $passwd = "test"; +my $msg1 = "TlRMTVNTUAABAAAAB7IAAAQABAAgAAAABAAEACQAAAB0ZXN0dGVzdA=="; +my $challenge = "TlRMTVNTUAACAAAABAAEADAAAAAFggEAQUJDREVGR0gAAAAAAAAAAAAAAAAAAAAAdGVzdA=="; +my $msg2 = "TlRMTVNTUAADAAAAGAAYAEAAAAAYABgAWAAAAAQABABwAAAACAAIAHQAAAAIAAgAfAAAAAAAAABEAAAABYIBAJ7/TlMo4HLg0gOk6iKq4bv2vk35ozHEKKoqG8nTkQ5S82zyqpJzxPDJHUMynnKsBHRlc3R0AGUAcwB0AHQAZQBzAHQA"; + +my $a = Authen::NTLM-> new( + user => $user, + domain => $domain, + password => $passwd, +); + +# 2: username + +ok($a->user eq $user, 'ntlm_user'); + +# 3: domain + +ok($a->domain eq $domain, 'ntlm_domain'); + +# 4: password + +ok($a->password eq $passwd, 'ntlm_password'); + +# 5: initial message + +my $reply1 = $a-> challenge; +ok($reply1 eq $msg1, 'reply 1'); + +# 6-12: decode challenge - not normally user accessed + +my $c = &Authen::NTLM::decode_challenge(decode_base64($challenge)); +ok($c->{ident} eq "NTLMSSP", 'header'); +ok($c->{type} == 2, 'type'); +ok($c->{flags} == 0x00018205, 'flags'); +ok($c->{data} eq "ABCDEFGH", 'data'); +ok($c->{domain}{len} == 4, 'domain length'); +ok($c->{domain}{offset} == 48, 'domain offset'); +ok($c->{buffer} eq "test", 'contents'); + +# 13: challenge response + +my $reply2 = $a-> challenge($challenge); +ok($reply2 eq $msg2, 'reply 2'); diff --git a/NTLM-1.05/t/04_v2.t b/NTLM-1.05/t/04_v2.t new file mode 100644 index 0000000..33e3fa6 --- /dev/null +++ b/NTLM-1.05/t/04_v2.t @@ -0,0 +1,44 @@ +#! /usr/bin/perl + +BEGIN { *CORE::GLOBAL::time = sub { CORE::time } }; + +use strict; +use warnings; +use Test::More tests => 9; +use Authen::NTLM; +use MIME::Base64; + +my $user = "test"; +my $domain = "test"; +my $passwd = "test"; +my $msg1 = "TlRMTVNTUAABAAAAB5IIAAAAAAAAAAAABAAEACAAAAB0ZXN0"; +my $challenge = "TlRMTVNTUAACAAAABAAEADgAAAAFgokCQUJDREVGR0gAAAAAAAAAAAQABAA8AAAAdGVzdHRlc3R0ZXN0"; +my $msg2 = "TlRMTVNTUAADAAAAGAAYAEAAAAAwADAAWAAAAAQABACIAAAACAAIAIwAAAAIAAgAlAAAAAAAAABcAAAABYIIAMAnJRnMkjvahFEZwXRLN9QAAAAAAAAAABmT0B8dzYsVm1/IAPnR5PIBAQAAAAAAAIBgMzwAAAAAAAAAAAAAAAAAAAAAAAAAAHRlc3R0AGUAcwB0AHQAZQBzAHQA"; + +my $a = Authen::NTLM-> new( + user => $user, + domain => $domain, + password => $passwd, + version => 2, +); + +my $reply1 = $a-> challenge; +ok($reply1 eq $msg1, 'reply 1'); + +# decode challenge - not normally user accessed +my $c = &Authen::NTLM::decode_challenge(decode_base64($challenge)); +ok($c->{ident} eq "NTLMSSP", 'header'); +ok($c->{type} == 2, 'type'); +ok($c->{flags} == 0x02898205, 'flags'); +ok($c->{data} eq "ABCDEFGH", 'data'); +ok($c->{domain}{len} == 4, 'domain length'); +ok($c->{domain}{offset} == 56, 'domain offset'); +ok($c->{buffer} eq "testtesttest", 'contents'); + +# 13: v2 challenge-response uses time() +{ + no warnings qw(redefine); + local *CORE::GLOBAL::time = sub { 1_000_000_000 }; + my $reply2 = $a-> challenge($challenge); + ok($reply2 eq $msg2, 'reply 2'); +} diff --git a/NTLM-1.05/t/99_pod.t b/NTLM-1.05/t/99_pod.t new file mode 100644 index 0000000..26d3764 --- /dev/null +++ b/NTLM-1.05/t/99_pod.t @@ -0,0 +1,9 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use Test::More; +eval 'use Test::Pod 1.00'; +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; +all_pod_files_ok(all_pod_files('blib')); diff --git a/README b/README index 6709d9c..7274c33 100644 --- a/README +++ b/README @@ -3,7 +3,7 @@ NAME Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 36 different IMAP server softwares supported with success. - $Revision: 1.366 $ + $Revision: 1.398 $ SYNOPSIS To synchronise imap account "foo" on "imap.truc.org" to imap account @@ -22,12 +22,12 @@ INSTALL imapsync is already available directly on the following distributions (at least): FreeBSD, Debian, Ubuntu, Gentoo, Fedora, NetBSD, Darwin, - Mandriva and OpenBSD (yeah!). + Mandriva and OpenBSD. Get imapsync at http://www.linux-france.org/prj/imapsync/ - You'll find a compressed tarball called imapsync-x.xx.tgz + You'll receive a link to a compressed tarball called imapsync-x.xx.tgz where x.xx is the version number. Untar the tarball where you want (on Unix): @@ -55,8 +55,10 @@ USAGE [--user2 ] [--passfile2 ] [--ssl1] [--ssl2] [--tls1] [--tls2] - [--authmech1 ] [--authmech2 ] - [--noauthmd5] + [--authmech1 ] [--authmech2 ] + [--proxyauth1] [--proxyauth2] + [--domain1] [--domain2] + [--authmd51] [--authmd52] [--folder --folder ...] [--folderrec --folderrec ...] [--include ] [--exclude ] @@ -67,7 +69,6 @@ USAGE [--justfolders] [--justfoldersizes] [--justconnect] [--justbanner] [--syncinternaldates] [--idatefromheader] - [--buffersize ] [--syncacls] [--regexmess ] [--regexmess ] [--maxsize ] @@ -76,9 +77,12 @@ USAGE [--minage ] [--skipheader ] [--useheader ] [--useheader ] + [--nouid1] [--nouid1] + [--usecache] [--skipsize] [--allowsizemismatch] [--delete] [--delete2] [--expunge] [--expunge1] [--expunge2] [--uidexpunge2] + [--delete2folders] [--delete2foldersonly] [--delete2foldersbutnot] [--subscribed] [--subscribe] [--subscribe_all] [--nofoldersizes] [--dry] @@ -86,9 +90,11 @@ USAGE [--timeout ] [--fast] [--split1] [--split2] [--reconnectretry1 ] [--reconnectretry2 ] + [--noreleasecheck] [--pidfile ] [--tmpdir ] [--version] [--help] + [--tests] [--tests_debug] DESCRIPTION The command imapsync is a tool allowing incremental and recursive imap @@ -110,7 +116,10 @@ DESCRIPTION You can decide to delete the messages from the source mailbox after a successful transfer (it is a good feature when migrating). In that case, - use the --delete --expunge1 options. + use the --delete option. Option --delete implies also option --expunge + so all messages marked deleted on host1 will be really deleted. (you can + use --noexpunge to avoid this but I don't see any real world scenario + for the combinaison --delete --noexpunge). You can also just synchronize a mailbox A from another mailbox B in case you just want to keep a "live" copy of B in A (--delete2 may help) @@ -165,6 +174,10 @@ SECURITY with --authuser1 "adminuser", it will not work. Same behavior with the --authuser2 option. + 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 + EXIT STATUS imapsync will exit with a 0 status (return code) if everything went good. Otherwise, it exits with a non-zero status. @@ -177,9 +190,10 @@ EXIT STATUS done LICENSE - imapsync is free, gratis and open source software cover by the Do What - The Fuck You Want To Public License (WTFPL). See COPYING file included - in the distribution or the web site http://sam.zoy.org/wtfpl/COPYING + imapsync is free, open source but not always gratis software cover by + the Do What The Fuck You Want To Public License (WTFPL). See COPYING + file included in the distribution or the web site + http://sam.zoy.org/wtfpl/COPYING MAILING-LIST The public mailing-list may be the best way to get support. @@ -214,8 +228,8 @@ AUTHOR imapsync mailing-list (see below). Gilles LAMIRAL earns his living writing, installing, configuring and - teaching free, open and gratis softwares. Do not hesitate to pay him for - that services. + teaching free, open and often gratis softwares. Do not hesitate to pay + him for that services. BUG REPORT GUIDELINES Help us to help you: follow the following guidelines. @@ -238,7 +252,7 @@ BUG REPORT GUIDELINES visible line). Don't write imapsync in uppercase in the email title, we'll know you run - windows(tm) and you haven't read the README yet. + Windows and you haven't read this README yet. Help us to help you: in your report, please include: @@ -271,18 +285,18 @@ BUG REPORT GUIDELINES it. IMAP SERVERS - Failure stories reported with the following 4 imap servers: + Failure stories reported with the following 3 imap servers: - MailEnable 1.54 (Proprietary) http://www.mailenable.com/ - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works. Patient and confident testers are welcome. - - dkimap4 2.39 - Imail 7.04 (maybe). - Success stories reported with the following 36 imap servers (software + Success stories reported with the following 40 imap servers (software names are in alphabetic order): - 1und1 H mimap1 84498 [host1] + - a1.net imap.a1.net IMAP4 Ready WARSBL614 00029c23 [host1] - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] (OSL 3.0) http://www.archiveopteryx.org/ - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) @@ -303,12 +317,15 @@ IMAP SERVERS - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). 2.0.7 seems buggy. - Deerfield VisNetic MailServer 5.8.6 [host1] - - Domino (Notes) 4.61[host1], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1[host1], 8.0.1[host1] + - dkimap4 [host1] + - Domino (Notes) 4.61[host1], 6.5[host1], 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, + 7.0.1[host1], 8.0.1[host1], 8.5.2[host2] - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, 1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/) - Eudora WorldMail v2 - GMX IMAP4 StreamProxy. - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. + - hMailServer 5.3.3 [host2], 4.4.1 [host1] (see FAQ) - iPlanet Messaging server 4.15, 5.1, 5.2 - IMail 7.15 (Ipswitch/Win2003), 8.12 - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform) @@ -317,18 +334,19 @@ IMAP SERVERS 6.5.7638.1 [host2], Exchange 2007 SP1 (with Update Rollup 2), Exchange2007-EP-SP2, Exchange 2010 RTM (Release to Manufacturing) [host2] + - Mirapoint - Netscape Mail Server 3.6 (Wintel !) - Netscape Messaging Server 4.15 Patch 7 - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) - OpenWave + - Oracle Beehive [host1] - Qualcomm Worldmail (NT) - Rockliffe Mailsite 5.3.11, 4.5.6 - Samsung Contact IMAP server 8.5.0 - Scalix v10.1, 10.0.1.3, 11.0.0.431 - - SmarterMail, Smarter Mail 5.0 Enterprise. + - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [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 - - Sun Messaging Server 6.3 + - Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 - Surgemail 3.6f5-5 - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) @@ -350,15 +368,10 @@ IMAP SERVERS imapsync --host1 imap.troc.org --host2 imap.trac.org --justconnect - Please rate imapsync at http://freshmeat.net/projects/imapsync/ or - better give the author a book, he likes books: - http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ (or its paypal - account gilles.lamiral@laposte.net) - HUGE MIGRATION Pay special attention to options --subscribed --subscribe --delete - --delete2 --expunge --expunge1 --expunge2 --uidexpunge2 --maxage - --minage --maxsize --useheader --fast + --delete2 --delete2folders --expunge --expunge1 --expunge2 --uidexpunge2 + --maxage --minage --maxsize --useheader --fast If you have many mailboxes to migrate think about a little shell program. Write a file called file.csv (for example) containing users and @@ -404,5 +417,5 @@ SIMILAR SOFTWARES Feedback (good or bad) will often be welcome. - $Id: imapsync,v 1.366 2010/10/25 17:15:52 gilles Exp gilles $ + $Id: imapsync,v 1.398 2011/01/18 03:03:24 gilles Exp gilles $ diff --git a/TIME b/TIME index 10aaed3..baa7434 100644 --- a/TIME +++ b/TIME @@ -1,3 +1,29 @@ +180 Added --authmd51 and --authmd52. --delete2foldersbutnot. Release 1.398 public. Payment in EUR. + 60 Added info about biggest messages. --debugimap* implies --debug +130 Added delete2foldersnot option. +420 Ended speedup with cache. +350 Continue speedup with cache. +360 Continue speedup with cache. +180 Started to speedup with cache. + 30 Reading rfc 3501 + 60 Added help to guess --sep1 and --prefix1 when needed. + 90 Added option --delete2foldersonly +105 1 email about subfolder and generic FAQ solution (no separator nor prefix by hand) + 65 2 email about subfolder and --delete2folders and Exchange --authuser +150 imapsync 1.384 cleanup. Think about cache and both sync. + 60 imapsync 1.383 better default behaviour. +300 paypal_reply: imap server independant +180 paypal_reply: paypal_send +180 paypal_reply: build reply. +150 paypal_reply: parsing received email +120 Started paypal_reply +180 Fix no header => take 2k body. + 30 Fix ps -o on Solaris. + 60 folderrec_blank_bug. Pricing includes updates? +120 dkimap support. +240 NTLM support. --domain1 --domain2 options. 1.377 release +240 New imapsync distribution policy: pay first. +260 New imapsync.exe 1.366 with --link libeay32_.dll --link ssleay32_.dll (better names ending_?). New index.shtml, imapsync.exe sold 15 USD. 90 Permit host* to change the case of headers. 1.366 release. 120 Fix tls capability. 1.365 release. 150 1.363 public release. diff --git a/TODO b/TODO index 689e8df..834d856 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: TODO,v 1.86 2010/10/08 00:43:09 gilles Exp gilles $ +# $Id: TODO,v 1.92 2011/01/18 02:38:48 gilles Exp gilles $ TODO file for imapsync ---------------------- @@ -15,6 +15,8 @@ Add a best practice migration tips document. Write a Mail::imapsync package and use it. +write a comment to http://blog.migrationwiz.com/2010/12/09/imapsync-vs-migrationwiz/ + Fix the mailing-list archive bug with From at the beginning of a line http://www.linux-france.org/prj/imapsync_list/msg00307.html @@ -28,8 +30,6 @@ funny during the sync. It would be great - and presumably easy to code - to have an option to have imapsync display e.g. the subject of an e-mail when it gets synced, rather than just the message ID and the date/time. -Add --noauthmd51 --noauthmd52 to permit noauthmd5 by host - Add a well described problem for each problem detected and counted in error counter statistics. @@ -39,9 +39,6 @@ http://www.bwebcentral.com/utils/imapsync-yahoo See patches/imapsync-yahoo -Add NTLM authentification support -http://cpansearch.perl.org/src/BUZZ/NTLM-1.05/NTLM.pm -http://curl.haxx.se/rfc/ntlm.html Add "output to reflect everything that imapsync was doing". Not everything but flag synchronization will be nice" @@ -60,11 +57,6 @@ their ACLs. Syncing ACLs vom Cyrus to Dovecot (at least 1.2) doesn't work. Cyrus uses c and d, Dovecot uses k and x instead." Peer Heinlein. -Add a --delete2folders option -"When syncing mailboxes with imapsync, is there a way to delete folders in the -target account? The --delete2 option only seems to delete individual -messages, not folders." - Add different levels of output to see clearly the problem by default. @@ -72,13 +64,6 @@ Add option --exclude_messages_with_flag Add more information about skipped messages. -There was a time imapsync took the whole message when the -header was bad (empty). But it was bad for speed with big -messages (nowadays there are always big messages in -mailboxes). May be the best is to take a part of the -body. Have to code this. - - Add Rick Romero patch with --quiet No output at all @@ -161,10 +146,38 @@ http://www.washington.edu/imap/documentation/commndmt.txt.html Add cyrus link about INBOX. namespace http://asg.web.cmu.edu/cyrus/download/imapd/altnamespace.html -Explain expunge behavior. - =========================================================================== +DONE. Explain expunge behavior in help message. + +DONE. Add --authmd51 --authmd52 to permit authmd5 by host. + +DONE. Write option --delete2foldersonly regex. +Example: to permit a sync in a subfolder with --delete2folder +--regextrans2 's#(.*)#NEW/$1#' --delete2foldersonly /^NEW/ + +DONE. Write option --delete2foldersnot regex. +Example: to permit a sync but not deleting folder OLD +--delete2foldersnot /^OLD/ + +DONE. Add cache to speed up transfer. Option --usecache + +DONE. There was a time imapsync took the whole message when the +header was bad (empty). But it was bad for speed with big +messages (nowadays there are always big messages in +mailboxes). May be the best is to take a part of the +body. Have to code this. + +DONE. Add a --delete2folders option +"When syncing mailboxes with imapsync, is there a way to delete folders in the +target account? The --delete2 option only seems to delete individual +messages, not folders." + +DONE. Add NTLM authentification support. Mail-IMAPClient-3.25 +support it. +http://cpansearch.perl.org/src/BUZZ/NTLM-1.05/NTLM.pm +http://curl.haxx.se/rfc/ntlm.html + DONE. Evaluate memory consumption with (or better): print qx{ ps o pid,pcpu,comm,vsz,rss,size $$ }, "\n" Search memory leaks with diff --git a/VERSION b/VERSION index f014005..f9cb03d 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.366 +1.398 diff --git a/VERSION_EXE b/VERSION_EXE index a31af01..f8ace8d 100644 --- a/VERSION_EXE +++ b/VERSION_EXE @@ -1 +1 @@ -1.366 +1.398 diff --git a/ab_jlh.png b/ab_jlh.png new file mode 100644 index 0000000..057031a Binary files /dev/null and b/ab_jlh.png differ diff --git a/build_exe.bat b/build_exe.bat index 2022c35..1598c26 100755 --- a/build_exe.bat +++ b/build_exe.bat @@ -1,10 +1,10 @@ -REM $Id: build_exe.bat,v 1.6 2010/10/24 23:51:48 gilles Exp gilles $ +REM $Id: build_exe.bat,v 1.8 2010/11/09 01:22:29 gilles Exp gilles $ echo Building imapsync.exe cd C:\msys\1.0\home\Admin\imapsync -perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mFile::Spec -mDigest::HMAC_MD5 -e '' +perl -mMail::IMAPClient -mDigest::MD5 -mTerm::ReadKey -mIO::Socket::SSL -mFile::Spec -mDigest::HMAC_MD5 -mAuthen::NTLM -e '' -pp -o imapsync.exe -M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL -M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey imapsync +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 Term::ReadKey -M Authen::NTLM imapsync echo Done building imapsync.exe diff --git a/freshmeat_submition.inp b/freshmeat_submition.inp index 4d8a193..ce85cb0 100644 --- a/freshmeat_submition.inp +++ b/freshmeat_submition.inp @@ -12,4 +12,4 @@ RELEASE_FOCUS="Minor feature enhancements" #TEXT_BODY="Syntax cleanup" #TEXT_BODY="Updated documentation" -TEXT_BODY="Since last public release 1.350: Added --minsize option to transfer messages bigger than a given size. Added memory consumption to know how much concurent imapsync can run in parallel on a system. Thanks to the freshmeat guy who corrects my bad and poorly English!" +TEXT_BODY="Several improvements to reach better usability. Authentication cram-md5 is not used by default (too few server support it). Issues from servers changing or adding header are avoided. Now imapsync has a way to handle efficiently no header in messages. The imap server dkimap is supported (dkimap isn't a uid capability server). Added NTLM authentication with domain. Added --minsize option to transfer messages bigger than a given size. Added memory consumption measurement to compute how much concurrent imapsync can run in parallel on a system. Imapsync is no longer gratis from the home page." diff --git a/freshmeat_submition.json b/freshmeat_submition.json index 0088346..abc407c 100644 --- a/freshmeat_submition.json +++ b/freshmeat_submition.json @@ -1,9 +1,9 @@ { "release": { "tag_list": "stable, Minor feature enhancements", - "version": "1.359", + "version": "1.383", "hidden_from_frontpage": false, - "changelog": "Since last public release 1.350: Added --minsize option to transfer messages bigger than a given size.Added memory consumption to know how much concurent imapsync can run in parallel on a system. Many thanks to the freshmeat folk that correct my bad and poorly English!" + "changelog": "Since last public release 1.350 several improvements have been made to reach a better usability. By default, authentication cram-md5 is not used (too few server support it) so --noauthmd5 option becomes useless. To avoid issues from servers changing or adding header option --useheader Message-Id is on by default too. Now imapsync has a way to handle efficiently no headers in messages (take first 2KB body). The imap server dkimap is now supported (it was not because dkimap is not a uid capability server). NTLM authentication with domain is supported. Added --minsize option to transfer messages bigger than a given size. Added memory consumption measurement to compute how much concurrent imapsync can run in parallel on a system. Imapsync is no longer gratis from the home page. Imapsync license has not changed, it is still a WTFPL software. Thanks again to the freshmeat guy who corrects my bad and poorly English!" } } diff --git a/imapsync b/imapsync index f20a9dd..e79b598 100755 --- a/imapsync +++ b/imapsync @@ -20,7 +20,7 @@ tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 36 different IMAP server softwares supported with success. -$Revision: 1.366 $ +$Revision: 1.398 $ =head1 SYNOPSIS @@ -43,12 +43,12 @@ To synchronise imap account "foo" on "imap.truc.org" imapsync is already available directly on the following distributions (at least): FreeBSD, Debian, Ubuntu, Gentoo, Fedora, -NetBSD, Darwin, Mandriva and OpenBSD (yeah!). +NetBSD, Darwin, Mandriva and OpenBSD. Get imapsync at http://www.linux-france.org/prj/imapsync/ - You'll find a compressed tarball called imapsync-x.xx.tgz + You'll receive a link to a compressed tarball called imapsync-x.xx.tgz where x.xx is the version number. Untar the tarball where you want (on Unix): @@ -77,8 +77,10 @@ The option list: [--user2 ] [--passfile2 ] [--ssl1] [--ssl2] [--tls1] [--tls2] - [--authmech1 ] [--authmech2 ] - [--noauthmd5] + [--authmech1 ] [--authmech2 ] + [--proxyauth1] [--proxyauth2] + [--domain1] [--domain2] + [--authmd51] [--authmd52] [--folder --folder ...] [--folderrec --folderrec ...] [--include ] [--exclude ] @@ -89,7 +91,6 @@ The option list: [--justfolders] [--justfoldersizes] [--justconnect] [--justbanner] [--syncinternaldates] [--idatefromheader] - [--buffersize ] [--syncacls] [--regexmess ] [--regexmess ] [--maxsize ] @@ -98,9 +99,12 @@ The option list: [--minage ] [--skipheader ] [--useheader ] [--useheader ] + [--nouid1] [--nouid1] + [--usecache] [--skipsize] [--allowsizemismatch] [--delete] [--delete2] [--expunge] [--expunge1] [--expunge2] [--uidexpunge2] + [--delete2folders] [--delete2foldersonly] [--delete2foldersbutnot] [--subscribed] [--subscribe] [--subscribe_all] [--nofoldersizes] [--dry] @@ -108,9 +112,11 @@ The option list: [--timeout ] [--fast] [--split1] [--split2] [--reconnectretry1 ] [--reconnectretry2 ] + [--noreleasecheck] [--pidfile ] [--tmpdir ] [--version] [--help] + [--tests] [--tests_debug] =cut # comment @@ -140,7 +146,11 @@ especially with large messages. You can decide to delete the messages from the source mailbox after a successful transfer (it is a good feature when migrating). -In that case, use the --delete --expunge1 options. +In that case, use the --delete option. Option --delete implies +also option --expunge so all messages marked deleted on host1 +will be really deleted. +(you can use --noexpunge to avoid this but I don't see any +real world scenario for the combinaison --delete --noexpunge). You can also just synchronize a mailbox A from another mailbox B in case you just want to keep a "live" copy of B in A (--delete2 @@ -204,6 +214,9 @@ is the only way to go for now. So don't use --authmech1 SOMETHING with --authuser1 "adminuser", it will not work. Same behavior with the --authuser2 option. +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 =head1 EXIT STATUS @@ -219,7 +232,7 @@ in a Bourne shell: =head1 LICENSE -imapsync is free, gratis and open source software cover by +imapsync is free, open source but not always gratis software cover by the Do What The Fuck You Want To Public License (WTFPL). See COPYING file included in the distribution or the web site http://sam.zoy.org/wtfpl/COPYING @@ -261,7 +274,7 @@ A better place is the public imapsync mailing-list (see below). Gilles LAMIRAL earns his living writing, installing, -configuring and teaching free, open and gratis +configuring and teaching free, open and often gratis softwares. Do not hesitate to pay him for that services. =head1 BUG REPORT GUIDELINES @@ -286,7 +299,7 @@ Don't write an email title with just "imapsync" or "problem", a good title is made of keywords summary, not too long (one visible line). Don't write imapsync in uppercase in the email title, we'll -know you run windows(tm) and you haven't read the README yet. +know you run Windows and you haven't read this README yet. Help us to help you: in your report, please include: @@ -320,18 +333,18 @@ and then forget it. =head1 IMAP SERVERS -Failure stories reported with the following 4 imap servers: +Failure stories reported with the following 3 imap servers: - MailEnable 1.54 (Proprietary) http://www.mailenable.com/ - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works. Patient and confident testers are welcome. - - dkimap4 2.39 - Imail 7.04 (maybe). -Success stories reported with the following 36 imap servers +Success stories reported with the following 40 imap servers (software names are in alphabetic order): - 1und1 H mimap1 84498 [host1] + - a1.net imap.a1.net IMAP4 Ready WARSBL614 00029c23 [host1] - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] (OSL 3.0) http://www.archiveopteryx.org/ - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) @@ -352,12 +365,15 @@ Success stories reported with the following 36 imap servers - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). 2.0.7 seems buggy. - Deerfield VisNetic MailServer 5.8.6 [host1] - - Domino (Notes) 4.61[host1], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1[host1], 8.0.1[host1] + - dkimap4 [host1] + - Domino (Notes) 4.61[host1], 6.5[host1], 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, + 7.0.1[host1], 8.0.1[host1], 8.5.2[host2] - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, 1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/) - Eudora WorldMail v2 - GMX IMAP4 StreamProxy. - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. + - hMailServer 5.3.3 [host2], 4.4.1 [host1] (see FAQ) - iPlanet Messaging server 4.15, 5.1, 5.2 - IMail 7.15 (Ipswitch/Win2003), 8.12 - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform) @@ -366,18 +382,19 @@ Success stories reported with the following 36 imap servers 6.5.7638.1 [host2], Exchange 2007 SP1 (with Update Rollup 2), Exchange2007-EP-SP2, Exchange 2010 RTM (Release to Manufacturing) [host2] + - Mirapoint - Netscape Mail Server 3.6 (Wintel !) - Netscape Messaging Server 4.15 Patch 7 - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) - OpenWave + - Oracle Beehive [host1] - Qualcomm Worldmail (NT) - Rockliffe Mailsite 5.3.11, 4.5.6 - Samsung Contact IMAP server 8.5.0 - Scalix v10.1, 10.0.1.3, 11.0.0.431 - - SmarterMail, Smarter Mail 5.0 Enterprise. + - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [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 - - Sun Messaging Server 6.3 + - Sun Java(tm) System Messaging Server 6.2-2.05, 6.2-7.05, 6.3 - Surgemail 3.6f5-5 - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) @@ -401,10 +418,6 @@ Example: imapsync --host1 imap.troc.org --host2 imap.trac.org --justconnect -Please rate imapsync at http://freshmeat.net/projects/imapsync/ -or better give the author a book, he likes books: -http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ -(or its paypal account gilles.lamiral@laposte.net) =head1 HUGE MIGRATION @@ -413,6 +426,7 @@ Pay special attention to options --subscribe --delete --delete2 +--delete2folders --expunge --expunge1 --expunge2 @@ -475,7 +489,7 @@ Entries for imapsync: Feedback (good or bad) will often be welcome. -$Id: imapsync,v 1.366 2010/10/25 17:15:52 gilles Exp gilles $ +$Id: imapsync,v 1.398 2011/01/18 03:03:24 gilles Exp gilles $ =cut @@ -500,6 +514,8 @@ use File::Spec; use File::Path qw(mkpath rmtree); use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE); use Errno qw(EAGAIN EPIPE ECONNRESET); +use File::Glob ':glob' ; +use IO::File; use Test::More 'no_plan'; @@ -519,7 +535,8 @@ my( $rcs, $pidfile, $debug, $debugimap, $debugimap1, $debugimap2, $nb_errors, $host1, $host2, $port1, $port2, - $user1, $user2, $password1, $password2, $passfile1, $passfile2, + $user1, $user2, $domain1, $domain2, + $password1, $password2, $passfile1, $passfile2, @folder, @include, @exclude, @folderrec, $prefix1, $prefix2, @regextrans2, @regexmess, @regexflag, @@ -535,7 +552,7 @@ my( $delete, $delete2, $expunge, $expunge1, $expunge2, $uidexpunge2, $dry, $justfoldersizes, - $authmd5, + $authmd5, $authmd51, $authmd52, $subscribed, $subscribe, $subscribe_all, $version, $help, $justconnect, $justfolders, $justbanner, @@ -559,7 +576,9 @@ my( $timesize, $timebefore, $ssl1, $ssl2, $tls1, $tls2, + $uid1, $uid2, $authuser1, $authuser2, + $proxyauth1, $proxyauth2, $authmech1, $authmech2, $split1, $split2, $reconnectretry1, $reconnectretry2, @@ -569,14 +588,15 @@ my( $releasecheck, $max_msg_size_in_bytes, $modules_version, - $delete2folders, + $delete2folders, $delete2foldersonly, $delete2foldersbutnot, + $usecache, ); # main program # global variables initialisation -$rcs = '$Id: imapsync,v 1.366 2010/10/25 17:15:52 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.398 2011/01/18 03:03:24 gilles Exp gilles $ '; $total_bytes_transferred = 0; $total_bytes_skipped = 0; @@ -638,11 +658,20 @@ $port1 ||= (defined $ssl1 and !defined $tls1) ? 993 : 143; $host2 || missing_option("--host2") ; $port2 ||= (defined $ssl2 && !defined $tls2) ? 993 : 143; -$debugimap1 = $debugimap2 = 1 if ($debugimap); +$debugimap1 = $debugimap2 = 1 if ( $debugimap ) ; +$debug = 1 if ( $debugimap1 or $debugimap2 ) ; # By default, don't take size to compare $skipsize = (defined $skipsize) ? $skipsize : 1; +$uid1 = defined($uid1) ? $uid1 : 1; +$uid2 = defined($uid2) ? $uid2 : 1; + +# Allow size mismatch by default +$allowsizemismatch = defined($allowsizemismatch) ? $allowsizemismatch : 1; + +$delete2folders = 1 + if ( defined( $delete2foldersbutnot ) or defined( $delete2foldersonly ) ) ; if ($justconnect) { justconnect(); @@ -654,6 +683,17 @@ $user2 || missing_option("--user2"); $syncinternaldates = defined($syncinternaldates) ? $syncinternaldates : 1; +# Turn on expunge if there is not explicit option --noexpunge and option +# --delete is given. +# Done because --delete --noexpunge is very dangerous on the second run: +# the Deleted flag is then synced to all previously transfered messages. +# So --delete implies --expunge is a better usability default behaviour. +if ($delete) { + if ( ! defined($expunge)) { + $expunge = 1; + } +} + if($idatefromheader) { print "Turned ON idatefromheader, ", "will set the internal dates on host2 from the 'Date:' header line.\n"; @@ -667,19 +707,36 @@ if ($syncinternaldates) { print "Turned OFF syncinternaldates\n"; } +if(defined($authmd5) and ($authmd5)) { + $authmd51 = 1 ; + $authmd52 = 1 ; +} -if(defined($authmd5) and not($authmd5)) { - $authmech1 ||= 'LOGIN'; - $authmech2 ||= 'LOGIN'; +if(defined($authmd51) and ($authmd51)) { + $authmech1 ||= 'CRAM-MD5'; } else{ - $authmech1 ||= $authuser1 ? 'PLAIN' : 'CRAM-MD5'; - $authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5'; + $authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN'; +} + +if(defined($authmd52) and ($authmd52)) { + $authmech2 ||= 'CRAM-MD5'; +} +else{ + $authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN'; } $authmech1 = uc($authmech1); $authmech2 = uc($authmech2); +if (defined $proxyauth1 && !$authuser1) { + missing_option("With --proxyauth1, --authuser1"); +} + +if (defined $proxyauth2 && !$authuser2) { + missing_option("With --proxyauth2, --authuser2"); +} + $authuser1 ||= $user1; $authuser2 ||= $user2; @@ -695,7 +752,7 @@ $fastio2 = (defined($fastio2)) ? $fastio2 : 0; $reconnectretry1 = (defined($reconnectretry1)) ? $reconnectretry1 : 3; $reconnectretry2 = (defined($reconnectretry2)) ? $reconnectretry2 : 3; -@useheader = ("ALL") unless (@useheader); +@useheader = ("Message-Id") unless (@useheader); print "Host1: imap server [$host1] port [$port1] user [$user1]\n"; print "Host2: imap server [$host2] port [$port2] user [$user2]\n"; @@ -719,14 +776,16 @@ $timestart = time(); $timebefore = $timestart; $debugimap1 and print "Host1 connection\n"; -$imap1 = login_imap($host1, $port1, $user1, $password1, +$imap1 = login_imap($host1, $port1, $user1, $domain1, $password1, $debugimap1, $timeout, $fastio1, $ssl1, $tls1, - $authmech1, $authuser1, $reconnectretry1); + $authmech1, $authuser1, $reconnectretry1, + $proxyauth1, $uid1); $debugimap2 and print "Host2 connection\n"; -$imap2 = login_imap($host2, $port2, $user2, $password2, +$imap2 = login_imap($host2, $port2, $user2, $domain2, $password2, $debugimap2, $timeout, $fastio2, $ssl2, $tls2, - $authmech2, $authuser2, $reconnectretry2); + $authmech2, $authuser2, $reconnectretry2, + $proxyauth2, $uid2); # history @@ -893,39 +952,17 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { my $h2_fold = imap2_folder_name($h1_fold); printf("%-35s -> %-35s\n", "[$h1_fold]", "[$h2_fold]"); - unless ($imap1->select($h1_fold)) { - warn - "Host1 folder $h1_fold: Could not select: ", - $imap1->LastError, "\n"; - $nb_errors++; - next FOLDER; - } + + select_folder($imap1, $h1_fold, 'Host1') or next FOLDER; + if ( ! exists($h2_folders_all{$h2_fold})) { - print "Host2 folder $h2_fold does not exist\n"; - print "Creating folder [$h2_fold]\n"; - unless ($dry){ - unless ($imap2->create($h2_fold)){ - warn "Couldn't create [$h2_fold]: ", - $imap2->LastError,"\n"; - $nb_errors++; - next FOLDER; - } - } - else{ - next FOLDER; - } + create_folder($imap2, $h2_fold, 'Host2') or next FOLDER; } acls_sync($h1_fold, $h2_fold); - - unless ($imap2->select($h2_fold)) { - warn - "Host2 folder $h2_fold: Could not select: ", - $imap2->LastError, "\n"; - $nb_errors++; - next FOLDER; - } + + select_folder($imap2, $h2_fold, 'Host2') or next FOLDER; my @select_results = $imap2->Results(); #print "%%% @select_results\n"; @@ -957,15 +994,48 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { $debug and print "LIST Host2: ", scalar(@h2_msgs), " messages [@h2_msgs]\n"; + my $cache_base = "$tmpdir/imapsync_cache/$host1/$user1/$host2/$user2"; + my $cache_dir = cache_folder( $cache_base, $h1_fold, $h2_fold ); + my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ); + + if ( $usecache ) { + print "cache directory: $cache_dir\n" ; + mkpath( "$cache_dir" ) ; + ( $cache_1_2_ref, $cache_2_1_ref ) = get_cache($cache_dir, \@h1_msgs, \@h2_msgs) if ($usecache) ; + print "CACHE h1 h2: ", scalar( keys %$cache_1_2_ref ), " files\n" ; + $debug and print '[', + map ( { "$_->$cache_1_2_ref->{$_} " } keys %$cache_1_2_ref ), " ]\n"; + #print "CACHE h2 h1: ", scalar( keys %$cache_2_1_ref ), " files\n" ; + #$debug and print '[', + # map ( { "$_->$cache_2_1_ref->{$_} " } keys %$cache_2_1_ref ), " ]\n"; + } + #sleep 4 ; + my %h1_hash = (); my %h2_hash = (); + my ( %h1_msgs_all, %h2_msgs_all ) ; + @h1_msgs_all{ @h1_msgs } = (); + @h2_msgs_all{ @h2_msgs } = (); + + my @h1_msgs_in_cache = keys %$cache_1_2_ref ; + my @h2_msgs_in_cache = keys %$cache_2_1_ref ; + + my ( %h1_msgs_no_cache, %h2_msgs_no_cache ) ; + %h1_msgs_no_cache = %h1_msgs_all ; + %h2_msgs_no_cache = %h2_msgs_all ; + delete @h1_msgs_no_cache{ @h1_msgs_in_cache } ; + delete @h2_msgs_no_cache{ @h2_msgs_in_cache } ; + + my @h1_msgs_no_cache = keys %h1_msgs_no_cache ; + my @h2_msgs_no_cache = keys %h2_msgs_no_cache ; + $debug and print "Host1 folder [$h1_fold] parsing headers\n"; last FOLDER if $imap1->IsUnconnected(); last FOLDER if $imap2->IsUnconnected(); my ($h1_heads_ref, $h1_fir_ref) = ({}, {}); - $h1_heads_ref = $imap1->parse_headers([@h1_msgs], @useheader) if (@h1_msgs); + $h1_heads_ref = $imap1->parse_headers([@h1_msgs_no_cache], @useheader) if (@h1_msgs_no_cache); $debug and print "Time headers: ", timenext(), " s\n"; last FOLDER if $imap1->IsUnconnected(); @@ -984,7 +1054,7 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { my @h1_msgs_duplicate; - foreach my $m (@h1_msgs) { + foreach my $m (@h1_msgs_no_cache) { my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, "F", \%h1_hash); if (! defined($rc)) { my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; @@ -1006,27 +1076,26 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { $debug and print "Host2 folder [$h2_fold] parsing headers\n"; - my ($h2_heads_ref, $h2_fir_ref) = ({}, {}); - $h2_heads_ref = $imap2->parse_headers([@h2_msgs], @useheader) if (@h2_msgs); + my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} ); + $h2_heads_ref = $imap2->parse_headers([@h2_msgs_no_cache], @useheader) if (@h2_msgs_no_cache); $debug and print "Time headers: ", timenext(), " s\n"; last FOLDER if $imap2->IsUnconnected(); - @$h2_fir_ref{@h2_msgs} = (undef); # fetch_hash_2 can select by uid with last arg as ref + @$h2_fir_ref{@h2_msgs} = ( ); # fetch_hash_2 can select by uid with last arg as ref $h2_fir_ref = $imap2->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref) if (@h2_msgs); $debug and print "Time fir: ", timenext(), " s\n"; last FOLDER if $imap2->IsUnconnected(); my @h2_msgs_duplicate; - foreach my $m (@h2_msgs) { + foreach my $m (@h2_msgs_no_cache) { my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, "T", \%h2_hash); + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; if (! defined($rc)) { - my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; print "+ Skipping msg #$m:$h2_size in host2 folder $h2_fold (no header so we ignore this message)\n"; $h2_nb_msg_noheader += 1 ; } elsif(0 == $rc) { # duplicate - my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; $h2_nb_msg_duplicate += 1; $h2_total_bytes_duplicate += $h2_size; push(@h2_msgs_duplicate, $m); @@ -1191,14 +1260,13 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { print "msg $h1_fold/$h1_msg copied to $h2_fold/$new_id\n"; $total_bytes_transferred += $h1_size; $nb_msg_transferred += 1; + touch( "$cache_dir/${h1_msg}_$new_id" ) if ( $usecache and $new_id =~ m{\d+} ); if($delete) { print "msg $h1_fold/$h1_msg deleted on host1\n"; unless($dry) { $imap1->delete_message($h1_msg); $h1_nb_msg_deleted += 1; - last FOLDER if $imap1->IsUnconnected(); $imap1->expunge() if ($expunge); - last FOLDER if $imap1->IsUnconnected(); } } } @@ -1210,88 +1278,46 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { next MESS; } else{ - #my $h2_size = $h2_hash{$m_id}{'s'}; my $h2_msg = $h2_hash{$m_id}{'m'}; - #my $h2_idate = $h2_hash{$m_id}{'D'}; $debug and print "msg $h1_fold/$h1_msg equals $h2_fold/$h2_msg\n"; $total_bytes_skipped += $h1_size; $nb_msg_skipped += 1; + touch( "$cache_dir/${h1_msg}_$h2_msg" ) if ( $usecache ); } $fast and next MESS; + #$debug and print "MESSAGE $m_id\n"; - my $h2_size = $h2_hash{$m_id}{'s'}; my $h2_msg = $h2_hash{$m_id}{'m'}; - # used cached flag values for efficiency - my $h1_flags = $h1_hash{$m_id}{'F'} || ""; - my $h2_flags = $h2_hash{$m_id}{'F'} || ""; - - # RFC 2060: This flag can not be altered by any client - $h1_flags =~ s@\\Recent\s?@@gi; - $h1_flags = flags_regex($h1_flags) if @regexflag; - $h1_flags = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); + sync_flags( $h1_msg, $h2_msg, $h2_fold, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ; - - # compare flags - set flags if there a difference - my @h1_flags = sort split(' ', $h1_flags ); - my @h2_flags = sort split(' ', $h2_flags ); - my $diff = compare_lists(\@h1_flags, \@h2_flags); - - $diff and $debug and print "msg $h2_fold/$h2_msg replacing h2 flags($h2_flags) with h1 flags($h1_flags)\n"; - - # This sets flags so flags can be removed with this - # When you remove a \Seen flag on host1 you want to it - # to be removed on host2. Just add flags is not what - # we need most of the time. - - if (!$dry and $diff and !$imap2->store($h2_msg, "FLAGS.SILENT (@h1_flags)") ) { - warn "- msg $h2_fold/$h2_msg could not add flags @h1_flags", - $imap2->LastError, "\n"; - #$nb_errors++; - } last FOLDER if $imap2->IsUnconnected(); - $debug and do { - my @h2_flags = @{ $imap2->flags($h2_msg) || [] }; - last FOLDER if $imap2->IsUnconnected(); - - print "host1 flags: $h1_flags\n", - "host2 flags: @h2_flags\n"; - - print "Looking dates\n"; - #my $h1_idate = $imap1->internaldate($h1_msg); - #my $h2_idate = $imap2->internaldate($h2_msg); - my $h1_idate = $h1_hash{$m_id}{'D'}; - my $h2_idate = $h2_hash{$m_id}{'D'}; - print - "host1 internal date: $h1_idate\n", - "host2 internal date: $h2_idate\n"; - - #unless ($h1_idate eq $h2_idate) { - # print "!!! Dates differs !!!\n"; - #} - }; - unless ($skipsize or ($h1_size == $h2_size)) { - # Bad size - print - "- msg $h1_fold/$h1_msg size diff $h1_size != $h2_size $h2_fold/$h2_msg\n"; - $nb_errors++; - } - else { - # Good - $debug and print - "msg $h1_fold/$h1_msg sizes ok $h1_size <=> $h2_size $h2_fold/$h2_msg\n"; - if($delete) { - print "msg $h1_fold/$h1_msg deleted on host1\n"; - unless($dry) { - $imap1->delete_message($h1_msg); - $h1_nb_msg_deleted += 1; - $imap1->expunge() if ($expunge); - } + # Good + my $h2_size = $h2_hash{$m_id}{'s'}; + $debug and print + "msg $h1_fold/$h1_msg sizes $h1_size <> $h2_size $h2_fold/$h2_msg\n"; + if( $delete ) { + print "msg $h1_fold/$h1_msg deleted on host1\n"; + unless( $dry ) { + $imap1->delete_message( $h1_msg ); + $h1_nb_msg_deleted += 1; + $imap1->expunge() if ( $expunge ); } } + } + # END MESS: loop + MESS_IN_CACHE: foreach my $h1_msg ( @h1_msgs_in_cache ) { + my $h2_msg = $cache_1_2_ref->{ $h1_msg } ; + #$debug and print "cache messages update $h1_msg->$h2_msg\n"; + sync_flags( $h1_msg, $h2_msg, $h2_fold, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ; + my $h1_size = $h1_fir_ref->{ $h1_msg }->{ 'RFC822.SIZE' } ; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + } + if ($expunge1){ print "Expunging host1 folder $h1_fold\n"; unless($dry) { $imap1->expunge() }; @@ -1304,6 +1330,38 @@ FOLDER: foreach my $h1_fold (@h1_folders_wanted) { $debug and print "Time: ", timenext(), " s\n"; } +sub sync_flags { + my ( $h1_msg, $h2_msg, $h2_fold, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) = @_ ; + $debug and print "sync flags $h1_msg->$h2_msg\n"; + + # used cached flag values for efficiency + my $h1_flags = $h1_fir_ref->{ $h1_msg }->{ "FLAGS" } ; + my $h2_flags = $h2_fir_ref->{ $h2_msg }->{ "FLAGS" } ; + + # RFC 2060: This flag can not be altered by any client + $h1_flags =~ s@\\Recent\s?@@gi; + $h1_flags = flags_regex($h1_flags) if @regexflag; + $h1_flags = flags_filter($h1_flags, $permanentflags2) if ( $permanentflags2 ); + + # compare flags - set flags if there a difference + my @h1_flags = sort split(' ', $h1_flags ); + my @h2_flags = sort split(' ', $h2_flags ); + my $diff = compare_lists( \@h1_flags, \@h2_flags ); + + #$diff = 1 ; + $diff and $debug and print "msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n"; + # This sets flags so flags can be removed with this + # When you remove a \Seen flag on host1 you want to it + # to be removed on host2. Just add flags is not what + # we need most of the time. + + if ( ! $dry and $diff and ! $imap2->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) { + warn "- msg $h2_fold/$h2_msg could not add flags @h1_flags", + $imap2->LastError, "\n"; + #$nb_errors++; + } +} + print "++++ End looping on each folder\n"; #print memory_consumption(); @@ -1375,7 +1433,8 @@ IO::Socket IO::Socket::SSL Digest::MD5 Digest::HMAC_MD5 -Term::ReadKey)) +Term::ReadKey +Authen::NTLM)) { my $v = "?"; @@ -1549,9 +1608,10 @@ sub justconnect { sub login_imap { - my($host, $port, $user, $password, + my($host, $port, $user, $domain, $password, $debugimap, $timeout, $fastio, - $ssl, $tls, $authmech, $authuser, $reconnectretry) = @_; + $ssl, $tls, $authmech, $authuser, $reconnectretry, + $proxyauth, $uid) = @_; my ($imap); $imap = Mail::IMAPClient->new(); @@ -1563,7 +1623,8 @@ sub login_imap { $imap->Port($port); $imap->Fast_io($fastio); $imap->Buffer($buffersize || 4096); - $imap->Uid(1); + $imap->Uid($uid); + #$imap->Uid(0); $imap->Peek(1); $imap->Debug($debugimap); $timeout and $imap->Timeout($timeout); @@ -1591,13 +1652,27 @@ sub login_imap { } } - $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); + if ($proxyauth) { + $imap->Authmechanism(""); + } else { + $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); + } + $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; - $imap->User($user); - $imap->Authuser($authuser); - $imap->Password($password); + if ($proxyauth) { + $imap->User($authuser); + $imap->Domain($domain) if (defined($domain)); + $imap->Authuser($authuser); + $imap->Password($password); + } else { + $imap->User($user); + $imap->Domain($domain) if (defined($domain)); + $imap->Authuser($authuser); + $imap->Password($password); + } + unless ($imap->login()) { my $info = "Error login: [$host] with user [$user] auth"; my $einfo = $imap->LastError || @{$imap->History}[-1]; @@ -1610,6 +1685,8 @@ sub login_imap { $imap->login() or die_clean("$info [LOGIN]: ", $imap->LastError, "\n"); } + $proxyauth && $imap->proxyauth($user); + print "Success login on [$host] with user [$user] auth [$authmech]\n"; return($imap); } @@ -1637,8 +1714,8 @@ sub banner_imapsync { my @argv_copy = @_; my $banner_imapsync = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.366 $ ', - '$Date: 2010/10/25 17:15:52 $ ', + '$Revision: 1.398 $ ', + '$Date: 2011/01/18 03:03:24 $ ', "\n",localhost_info(), "\n", "Command line used:\n", "$0 ", command_line_nopassword(@argv_copy), "\n", @@ -1655,8 +1732,6 @@ sub is_valid_directory { } - - sub write_pidfile { my $pidfile = shift; @@ -1693,6 +1768,42 @@ sub missing_option { } +sub select_folder { + my ($imap, $folder, $hostside) = @_; + if ( ! $imap->select($folder)) { + warn + "$hostside folder $folder: Could not select: ", + $imap->LastError, "\n"; + $nb_errors++; + return(0); + }else{ + # ok select succeeded + return(1); + } +} + + +sub create_folder { + my ($imap, $folder, $hostside) = @_; + print "$hostside folder $folder does not exist\n"; + print "Creating folder [$folder]\n"; + if ( ! $dry){ + if ( ! $imap->create($folder)){ + warn "Couldn't create [$folder] on $hostside: ", + $imap->LastError,"\n"; + $nb_errors++; + return(0); + }else{ + #create succeeded + return(1); + } + }else{ + # dry mode, no folder so many imap will fail, assuming failure + return(0); + } +} + + sub tests_folder_routines { ok( !is_requested_folder('folder_foo') ); @@ -1840,7 +1951,7 @@ sub get_prefix { print "No NAMESPACE capability in imap server ", $imap->Server(),"\n", - "Give the prefix namespace with the $prefix_opt option\n"; + help_to_guess_prefix($imap, $prefix_opt); exit_clean(1); } } @@ -1860,20 +1971,54 @@ sub get_separator { if ($imap->has_capability("namespace")) { $sep_out = $imap->separator(); return($sep_out) if defined $sep_out; - warn + print "NAMESPACE request failed for ", $imap->Server(), ": ", $imap->LastError, "\n"; exit_clean(1); } else{ - warn + print "No NAMESPACE capability in imap server ", $imap->Server(),"\n", - "Give the separator character with the $sep_opt option\n"; + help_to_guess_sep($imap, $sep_opt); exit_clean(1); } } +sub help_to_guess_sep { + my($imap, $sep_opt) = @_; + + my $help = "Give the separator character with the $sep_opt option,\n" + . "the folowing listing of folders may help you to find it:\n" + . folders_list_to_help($imap) + . "Most of the time it is character . or /\n" + . "so try $sep_opt . or $sep_opt /\n"; + + return($help); +} + +sub help_to_guess_prefix { + my($imap, $prefix_opt) = @_; + + my $help = "Give the prefix namespace with the $prefix_opt option,\n" + . "the folowing listing of folders may help you to find it:\n" + . folders_list_to_help($imap) + . "Most of the time it is INBOX. or an empty string\n" + . "so try $prefix_opt INBOX. or $prefix_opt ''\n"; + + return($help); +} + + +sub folders_list_to_help { + my($imap) = @_; + + my @folders = $imap->folders; + my $listing = join('', map { "[$_]\n" } @folders); + return $listing; + +} + sub separator_invert { # The separator we hope we'll never encounter: 00000000 my $o_sep="\000"; @@ -1952,6 +2097,7 @@ sub foldersizes { my ($side, $imap, @folders) = @_; my $tot = 0; my $tmess = 0; + my $biggest = 0 ; print "++++ Calculating sizes\n"; foreach my $folder (@folders) { @@ -1973,21 +2119,26 @@ sub foldersizes { my $hash_ref = {}; my @msgs = select_msgs($imap); $smess = scalar(@msgs); + my $smax = 0 ; @$hash_ref{@msgs} = (undef); unless ($smess == 0) { $imap->fetch_hash_2("RFC822.SIZE",$hash_ref) or die_clean("$@"); #print map {$hash_ref->{$_}->{"RFC822.SIZE"}, " "} keys %$hash_ref; - map {$stot += $hash_ref->{$_}->{"RFC822.SIZE"}} keys %$hash_ref; + map {$stot += $hash_ref->{$_}->{"RFC822.SIZE"}} keys %$hash_ref ; + $smax = max( map {$hash_ref->{$_}->{"RFC822.SIZE"}} keys %$hash_ref ); + $biggest = max( $biggest, $smax ); } printf(" Size: %9s", $stot); - printf(" Messages: %5s\n", $smess); + printf(" Messages: %5s", $smess); + printf(" Biggest: %9s\n", $smax); $tot += $stot; $tmess += $smess; } - print "Total size: $tot\n"; - print "Total messages: $tmess\n"; - print "Time: ", timenext(), " s\n"; + printf ("Nb messages: %11s\n", $tmess ) ; + printf ("Total size: %11s bytes\n", $tot ) ; + printf ("Biggest message: %11s bytes\n", $biggest ) ; + printf ("Time: %11s secondes\n", timenext( ) ) ; } sub timenext { @@ -2200,7 +2351,8 @@ sub select_msgs { my (@msgs,@max,@min,@union,@inter); unless (defined($maxage) or defined($minage)) { - @msgs = $imap->search("ALL"); + #@msgs = $imap->search("ALL"); + @msgs = $imap->messages(); return(@msgs); } if (defined($maxage)) { @@ -2225,9 +2377,286 @@ sub select_msgs { return(@msgs); } +sub cache_map { + my ( $cache_files_ref, $h1_msgs_ref, $h2_msgs_ref ) = @_; + my ( %map1_2, %map2_1 ) ; + + my $h1_msgs_hash_ref = { } ; + my $h2_msgs_hash_ref = { } ; + + @$h1_msgs_hash_ref{ @$h1_msgs_ref } = ( ) ; + @$h2_msgs_hash_ref{ @$h2_msgs_ref } = ( ) ; + + foreach my $file ( sort @$cache_files_ref ) { + #print "C12: $file\n" ; + ( $uid1, $uid2 ) = match_a_cache_file( $file ) ; + + if ( exists( $h1_msgs_hash_ref->{ $uid1 } ) + and exists( $h2_msgs_hash_ref->{ $uid2 } ) ) { + $map1_2{ $uid1 } = $uid2 ; + }; + + } + %map2_1 = reverse( %map1_2 ) ; + return( \%map1_2, \%map2_1) ; +} + +sub tests_cache_map { + + my @cache_files = qw ( + 100_200 + 101_201 + 120_220 + 142_242 + 143_243 + 177_277 + 177_278 + 177_279 + 155_255 + 180_280 + 181_280 + 182_280 + ) ; + + my $msgs_1 = [120, 142, 143, 144, 177, 182 ]; + my $msgs_2 = [ 242, 243, 299, 377, 279, 255, 280 ]; + + my( $c12, $c21 ) ; + ok( ( $c12, $c21 ) = cache_map( \@cache_files, $msgs_1, $msgs_2 ), 'cache_map: 02' ); + my $a1 = [ sort { $a <=> $b } keys %$c12 ] ; + my $a2 = [ sort { $a <=> $b } keys %$c21 ] ; + ok( 0 == compare_lists( [ 142, 143, 177, 182 ], $a1 ), 'cache_map: 03' ); + ok( 0 == compare_lists( [ 242, 243, 279, 280 ], $a2 ), 'cache_map: 04' ); + +} + + +sub get_cache { + + my ($cache_dir, $h1_msgs_ref, $h2_msgs_ref) = @_; + + -d $cache_dir or return( undef ); # exit if cache directory doesn't exist + #print "cache_dir: $cache_dir\n"; + + my @cache_files = bsd_glob( "$cache_dir/*" ) ; + #print "cache_files: [@cache_files]\n"; + + my( $cache_1_2_ref, $cache_2_1_ref ) + = cache_map( \@cache_files, $h1_msgs_ref, $h2_msgs_ref ) ; + + clean_cache( \@cache_files, $cache_1_2_ref ) + if ( ! ( defined( $maxsize ) + or defined( $minsize ) + or defined( $maxage ) + or defined( $minage ) ) ); + + #print "\n", map { "c12 $_ -> $cache_1_2_ref->{ $_ }\n" } keys %$cache_1_2_ref ; + #print "\n", map { "c21 $_ -> $cache_2_1_ref->{ $_ }\n" } keys %$cache_2_1_ref ; + + return ( $cache_1_2_ref, $cache_2_1_ref ) ; +} + +sub tests_get_cache { + + ok( ! get_cache('/cache_no_exist'), 'get_cache: /cache_no_exist' ); + ok( ( ! -d 'tmp/cache/F1/F2' or rmtree( 'tmp/cache/F1/F2' )), 'get_cache: rmtree tmp/cache/F1/F2' ) ; + ok( mkpath( 'tmp/cache/F1/F2' ), 'get_cache: mkpath tmp/cache/F1/F2' ) ; + + my @test_files_cache = ( qw( + tmp/cache/F1/F2/100_200 + tmp/cache/F1/F2/101_201 + tmp/cache/F1/F2/120_220 + tmp/cache/F1/F2/142_242 + tmp/cache/F1/F2/143_243 + tmp/cache/F1/F2/177_277 + tmp/cache/F1/F2/177_377 + tmp/cache/F1/F2/177_777 + tmp/cache/F1/F2/155_255 + ) ) ; + ok( touch(@test_files_cache), 'get_cache: touch tmp/cache/F1/F2/...' ) ; + + + # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255 + # on live: + my $msgs_1 = [120, 142, 143, 144, 177 ]; + my $msgs_2 = [ 242, 243, 299, 377, 777, 255 ]; + + my( $c12, $c21 ) ; + ok( ( $c12, $c21 ) = get_cache('tmp/cache/F1/F2', $msgs_1, $msgs_2), 'get_cache: 02' ); + my $a1 = [ sort { $a <=> $b } keys %$c12 ] ; + my $a2 = [ sort { $a <=> $b } keys %$c21 ] ; + ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' ); + ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' ); + ok( -f 'tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242'); + ok( -f 'tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243'); + ok( ! -f 'tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200'); + ok( ! -f 'tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201'); + + # test clean_cache not executed + $maxage = 2 ; + ok( touch(@test_files_cache), 'get_cache: touch tmp/cache/F1/F2/...' ) ; + ok( ( $c12, $c21 ) = get_cache('tmp/cache/F1/F2', $msgs_1, $msgs_2), 'get_cache: 02' ); + ok( -f 'tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242'); + ok( -f 'tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243'); + ok( -f 'tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200'); + ok( -f 'tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201'); + + +} + +sub match_a_cache_file { + my $file = shift ; + my ( $uid1, $uid2 ) ; + + return( ( undef, undef ) ) if ( ! $file ) ; + if ( $file =~ m{(?:^|/)(\d+)_(\d+)$} ) { + $uid1 = $1 ; + $uid2 = $2 ; + } + return( $uid1, $uid2 ) ; +} + +sub tests_match_a_cache_file { + my ( $uid1, $uid2 ) ; + ok( ( $uid1, $uid2 ) = match_a_cache_file( ), 'match_a_cache_file: no arg' ) ; + ok( ! defined( $uid1 ), 'match_a_cache_file: no arg 1' ) ; + ok( ! defined( $uid2 ), 'match_a_cache_file: no arg 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '' ), 'match_a_cache_file: empty arg' ) ; + ok( ! defined( $uid1 ), 'match_a_cache_file: empty arg 1' ) ; + ok( ! defined( $uid2 ), 'match_a_cache_file: empty arg 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '000_000' ), 'match_a_cache_file: 000_000' ) ; + ok( '000' eq $uid1, 'match_a_cache_file: 000_000 1' ) ; + ok( '000' eq $uid2, 'match_a_cache_file: 000_000 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ; + ok( '123' eq $uid1, 'match_a_cache_file: 123_456 1' ) ; + ok( '456' eq $uid2, 'match_a_cache_file: 123_456 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ; + ok( '123' eq $uid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ; + ok( '456' eq $uid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ; + ok( ! $uid1, 'match_a_cache_file: /lala123_456 1' ) ; + ok( ! $uid2, 'match_a_cache_file: /lala123_456 2' ) ; + + ok( ( $uid1, $uid2 ) = match_a_cache_file( 'la123_456' ), 'match_a_cache_file: NO la123_456' ) ; + ok( ! $uid1, 'match_a_cache_file: la123_456 1' ) ; + ok( ! $uid2, 'match_a_cache_file: la123_456 2' ) ; + + +} + +sub clean_cache { + my $cache_files_ref = shift ; + my $cache_1_2_ref = shift ; + + #print map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %$cache_1_2_ref ; + foreach my $file ( @$cache_files_ref ) { + #print "$file\n" ; + my ( $uid1, $uid2 ) = match_a_cache_file( $file ) ; + #print "$uid1 $uid2 ", $cache_1_2_ref->{ $uid1 }, "\n" ; + if ( ( ! defined( $uid1 ) ) + or ( ! defined( $uid2 ) ) + or ( ! exists( $cache_1_2_ref->{ $uid1 } ) ) + or ( ! ( $uid2 == $cache_1_2_ref->{ $uid1 } ) ) ) { + #print "remove $file\n" ; + unlink( $file ) ; + } + } + return( 1 ) ; +} + +sub tests_clean_cache { + + ok( ( ! -d 'tmp/cache/G1/G2' or rmtree( 'tmp/cache/G1/G2' )), 'clean_cache: rmtree tmp/cache/G1/G2' ) ; + ok( mkpath( 'tmp/cache/G1/G2' ), 'clean_cache: mkpath tmp/cache/G1/G2' ) ; + + my @test_files_cache = ( qw( + tmp/cache/G1/G2/100_200 + tmp/cache/G1/G2/101_201 + tmp/cache/G1/G2/120_220 + tmp/cache/G1/G2/142_242 + tmp/cache/G1/G2/143_243 + tmp/cache/G1/G2/177_277 + tmp/cache/G1/G2/177_377 + tmp/cache/G1/G2/177_777 + tmp/cache/G1/G2/155_255 + ) ) ; + ok( touch(@test_files_cache), 'clean_cache: touch tmp/cache/G1/G2/...' ) ; + + ok( -f 'tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' ); + ok( -f 'tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' ); + ok( -f 'tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' ); + ok( -f 'tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' ); + ok( -f 'tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' ); + ok( -f 'tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' ); + + my $cache = { + 142 => 242, + 177 => 777, + } ; + + ok( clean_cache( \@test_files_cache, $cache ), 'clean_cache: ' ) ; + + ok( ! -f 'tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' ); + ok( -f 'tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' ); + ok( ! -f 'tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' ); + ok( ! -f 'tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' ); + ok( -f 'tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' ); + ok( ! -f 'tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' ); +} + + + +sub touch { + my @files = @_ ; + my @result; + + foreach my $file ( @files ) { + my $fh = new IO::File ; + if ($fh->open(">> $file")) { + $fh->close ; + push(@result, $file) ; + } + } + return(@result); +} + +sub cache_folder { + my( $cache_dir, $h1_fold, $h2_fold ) = @_ ; + + #print "sep1 $h1_sep sep2 $h2_sep\n"; + my $sep1 = $h1_sep || '/'; + my $sep2 = $h2_sep || '/'; + + my $h1_fold_slash = convert_sep_to_slash( $h1_fold, $sep1 ); + my $h2_fold_slash = convert_sep_to_slash( $h2_fold, $sep2 ); + + return( "$cache_dir/$h1_fold_slash/$h2_fold_slash" ) ; +} + +sub convert_sep_to_slash { + my ($folder, $sep) = @_; + + $folder =~ s{\Q$sep\E}{/}g; + return($folder); +} + +sub tests_convert_sep_to_slash { + + ok('' eq convert_sep_to_slash('', '/'), 'convert_sep_to_slash: no folder'); + ok('INBOX' eq convert_sep_to_slash('INBOX', '/'), 'convert_sep_to_slash: INBOX'); + ok('INBOX/foo' eq convert_sep_to_slash('INBOX/foo', '/'), 'convert_sep_to_slash: INBOX/foo'); + ok('INBOX/foo' eq convert_sep_to_slash('INBOX_foo', '_'), 'convert_sep_to_slash: INBOX_foo'); + ok('INBOX/foo/zob' eq convert_sep_to_slash('INBOX_foo_zob', '_'), 'convert_sep_to_slash: INBOX_foo_zob'); + ok('INBOX/foo' eq convert_sep_to_slash('INBOX.foo', '.'), 'convert_sep_to_slash: INBOX.foo'); + ok('INBOX/foo/hi' eq convert_sep_to_slash('INBOX.foo.hi', '.'), 'convert_sep_to_slash: INBOX.foo.hi'); +} + - - sub tests_regexmess { ok("blabla" eq regexmess("blabla"), "regexmess, no regexmess, nothing to do"); @@ -2328,6 +2757,7 @@ sub stats { print "Reconnections to host1 : $host1_reconnect_count\n"; print "Reconnections to host2 : $host2_reconnect_count\n"; printf ("Memory consumption : %.1f MB\n", $memory_consumption / 1024 / 1024); + print "Biggest message : $max_msg_size_in_bytes bytes\n"; print "Memory/biggest message ratio : $memory_ratio\n"; print "Detected $nb_errors errors\n\n"; @@ -2337,6 +2767,13 @@ sub stats { sub thank_author { + return("Homepage: http://www.linux-france.org/prj/imapsync/\n"); + + my $basename = imapsync_basename(); + $debug and print "[$basename]\n"; + return("Homepage: http://www.linux-france.org/prj/imapsync/\n") + if ( $basename =~ /\.exe$|\.bin$/ ); + return(join("", "Happy with this free, open and gratis DWTFPL software?\n", "Encourage the author (Gilles LAMIRAL) by giving him a book\n", "or just money via paypal:\n", @@ -2365,11 +2802,15 @@ sub get_options { "port2=i" => \$port2, "user1=s" => \$user1, "user2=s" => \$user2, + "domain1=s" => \$domain1, + "domain2=s" => \$domain2, "password1=s" => \$password1, "password2=s" => \$password2, "passfile1=s" => \$passfile1, "passfile2=s" => \$passfile2, "authmd5!" => \$authmd5, + "authmd51!" => \$authmd51, + "authmd52!" => \$authmd52, "sep1=s" => \$sep1, "sep2=s" => \$sep2, "folder=s" => \@folder, @@ -2384,6 +2825,8 @@ sub get_options { "delete!" => \$delete, "delete2!" => \$delete2, "delete2folders!" => \$delete2folders, + "delete2foldersonly=s" => \$delete2foldersonly, + "delete2foldersbutnot=s" => \$delete2foldersbutnot, "syncinternaldates!" => \$syncinternaldates, "idatefromheader!" => \$idatefromheader, "syncacls!" => \$syncacls, @@ -2391,7 +2834,6 @@ sub get_options { "minsize=i" => \$minsize, "maxage=i" => \$maxage, "minage=i" => \$minage, - "buffersize=i" => \$buffersize, "foldersizes!" => \$foldersizes, "dry!" => \$dry, "expunge!" => \$expunge, @@ -2419,12 +2861,17 @@ sub get_options { "ssl2!" => \$ssl2, "tls1!" => \$tls1, "tls2!" => \$tls2, + "uid1!" => \$uid1, + "uid2!" => \$uid2, "authmech1=s" => \$authmech1, "authmech2=s" => \$authmech2, "authuser1=s" => \$authuser1, "authuser2=s" => \$authuser2, + "proxyauth1" => \$proxyauth1, + "proxyauth2" => \$proxyauth1, "split1=i" => \$split1, "split2=i" => \$split2, + "buffersize=i" => \$buffersize, "reconnectretry1=i" => \$reconnectretry1, "reconnectretry2=i" => \$reconnectretry2, "tests" => \$tests, @@ -2435,6 +2882,7 @@ sub get_options { "pidfile=s" => \$pidfile, "releasecheck!" => \$releasecheck, "modules_version!" => \$modules_version, + "usecache!" => \$usecache, ); $debug and print "get options: [$opt_ret]\n"; @@ -2512,13 +2960,9 @@ sub parse_header_msg { } #return unless ($headstr); unless ($headstr){ - # taking everything is too heavy, - # should take only 1 Ko - #print "no header so taking everything\n"; - #$headstr = $imap->message_string($m_uid); - - print "no header so we ignore this message\n"; - return undef; + print "no header so taking body first 2Ko\n"; + $imap->fetch($m_uid, "BODY.PEEK[TEXT]<0.2048>"); + $headstr = $imap->_transaction_literals; } my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"}; my $flags = $s_fir->{$m_uid}->{"FLAGS"}; @@ -2543,7 +2987,7 @@ sub parse_header_msg { } -sub firstline { +sub firstline { # extract the first line of a file (without \n) my($file) = @_; @@ -2591,9 +3035,10 @@ sub is_a_release_number { sub check_last_release { my $public_release = not_long('imapsync_version_lfo'); + print "check_last_release: [$public_release]\n" ; return('unknown') if ($public_release eq 'unknown'); - return('unknown') if (! is_a_release_number($public_release)); return('timeout') if ($public_release eq 'timeout'); + return('unknown') if (! is_a_release_number($public_release)); my $imapsync_here = imapsync_version(); @@ -2605,7 +3050,7 @@ sub check_last_release { } sub imapsync_version { - my $rcs = '$Id: imapsync,v 1.366 2010/10/25 17:15:52 gilles Exp gilles $ '; + my $rcs = '$Id: imapsync,v 1.398 2011/01/18 03:03:24 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; my $VERSION = ($1) ? $1: "UNKNOWN"; return($VERSION); @@ -2632,7 +3077,7 @@ sub imapsync_version_lfo { . ", Mail::IMAPClient $Mail::IMAPClient::VERSION" . " $imapsync_basename"; my $sock = new IO::Socket::INET ( - PeerAddr => 'linux-france.org', + PeerAddr => 'imapsync.lamiral.info', PeerPort => '80', Proto => 'tcp'); return('unknown') if not $sock; @@ -2677,6 +3122,7 @@ sub not_long { alarm(0); }; if ($@) { + #print "$@"; if ($@ =~ /alarm/) { # timed out return('timeout'); @@ -2720,17 +3166,26 @@ Several options are mandatory. --host1 : "from" imap server. Mandatory. --port1 : port to connect on host1. Default is 143. --user1 : user to login on host1. Mandatory. +--domain1 : domain on host1 (NTLM authentication). --authuser1 : user to auth with on host1 (admin user). Avoid using --authmech1 SOMETHING with --authuser1. +--proxyauth1 : Use proxyauth on host1. Requires --authuser1. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user --password1 : password for the user1. Dangerous, use --passfile1 --passfile1 : password file for the user1. Contains the password. --host2 : "destination" imap server. Mandatory. --port2 : port to connect on host2. Default is 143. --user2 : user to login on host2. Mandatory. +--domain2 : domain on host2 (NTLM authentication). --authuser2 : user to auth with on host2 (admin user). +--proxyauth2 : Use proxyauth on host2. Requires --authuser2. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user --password2 : password for the user2. Dangerous, use --passfile2 --passfile2 : password file for the user2. Contains the password. ---noauthmd5 : don't use MD5 authentification. +--authmd51 : Use MD5 authentification for host1. +--authmd52 : Use MD5 authentification for host2. --authmech1 : auth mechanism to use with host1: PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. --authmech2 : auth mechanism to use with host2. See --authmech1 @@ -2779,30 +3234,30 @@ Several options are mandatory. --delete : delete messages on host1 server after a successful transfer. Useful in case you want to migrate from one server to another one. - With imap, "delete" tags messages as deleted, they - are not really deleted. See expunge. + With imapsync, --delete tags messages as deleted and they + are really deleted unless --noexpunge is used. --delete2 : delete messages in host2 that are not in host1 server. --delete2folders : delete folders in host2 that are not in - host1 server. For safety try it like this: + host1 server. For safety, please try it like this (safe): --delete2folders --dry --justfolders --nofoldersizes ---expunge : expunge messages on host1. - expunge really deletes messages marked deleted. - expunge is made at the beginning, on host1 only. - Newly transferred messages are expunged if - option --expunge is given. - No expunge is done on destination account - (see --expunge2) but it may change in future releases. ---expunge1 : expunge messages on host1. ---expunge2 : expunge messages on host2. ---uidexpunge2 : uidexpunge messages on the destination imap server - that are not on the source server, requires --delete2 +--delete2foldersonly : delete only folders matching regex. +--delete2foldersbutnot : do not delete folders matching regex. +--noexpunge : Do not expunge messages on host1. + Expunge really deletes messages marked deleted. + Expunge is made at the beginning, on host1 only. + Newly transferred messages are also expunged if + option --delete is given. + No expunge is done on host2 account (unless --expunge2) +--expunge1 : expunge messages on host1 after the transfer of messages. +--expunge2 : expunge messages on host2 after the transfer of messages. +--uidexpunge2 : uidexpunge messages on the host2 account + that are not on the host1 account, requires --delete2 --syncinternaldates : sets the internal dates on host2 same as host1. Turned on by default. Internal date is the date a message arrived on a host (mtime). --idatefromheader : sets the internal dates on host2 same as the - "Date:" headers. ---buffersize : sets the size of a block of I/O. + "Date:" headers. --maxsize : skip messages larger (or equal) than bytes --minsize : skip messages smaller (or equal) than bytes --maxage : skip messages older than days. @@ -2835,8 +3290,10 @@ Several options are mandatory. --nofoldersizes : Do not calculate the size of each folder in bytes and message counts. Default is to calculate them. --justfoldersizes : exit after printed the folder sizes. ---syncacls : Synchronises acls (Access Control Lists). ---nosyncacls : Does not synchronise acls. This is the default. +--syncacls : synchronises acls (Access Control Lists). +--nosyncacls : does not synchronise acls. This is the default. +--usecache : Use cache to speedup. +--nousecache : Do not use cache. --debug : debug mode. --debugimap1 : imap debug mode for host1. imap debug is very verbose. --debugimap2 : imap debug mode for host2. @@ -2857,8 +3314,6 @@ Several options are mandatory. is the number of messages handled per request. default is like --split1 1000. --split2 : same thing on host2. ---fastio1 : use fastio with host1. ---fastio2 : use fastio with host2. --timeout : imap connect timeout. --help : print this help. @@ -2930,7 +3385,7 @@ sub memory_consumption_of_pids { @val = memory_consumption_of_pids_win32(@PID); }else{ # Unix - my @ps = qx{ ps o vsz @PID }; + my @ps = qx{ ps -o vsz @PID }; shift @ps; # First line is column name "VSZ" chomp @ps; # convert to @@ -3080,7 +3535,14 @@ sub delete_folders_in_2_not_in_1 { my $dry_message = ''; $dry_message = "\t(not really since --dry mode)" if $dry; foreach my $folder (@h2_folders_not_in_1) { - + if ( defined($delete2foldersonly) and eval("\$folder !~ $delete2foldersonly" ) ) { + print "Not deleting $folder because of --delete2foldersonly $delete2foldersonly\n"; + next; + } + if ( defined($delete2foldersbutnot) and eval("\$folder =~ $delete2foldersbutnot" ) ) { + print "Not deleting $folder because of --delete2foldersbutnot $delete2foldersbutnot\n"; + next; + } my $res = $dry; # always success in dry mode! $res = $imap2->delete($folder) if ( ! $dry ) ; if ($res) { @@ -3094,8 +3556,12 @@ sub delete_folders_in_2_not_in_1 { sub tests_debug { SKIP: { - skip "No test in normal run" if (not $tests_debug); - tests_list_keys_in_2_not_in_1(); + skip "No test in normal run" if ( not $tests_debug ); + tests_convert_sep_to_slash( ) ; + tests_cache_map( ) ; + tests_get_cache( ) ; + tests_clean_cache( ) ; + tests_match_a_cache_file( ) ; } } @@ -3118,6 +3584,11 @@ sub tests { tests_is_a_release_number(); tests_imapsync_basename(); tests_list_keys_in_2_not_in_1(); + tests_convert_sep_to_slash( ) ; + tests_cache_map( ) ; + tests_get_cache( ) ; + tests_clean_cache( ) ; + tests_match_a_cache_file( ) ; } } @@ -3139,6 +3610,18 @@ 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; +}; + + *Mail::IMAPClient::append_file = sub { my $self = shift; diff --git a/imapsync.exe b/imapsync.exe new file mode 100755 index 0000000..11c42d1 Binary files /dev/null and b/imapsync.exe differ diff --git a/imapsync_1.383 b/imapsync_1.383 new file mode 100755 index 0000000..88d47da --- /dev/null +++ b/imapsync_1.383 @@ -0,0 +1,4383 @@ +#!/usr/bin/perl + +# structure +# pod documentation +# pragmas +# main program +# global variables initialisation +# default values +# folder loop +# subroutines +# IMAPClient 2.2.9 overrides +# IMAPClient 2.2.9 3.xx ads + +=pod + +=head1 NAME + +imapsync - IMAP synchronisation, sync, copy or migration +tool. Synchronise mailboxes between two imap servers. Good +at IMAP migration. More than 36 different IMAP server softwares +supported with success. + +$Revision: 1.383 $ + +=head1 SYNOPSIS + +To synchronise imap account "foo" on "imap.truc.org" + to imap account "bar" on "imap.trac.org" + with foo password "secret1" + and bar password "secret2": + + imapsync \ + --host1 imap.truc.org --user1 foo --password1 secret1 \ + --host2 imap.trac.org --user2 bar --password2 secret2 + +=head1 INSTALL + + imapsync works fine under any Unix OS with perl. + imapsync works fine under Windows (2000, XP) + with Strawberry Perl 5.10 or 5.12 + or as a standalone binary software imapsync.exe + +imapsync is already available directly on the following distributions +(at least): +FreeBSD, Debian, Ubuntu, Gentoo, Fedora, +NetBSD, Darwin, Mandriva and OpenBSD. + + Get imapsync at + http://www.linux-france.org/prj/imapsync/ + + You'll receive a link to a compressed tarball called imapsync-x.xx.tgz + where x.xx is the version number. Untar the tarball where + you want (on Unix): + + tar xzvf imapsync-x.xx.tgz + + Go into the directory imapsync-x.xx and read the INSTALL file. + The INSTALL file is also at + http://www.linux-france.org/prj/imapsync/INSTALL + + The freshmeat record is at http://freshmeat.net/projects/imapsync/ + +=head1 USAGE + + imapsync [options] + +To get a description of each option just run imapsync like this: + + imapsync --help + imapsync + +The option list: + + imapsync [--host1 server1] [--port1 ] + [--user1 ] [--passfile1 ] + [--host2 server2] [--port2 ] + [--user2 ] [--passfile2 ] + [--ssl1] [--ssl2] + [--tls1] [--tls2] + [--authmech1 ] [--authmech2 ] + [--noauthmd5] + [--folder --folder ...] + [--folderrec --folderrec ...] + [--include ] [--exclude ] + [--prefix2 ] [--prefix1 ] + [--regextrans2 --regextrans2 ...] + [--sep1 ] + [--sep2 ] + [--justfolders] [--justfoldersizes] [--justconnect] [--justbanner] + [--syncinternaldates] + [--idatefromheader] + [--buffersize ] + [--syncacls] + [--regexmess ] [--regexmess ] + [--maxsize ] + [--minsize ] + [--maxage ] + [--minage ] + [--skipheader ] + [--useheader ] [--useheader ] + [--skipsize] [--allowsizemismatch] + [--delete] [--delete2] + [--expunge] [--expunge1] [--expunge2] [--uidexpunge2] + [--subscribed] [--subscribe] [--subscribe_all] + [--nofoldersizes] + [--dry] + [--debug] [--debugimap][--debugimap1][--debugimap2] + [--timeout ] [--fast] + [--split1] [--split2] + [--reconnectretry1 ] [--reconnectretry2 ] + [--pidfile ] + [--tmpdir ] + [--version] [--help] + +=cut +# comment + +=pod + +=head1 DESCRIPTION + +The command imapsync is a tool allowing incremental and +recursive imap transfer from one mailbox to another. + +By default all folders are transferred, recursively. + +We sometimes need to transfer mailboxes from one imap server to +another. This is called migration. + +imapsync is a good tool because it reduces the amount +of data transferred by not transferring a given message if it +is already on both sides. Same headers +and the transfer is done only once. All flags are +preserved, unread will stay unread, read will stay read, +deleted will stay deleted. You can stop the transfer at any +time and restart it later, imapsync works well with bad +connections. imapsync is CPU hungry so nice and renice +commands can be a good help. imapsync can be memory hungry too, +especially with large messages. + +You can decide to delete the messages from the source mailbox +after a successful transfer (it is a good feature when migrating). +In that case, use the --delete --expunge1 options. + +You can also just synchronize a mailbox A from another mailbox B +in case you just want to keep a "live" copy of B in A (--delete2 +may help) + +=head1 OPTIONS + +To get a description of each option just invoke: + +imapsync --help + +=head1 HISTORY + +I wrote imapsync because an enterprise (basystemes) paid me to install +a new imap server without losing huge old mailboxes located on a far +away remote imap server accessible by a low bandwidth link. The tool +imapcp (written in python) could not help me because I had to verify +every mailbox was well transferred and delete it after a good +transfer. imapsync started life as a copy_folder.pl patch. +The tool copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl +module tarball source (in the examples/ directory of the tarball). + +=head1 EXAMPLE + +While working on imapsync parameters please run imapsync in +dry mode (no modification induced) with the --dry +option. Nothing bad can be done this way. + +To synchronize the imap account "buddy" (with password "secret1") +on host "imap.src.fr" to the imap account "max" (with password "secret2") +on host "imap.dest.fr": + + imapsync --host1 imap.src.fr --user1 buddy --password1 secret1 \ + --host2 imap.dest.fr --user2 max --password2 secret2 + +Then you will have max's mailbox updated from buddy's +mailbox. + +=head1 SECURITY + +You can use --passfile1 instead of --password1 to give the +password since it is safer. With --password1 option any user +on your host can see the password by using the 'ps auxwwww' +command. Using a variable (like $PASSWORD1) is also +dangerous because of the 'ps auxwwwwe' command. So, saving +the password in a well protected file (600 or rw-------) is +the best solution. + +imasync is not totally protected against sniffers on the +network since passwords may be transferred in plain text +if CRAM-MD5 is not supported by your imap servers. Use +--ssl1 (or --tls1) and --ssl2 (or --tls2) to enable +encryption on host1 and host2. + +You may authenticate as one user (typically an admin user), +but be authorized as someone else, which means you don't +need to know every user's personal password. Specify +--authuser1 "adminuser" to enable this on host1. In this +case, --authmech1 PLAIN will be used by default since it +is the only way to go for now. So don't use --authmech1 SOMETHING +with --authuser1 "adminuser", it will not work. +Same behavior with the --authuser2 option. + +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 + +=head1 EXIT STATUS + +imapsync will exit with a 0 status (return code) if everything went good. +Otherwise, it exits with a non-zero status. + +So if you have an unreliable internet connection, you can use this loop +in a Bourne shell: + + while ! imapsync ...; do + echo imapsync not complete + done + +=head1 LICENSE + +imapsync is free, open source but not always gratis software cover by +the Do What The Fuck You Want To Public License (WTFPL). +See COPYING file included in the distribution or the web site +http://sam.zoy.org/wtfpl/COPYING + +=head1 MAILING-LIST + +The public mailing-list may be the best way to get support. + +To write on the mailing-list, the address is: + + +To subscribe, send any message (even empty) to: + +then just reply to the confirmation message. + +To unsubscribe, send a message to: + + +To contact the person in charge for the list: + + +The list archives may be available at: +http://www.linux-france.org/prj/imapsync_list/ +So consider that the list is public, anyone +can see your post. Use a pseudonym or do not +post to this list if you want to stay private. + +Thank you for your participation. + +=head1 AUTHOR + +Gilles LAMIRAL + +Feedback good or bad is always welcome. + +The newsgroup comp.mail.imap may be a good place to talk about +imapsync. I read it when imapsync is concerned. +A better place is the public imapsync mailing-list +(see below). + +Gilles LAMIRAL earns his living writing, installing, +configuring and teaching free, open and often gratis +softwares. Do not hesitate to pay him for that services. + +=head1 BUG REPORT GUIDELINES + +Help us to help you: follow the following guidelines. + +Report any bugs or feature requests to the public mailing-list +or to the author. + +Before reporting bugs, read the FAQ, the README and the +TODO files. http://www.linux-france.org/prj/imapsync/ + +Upgrade to last imapsync release, maybe the bug +is already fixed. + +Upgrade to last Mail-IMAPClient Perl module. +http://search.cpan.org/dist/Mail-IMAPClient/ +maybe the bug is already fixed. + +Make a good title with word "imapsync" in it (my spam filter won't filter it), +Don't write an email title with just "imapsync" or "problem", +a good title is made of keywords summary, not too long (one visible line). + +Don't write imapsync in uppercase in the email title, we'll +know you run Windows and you haven't read this README yet. + +Help us to help you: in your report, please include: + + - imapsync version. + + - output given with --debug --debugimap near the failure point. + Isolate a message or two in a folder 'BUG' and use + + imapsync ... --folder 'BUG' --debug --debugimap + + - imap server software on both side and their version number. + + - imapsync with all the options you use, the full command line + you use (except the passwords of course). + + - IMAPClient.pm version. + + - operating system running imapsync. + + - operating systems on both sides and the third side in case + you run imapsync on a foreign host from the both. + + - virtual software context (vmware, xen etc.) + +Most of those values can be found as a copy/paste at the begining of the output. + +One time in your life, read the paper +"How To Ask Questions The Smart Way" +http://www.catb.org/~esr/faqs/smart-questions.html +and then forget it. + +=head1 IMAP SERVERS + +Failure stories reported with the following 3 imap servers: + + - MailEnable 1.54 (Proprietary) http://www.mailenable.com/ + - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works. + Patient and confident testers are welcome. + - Imail 7.04 (maybe). + +Success stories reported with the following 40 imap servers +(software names are in alphabetic order): + + - 1und1 H mimap1 84498 [host1] + - a1.net imap.a1.net IMAP4 Ready WARSBL614 00029c23 [host1] + - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] + (OSL 3.0) http://www.archiveopteryx.org/ + - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) + - CommuniGatePro server (Redhat 8.0) (Solaris), CommuniGate Pro 5.2.17[host2] (CentOS 5.4) + - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL) + (http://www.courier-mta.org/) + - Critical Path (7.0.020) + - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18 + 2.2.1, 2.2.2-BETA, 2.2.10, 2.2.12, + v2.2.3-Invoca-RPM-2.2.3-8, + 2.3-alpha (OSI Approved), + v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1, + 2.2.13, + v2.3.1-Invoca-RPM-2.3.1-2.7.fc5, + v2.3.7, + (http://asg.web.cmu.edu/cyrus/) + - David Tobit V8 (proprietary Message system). + - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). + 2.0.7 seems buggy. + - Deerfield VisNetic MailServer 5.8.6 [host1] + - dkimap4 [host1] + - Domino (Notes) 4.61[host1], 6.5[host1], 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, + 7.0.1[host1], 8.0.1[host1], 8.5.2[host2] + - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, + 1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/) + - Eudora WorldMail v2 + - GMX IMAP4 StreamProxy. + - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. + - hMailServer 5.3.3 [host2] + - iPlanet Messaging server 4.15, 5.1, 5.2 + - IMail 7.15 (Ipswitch/Win2003), 8.12 + - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform) + - 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], Exchange 2007 SP1 (with Update Rollup 2), + Exchange2007-EP-SP2, + Exchange 2010 RTM (Release to Manufacturing) [host2] + - Netscape Mail Server 3.6 (Wintel !) + - Netscape Messaging Server 4.15 Patch 7 + - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) + - OpenWave + - Oracle Beehive [host1] + - Qualcomm Worldmail (NT) + - Rockliffe Mailsite 5.3.11, 4.5.6 + - Samsung Contact IMAP server 8.5.0 + - Scalix v10.1, 10.0.1.3, 11.0.0.431 + - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [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 + - 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/) + - UW - QMail v2.1 + - Imap part of TCP/IP suite of VMS 7.3.2 + - Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, 5.5, 6.x + +Please report to the author any success or bad story with +imapsync and do not forget to mention the IMAP server +software names and version on both sides. This will help +future users. To help the author maintaining this section +report the two lines at the begining of the output if they +are useful to know the softwares. Example: + + Host1 software:* OK louloutte Cyrus IMAP4 v1.5.19 server ready + Host2 software:* OK Courier-IMAP ready + +You can use option --justconnect to get those lines. +Example: + + imapsync --host1 imap.troc.org --host2 imap.trac.org --justconnect + + +=head1 HUGE MIGRATION + +Pay special attention to options +--subscribed +--subscribe +--delete +--delete2 +--delete2folders +--expunge +--expunge1 +--expunge2 +--uidexpunge2 +--maxage +--minage +--maxsize +--useheader +--fast + +If you have many mailboxes to migrate think about a little +shell program. Write a file called file.csv (for example) +containing users and passwords. +The separator used in this example is ';' + +The file.csv file contains: + +user0001;password0001;user0002;password0002 +user0011;password0011;user0012;password0012 +... + +And the shell program is just: + + { while IFS=';' read u1 p1 u2 p2; do + imapsync --user1 "$u1" --password1 "$p1" --user2 "$u2" --password2 "$p2" ... + done ; } < file.csv + +Welcome in shell programming ! + +=head1 Hacking + +Feel free to hack imapsync as the WTFPL Licence permits it. + +=head1 Links + +Entries for imapsync: + http://www.imap.org/products/showall.php + + +=head1 SIMILAR SOFTWARES + + imap_tools : http://www.athensfbc.com/imap_tools + offlineimap : http://software.complete.org/offlineimap + mailsync : http://mailsync.sourceforge.net/ + imapxfer : http://www.washington.edu/imap/ + part of the imap-utils from UW. + mailutil : replace imapxfer in + part of the imap-utils from UW. + http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil + imaprepl : http://www.bl0rg.net/software/ + http://freshmeat.net/projects/imap-repl/ + imap_migrate : http://freshmeat.net/projects/imapmigration/ + imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html + migrationtool : http://sourceforge.net/projects/migrationtool/ + imapmigrate : http://sourceforge.net/projects/cyrus-utils/ + wonko_imapsync: http://wonko.com/article/554 + see also tools/wonko_ruby_imapsync + pop2imap : http://www.linux-france.org/prj/pop2imap/ + + +Feedback (good or bad) will often be welcome. + +$Id: imapsync,v 1.383 2010/11/28 04:28:52 gilles Exp $ + +=cut + + +# pragmas + +use warnings; +++$|; +use strict; +use Carp; +use Getopt::Long; +use Mail::IMAPClient; +use Digest::MD5 qw(md5_base64); +#use Term::ReadKey; +#use IO::Socket::SSL; +use MIME::Base64; +use English; +use File::Basename; +use POSIX qw(uname SIGALRM); +use Fcntl; +use File::Spec; +use File::Path qw(mkpath rmtree); +use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE); +use Errno qw(EAGAIN EPIPE ECONNRESET); + +use Test::More 'no_plan'; + +eval { require 'usr/include/sysexits.ph' }; + +use constant { + Unconnected => 0, + Connected => 1, # connected; not logged in + Authenticated => 2, # logged in; no mailbox selected + Selected => 3, # mailbox selected +}; + + +# global variables + +my( + $rcs, $pidfile, + $debug, $debugimap, $debugimap1, $debugimap2, $nb_errors, + $host1, $host2, $port1, $port2, + $user1, $user2, $domain1, $domain2, + $password1, $password2, $passfile1, $passfile2, + @folder, @include, @exclude, @folderrec, + $prefix1, $prefix2, + @regextrans2, @regexmess, @regexflag, + $sep1, $sep2, + $syncinternaldates, + $idatefromheader, + $usedatemanip, + $syncacls, + $fastio1, $fastio2, + $maxsize, $minsize, $maxage, $minage, + $skipheader, @useheader, + $skipsize, $allowsizemismatch, $foldersizes, $buffersize, + $delete, $delete2, + $expunge, $expunge1, $expunge2, $uidexpunge2, $dry, + $justfoldersizes, + $authmd5, + $subscribed, $subscribe, $subscribe_all, + $version, $help, + $justconnect, $justfolders, $justbanner, + $fast, + $total_bytes_transferred, + $total_bytes_skipped, + $total_bytes_error, + $nb_msg_transferred, + $nb_msg_skipped, + $nb_msg_skipped_dry_mode, + $h1_nb_msg_duplicate, + $h2_nb_msg_duplicate, + $h1_nb_msg_noheader, + $h2_nb_msg_noheader, + $h1_total_bytes_duplicate, + $h2_total_bytes_duplicate, + $h1_nb_msg_deleted, + $h2_nb_msg_deleted, + $timeout, + $timestart, $timeend, $timediff, + $timesize, $timebefore, + $ssl1, $ssl2, + $tls1, $tls2, + $uid1, $uid2, + $authuser1, $authuser2, + $proxyauth1, $proxyauth2, + $authmech1, $authmech2, + $split1, $split2, + $reconnectretry1, $reconnectretry2, + $tests, $test_builder, $tests_debug, + $allow3xx, $justlogin, + $tmpdir, + $releasecheck, + $max_msg_size_in_bytes, + $modules_version, + $delete2folders, +); + +# main program + +# global variables initialisation + +$rcs = '$Id: imapsync,v 1.383 2010/11/28 04:28:52 gilles Exp $ '; + +$total_bytes_transferred = 0; +$total_bytes_skipped = 0; +$total_bytes_error = 0; +$nb_msg_transferred = 0; +$nb_msg_skipped = $nb_msg_skipped_dry_mode = 0; +$h1_nb_msg_deleted = $h2_nb_msg_deleted = 0; +$h1_nb_msg_duplicate = $h2_nb_msg_duplicate = 0; +$h1_nb_msg_noheader = $h2_nb_msg_noheader = 0; +$h1_total_bytes_duplicate = $h2_total_bytes_duplicate = 0; + +$nb_errors = 0; +$max_msg_size_in_bytes = 0; + +unless(defined(&_SYSEXITS_H)) { + # 64 on my linux box. + eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE); +} + +# @ARGV will be eat by get_options() +my @argv_copy = @ARGV; + +get_options(); + +$modules_version = defined($modules_version) ? $modules_version : 1; + +$releasecheck = defined($releasecheck) ? $releasecheck : 1; +my $warn_release = ($releasecheck) ? check_last_release() : ''; + +# default values + +$tmpdir ||= File::Spec->tmpdir(); +$pidfile ||= $tmpdir . '/imapsync.pid'; + +# allow Mail::IMAPClient 3.0.xx by default +$allow3xx = defined($allow3xx) ? $allow3xx : 1; + +print banner_imapsync(@argv_copy); + +print "Temp directory is $tmpdir\n"; + +is_valid_directory($tmpdir); +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.0.25 or superior \n"; + +exit_clean(0) if ($justbanner); + +# By default, 1000 at a time, not more. +$split1 ||= 1000; +$split2 ||= 1000; + +$host1 || missing_option("--host1") ; +$port1 ||= (defined $ssl1 and !defined $tls1) ? 993 : 143; + +$host2 || missing_option("--host2") ; +$port2 ||= (defined $ssl2 && !defined $tls2) ? 993 : 143; + +$debugimap1 = $debugimap2 = 1 if ($debugimap); + +# By default, don't take size to compare +$skipsize = (defined $skipsize) ? $skipsize : 1; + +$uid1 = defined($uid1) ? $uid1 : 1; +$uid2 = defined($uid2) ? $uid2 : 1; + +# Allow size mismatch by default +$allowsizemismatch = defined($allowsizemismatch) ? $allowsizemismatch : 1; + +if ($justconnect) { + justconnect(); + exit_clean(0); +} + +$user1 || missing_option("--user1"); +$user2 || missing_option("--user2"); + +$syncinternaldates = defined($syncinternaldates) ? $syncinternaldates : 1; + +if($idatefromheader) { + print "Turned ON idatefromheader, ", + "will set the internal dates on host2 from the 'Date:' header line.\n"; + $syncinternaldates = 0; + +} +if ($syncinternaldates) { + print "Turned ON syncinternaldates, ", + "will set the internal dates (arrival dates) on host2 same as host1.\n"; +}else{ + print "Turned OFF syncinternaldates\n"; +} + + +if(defined($authmd5) and ($authmd5)) { + $authmech1 ||= 'CRAM-MD5'; + $authmech2 ||= 'CRAM-MD5'; +} +else{ + $authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN'; + $authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN'; +} + +$authmech1 = uc($authmech1); +$authmech2 = uc($authmech2); + +if (defined $proxyauth1 && !$authuser1) { + missing_option("With --proxyauth1, --authuser1"); +} + +if (defined $proxyauth2 && !$authuser2) { + missing_option("With --proxyauth2, --authuser2"); +} + +$authuser1 ||= $user1; +$authuser2 ||= $user2; + +print "Will try to use $authmech1 authentication on host1\n"; +print "Will try to use $authmech2 authentication on host2\n"; + +$syncacls = (defined($syncacls)) ? $syncacls : 0; +$foldersizes = (defined($foldersizes)) ? $foldersizes : 1; + +$fastio1 = (defined($fastio1)) ? $fastio1 : 0; +$fastio2 = (defined($fastio2)) ? $fastio2 : 0; + +$reconnectretry1 = (defined($reconnectretry1)) ? $reconnectretry1 : 3; +$reconnectretry2 = (defined($reconnectretry2)) ? $reconnectretry2 : 3; + +@useheader = ("Message-Id") unless (@useheader); + +print "Host1: imap server [$host1] port [$port1] user [$user1]\n"; +print "Host2: imap server [$host2] port [$port2] user [$user2]\n"; + +$password1 || $passfile1 || do { + $password1 = ask_for_password($authuser1 || $user1, $host1); +}; + +$password1 = (defined($passfile1)) ? firstline ($passfile1) : $password1; + +$password2 || $passfile2 || do { + $password2 = ask_for_password($authuser2 || $user2, $host2); +}; + +$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2; + +my $imap1 = (); +my $imap2 = (); + +$timestart = time(); +$timebefore = $timestart; + +$debugimap1 and print "Host1 connection\n"; +$imap1 = login_imap($host1, $port1, $user1, $domain1, $password1, + $debugimap1, $timeout, $fastio1, $ssl1, $tls1, + $authmech1, $authuser1, $reconnectretry1, + $proxyauth1, $uid1); + +$debugimap2 and print "Host2 connection\n"; +$imap2 = login_imap($host2, $port2, $user2, $domain2, $password2, + $debugimap2, $timeout, $fastio2, $ssl2, $tls2, + $authmech2, $authuser2, $reconnectretry2, + $proxyauth2, $uid2); + +# history + +$debug and print "Host1 Buffer I/O: ", $imap1->Buffer(), "\n"; +$debug and print "Host2 Buffer I/O: ", $imap2->Buffer(), "\n"; + + + +die_clean() unless $imap1->IsAuthenticated(); +print "Host1: state Authenticated\n"; +die_clean() unless $imap2->IsAuthenticated(); +print "Host2: state Authenticated\n"; + +print "Host1 capability: ", join(" ", $imap1->capability_update()), "\n"; +print "Host2 capability: ", join(" ", $imap2->capability_update()), "\n"; + + +exit_clean(0) if ($justlogin); + +$split1 and $imap1->Split($split1); +$split2 and $imap2->Split($split2); + +# +# Folder stuff +# + +my ( +@h1_folders_all, %h1_folders_all, @h1_folders_wanted, %requested_folder, %subscribed_folder, +@h2_folders_all, %h2_folders_all, @h2_folders_from_1, %h2_folders_from_1, +); + + +# Make a hash of subscribed folders in source server. +map { $subscribed_folder{$_} = 1 } $imap1->subscribed(); + +# All folders on host1 and host2 +@h1_folders_all = sort $imap1->folders(); +@h2_folders_all = sort $imap2->folders(); + +map { $h1_folders_all{$_} = 1} @h1_folders_all; +map { $h2_folders_all{$_} = 1} @h2_folders_all; + +if (scalar(@folder) or $subscribed or scalar(@folderrec)) { + # folders given by option --folder + if (scalar(@folder)) { + add_to_requested_folders(@folder); + } + + # option --subscribed + if ($subscribed) { + add_to_requested_folders(keys (%subscribed_folder)); + } + + # option --folderrec + if (scalar(@folderrec)) { + foreach my $folderrec (@folderrec) { + add_to_requested_folders($imap1->folders($folderrec)); + } + } +} +else { + # no include, no folder/subscribed/folderrec options => all folders + if (not scalar(@include)) { + add_to_requested_folders(@h1_folders_all); + } +} + + +# consider (optional) includes and excludes +if (scalar(@include)) { + foreach my $include (@include) { + my @included_folders = grep /$include/, @h1_folders_all; + add_to_requested_folders(@included_folders); + print "Including folders matching pattern '$include': @included_folders\n"; + } +} + +if (scalar(@exclude)) { + foreach my $exclude (@exclude) { + my @requested_folder = sort(keys(%requested_folder)); + my @excluded_folders = grep /$exclude/, @requested_folder; + remove_from_requested_folders(@excluded_folders); + print "Excluding folders matching pattern '$exclude': @excluded_folders\n"; + } +} + +# Remove no selectable folders + +foreach my $folder (keys(%requested_folder)) { + if ( not $imap1->selectable($folder)) { + print "Warning: ignoring folder $folder because it is not selectable\n"; + remove_from_requested_folders($folder); + } +} + + +my @requested_folder = sort(keys(%requested_folder)); + +@h1_folders_wanted = @requested_folder; + +my($h1_sep,$h2_sep); +# what are the private folders separators for each server ? + +$debug and print "Getting separators\n"; +$h1_sep = get_separator($imap1, $sep1, "--sep1"); +$h2_sep = get_separator($imap2, $sep2, "--sep2"); + +#my $h1_namespace = $imap1->namespace(); +#my $h2_namespace = $imap2->namespace(); +#$debug and print "Host1 namespace:\n", Data::Dumper->Dump([$h1_namespace]); +#$debug and print "Host2 namespace:\n", Data::Dumper->Dump([$h2_namespace]); + +my($h1_prefix,$h2_prefix); +$h1_prefix = get_prefix($imap1, $prefix1, "--prefix1"); +$h2_prefix = get_prefix($imap2, $prefix2, "--prefix2"); + + +print "Host1 separator and prefix: [$h1_sep][$h1_prefix]\n"; +print "Host2 separator and prefix: [$h2_sep][$h2_prefix]\n"; + + +foreach my $h1_fold (@h1_folders_wanted) { + my $h2_fold; + $h2_fold = imap2_folder_name($h1_fold); + $h2_folders_from_1{$h2_fold}++; +} + +@h2_folders_from_1 = sort keys(%h2_folders_from_1); + +if ($foldersizes) { + foldersizes("Host1", $imap1, @h1_folders_wanted); + foldersizes("Host2", $imap2, @h2_folders_from_1); +} + + +exit_clean(0) if ($justfoldersizes); + +print + "++++ Listing folders\n", + "Host1 folders list:\n", map("[$_]\n",@h1_folders_all),"\n", + "Host2 folders list:\n", map("[$_]\n",@h2_folders_all),"\n"; + +print + "Host1 subscribed folders list: ", + map("[$_] ", sort keys(%subscribed_folder)), "\n" + if ($subscribed); + +my @h2_folders_not_in_1; +@h2_folders_not_in_1 = list_folders_in_2_not_in_1(); + +print "Folders in host2 not in host1:\n", + map("[$_]\n", @h2_folders_not_in_1),"\n"; + +delete_folders_in_2_not_in_1() if $delete2folders; + +# folder loop +print "++++ Looping on each folder\n"; + +FOLDER: foreach my $h1_fold (@h1_folders_wanted) { + + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my $h2_fold = imap2_folder_name($h1_fold); + + printf("%-35s -> %-35s\n", "[$h1_fold]", "[$h2_fold]"); + unless ($imap1->select($h1_fold)) { + warn + "Host1 folder $h1_fold: Could not select: ", + $imap1->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + + if ( ! exists($h2_folders_all{$h2_fold})) { + print "Host2 folder $h2_fold does not exist\n"; + print "Creating folder [$h2_fold]\n"; + unless ($dry){ + unless ($imap2->create($h2_fold)){ + warn "Couldn't create [$h2_fold]: ", + $imap2->LastError,"\n"; + $nb_errors++; + next FOLDER; + } + } + else{ + next FOLDER; + } + } + + acls_sync($h1_fold, $h2_fold); + + unless ($imap2->select($h2_fold)) { + warn + "Host2 folder $h2_fold: Could not select: ", + $imap2->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + my @select_results = $imap2->Results(); + + #print "%%% @select_results\n"; + my $permanentflags2 = permanentflags(@select_results); + + if ($expunge){ + print "Expunging host1 $h1_fold\n"; + unless($dry) { $imap1->expunge() }; + #print "Expunging host2 $h2_fold\n"; + #unless($dry) { $imap2->expunge() }; + } + + if (($subscribe and exists $subscribed_folder{$h1_fold}) or $subscribe_all) { + print "Subscribing to folder $h2_fold on destination server\n"; + unless($dry) { $imap2->subscribe($h2_fold) }; + } + + next FOLDER if ($justfolders); + + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my @h1_msgs = select_msgs($imap1); + + $debug and print "LIST Host1: ", scalar(@h1_msgs), " messages [@h1_msgs]\n"; + # internal dates on host2 are after the ones on host1 + # normally... + my @h2_msgs = select_msgs($imap2); + + $debug and print "LIST Host2: ", scalar(@h2_msgs), " messages [@h2_msgs]\n"; + + my %h1_hash = (); + my %h2_hash = (); + + $debug and print "Host1 folder [$h1_fold] parsing headers\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + + my ($h1_heads_ref, $h1_fir_ref) = ({}, {}); + $h1_heads_ref = $imap1->parse_headers([@h1_msgs], @useheader) if (@h1_msgs); + $debug and print "Time headers: ", timenext(), " s\n"; + last FOLDER if $imap1->IsUnconnected(); + + @$h1_fir_ref{@h1_msgs} = (undef); + $h1_fir_ref = $imap1->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref) + if (@h1_msgs); + $debug and print "Time fir: ", timenext(), " s\n"; + unless ($h1_fir_ref) { + warn + "Host1 folder $h1_fold: Could not fetch_hash_2 ", + scalar(@h1_msgs), " msgs: ", $imap1->LastError, "\n"; + $nb_errors++; + next FOLDER; + } + last FOLDER if $imap1->IsUnconnected(); + + + my @h1_msgs_duplicate; + foreach my $m (@h1_msgs) { + my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, "F", \%h1_hash); + if (! defined($rc)) { + my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + print "+ Skipping msg #$m:$h1_size on host1 folder $h1_fold (no header so we ignore this message)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + $h1_nb_msg_noheader +=1; + } elsif(0 == $rc) { + # duplicate + push(@h1_msgs_duplicate, $m); + # duplicate, same id same size? + my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + $nb_msg_skipped += 1; + $h1_total_bytes_duplicate += $h1_size; + $h1_nb_msg_duplicate += 1; + } + } + $debug and print "Time parsing headers on host1: ", timenext(), " s\n"; + + $debug and print "Host2 folder [$h2_fold] parsing headers\n"; + + my ($h2_heads_ref, $h2_fir_ref) = ({}, {}); + $h2_heads_ref = $imap2->parse_headers([@h2_msgs], @useheader) if (@h2_msgs); + $debug and print "Time headers: ", timenext(), " s\n"; + last FOLDER if $imap2->IsUnconnected(); + + @$h2_fir_ref{@h2_msgs} = (undef); # fetch_hash_2 can select by uid with last arg as ref + $h2_fir_ref = $imap2->fetch_hash_2("FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref) + if (@h2_msgs); + $debug and print "Time fir: ", timenext(), " s\n"; + last FOLDER if $imap2->IsUnconnected(); + + my @h2_msgs_duplicate; + foreach my $m (@h2_msgs) { + my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, "T", \%h2_hash); + if (! defined($rc)) { + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + print "+ Skipping msg #$m:$h2_size in host2 folder $h2_fold (no header so we ignore this message)\n"; + $h2_nb_msg_noheader += 1 ; + } elsif(0 == $rc) { + # duplicate + my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0; + $h2_nb_msg_duplicate += 1; + $h2_total_bytes_duplicate += $h2_size; + push(@h2_msgs_duplicate, $m); + } + } + $debug and print "Time parsing headers on host2: ", timenext(), " s\n"; + + $debug and print "++++ Verifying [$h1_fold] -> [$h2_fold]\n"; + # messages in host1 that are not in host2 + + my @h1_hash_keys_sorted_by_uid + = sort {$h1_hash{$a}{'m'} <=> $h1_hash{$b}{'m'}} keys(%h1_hash); + + #print map { $h1_hash{$_}{'m'} . " "} @h1_hash_keys_sorted_by_uid; + + my @h2_hash_keys_sorted_by_uid + = sort {$h2_hash{$a}{'m'} <=> $h2_hash{$b}{'m'}} keys(%h2_hash); + + + if($delete2) { + my @h2_expunge; + foreach my $m_id (@h2_hash_keys_sorted_by_uid) { + #print "$m_id "; + unless (exists($h1_hash{$m_id})) { + my $h2_msg = $h2_hash{$m_id}{'m'}; + my $h2_flags = $h2_hash{$m_id}{'F'} || ""; + my $isdel = $h2_flags =~ /\B\\Deleted\b/ ? 1 : 0; + print "msg $h2_fold/$h2_msg deleted on host2 [$m_id]\n" + if ! $isdel; + push(@h2_expunge, $h2_msg) if $uidexpunge2; + unless ($dry or $isdel) { + $imap2->delete_message($h2_msg); + $h2_nb_msg_deleted += 1; + } + } + } + foreach my $h2_msg (@h2_msgs_duplicate) { + print "msg $h2_fold/$h2_msg deleted [duplicate] on host2\n"; + push(@h2_expunge, $h2_msg) if $uidexpunge2; + unless ($dry) { + $imap2->delete_message($h2_msg); + $h2_nb_msg_deleted += 1; + } + } + + my $cnt = scalar @h2_expunge; + if(@h2_expunge and !$imap2->can("uidexpunge")) { + warn "uidexpunge not supported (< IMAPClient 3.17)\n"; + } + elsif(@h2_expunge) { + print "uidexpunge $cnt message(s)\n"; + $imap2->uidexpunge(\@h2_expunge) if !$dry; + } + } + + MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) { + my $h1_size = $h1_hash{$m_id}{'s'}; + my $h1_msg = $h1_hash{$m_id}{'m'}; + my $h1_idate = $h1_hash{$m_id}{'D'}; + + if (defined $maxsize and $h1_size >= $maxsize) { + print "msg $h1_fold/$h1_msg skipping ($h1_size exceeds maxsize limit $maxsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + next MESS; + } + if (defined $minsize and $h1_size <= $minsize) { + print "msg $h1_fold/$h1_msg skipping ($h1_size smaller than minsize $minsize bytes)\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + next MESS; + } + + unless (exists($h2_hash{$m_id})) { + # copy + $debug and print "msg $h1_fold/$h1_msg copying to $h2_fold\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + my $string; + #print "Message_string Beg\n", memory_consumption(); + $string = $imap1->message_string($h1_msg); + #print "Message_string End\n", memory_consumption(); + unless (defined($string)) { + warn + "- msg $h1_fold/$h1_msg could not fetch [$m_id $h1_size]: ", + $imap1->LastError, "\n"; + $nb_errors++; + $total_bytes_error += $h1_size; + next MESS; + } + + #my $message_file = "tmp_imapsync_$$"; + #$imap1->select($h1_fold); + #unlink($message_file); + #$imap1->message_to_file($message_file, $h1_msg) or do { + # warn "Could not put message #$h1_msg to file $message_file", + # $imap1->LastError; + # $nb_errors++; + # $total_bytes_error += $h1_size; + # next MESS; + #}; + #$string = file_to_string($message_file); + #print "AAA1[$string]ZZZ\n"; + #unlink($message_file); + if (@regexmess) { + $string = regexmess($string); + + #string_to_file($string, $message_file); + } + + + $debug and print + "=" x80, "\n", + "F message content begin next line\n", + $string, + "F message content ended on previous line\n", "=" x 80, "\n"; + my $h1_date = ""; + if ($syncinternaldates) { + $h1_date = $h1_idate; + $debug and print "internal date from host1: [$h1_date]\n"; + $h1_date = good_date($h1_date); + $debug and print "internal date from host1: [$h1_date] (fixed)\n"; + } + + if ($idatefromheader) { + + $h1_date = $imap1->get_header($h1_msg,"Date"); + $debug and print "header date from host1: [$h1_date]\n"; + $h1_date = good_date($h1_date); + $debug and print "header date from host1: [$h1_date] (fixed)\n"; + } + + my $h1_flags = $h1_hash{$m_id}{'F'} || ""; + # RFC 2060: This flag can not be altered by any client + $h1_flags =~ s@\\Recent\s?@@gi; + $h1_flags = flags_regex($h1_flags) if @regexflag; + + $h1_flags = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); + + my $new_id; + $debug and print "msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n"; + last FOLDER if $imap1->IsUnconnected(); + last FOLDER if $imap2->IsUnconnected(); + $h1_date = undef if ($h1_date eq ""); + + unless ($dry) { + $max_msg_size_in_bytes = max($h1_size, $max_msg_size_in_bytes); + $new_id = $imap2->append_string($h2_fold, $string, $h1_flags, $h1_date); + unless($new_id){ + no warnings 'uninitialized'; + warn "- msg $h1_fold/$h1_msg couldn't append (Subject:[". + $imap1->subject($h1_msg)."]) to folder $h2_fold: ", + $imap2->LastError, "\n"; + $nb_errors++; + $total_bytes_error += $h1_size; + next MESS; + } + else{ + # good + # $new_id is an id if the IMAP server has the + # UIDPLUS capability else just a ref + print "msg $h1_fold/$h1_msg copied to $h2_fold/$new_id\n"; + $total_bytes_transferred += $h1_size; + $nb_msg_transferred += 1; + if($delete) { + print "msg $h1_fold/$h1_msg deleted on host1\n"; + unless($dry) { + $imap1->delete_message($h1_msg); + $h1_nb_msg_deleted += 1; + last FOLDER if $imap1->IsUnconnected(); + $imap1->expunge() if ($expunge); + last FOLDER if $imap1->IsUnconnected(); + } + } + } + } + else{ + $nb_msg_skipped_dry_mode += 1; + } + #unlink($message_file); + next MESS; + } + else{ + #my $h2_size = $h2_hash{$m_id}{'s'}; + my $h2_msg = $h2_hash{$m_id}{'m'}; + #my $h2_idate = $h2_hash{$m_id}{'D'}; + $debug and print "msg $h1_fold/$h1_msg equals $h2_fold/$h2_msg\n"; + $total_bytes_skipped += $h1_size; + $nb_msg_skipped += 1; + } + + $fast and next MESS; + #$debug and print "MESSAGE $m_id\n"; + my $h2_size = $h2_hash{$m_id}{'s'}; + my $h2_msg = $h2_hash{$m_id}{'m'}; + + # used cached flag values for efficiency + my $h1_flags = $h1_hash{$m_id}{'F'} || ""; + my $h2_flags = $h2_hash{$m_id}{'F'} || ""; + + # RFC 2060: This flag can not be altered by any client + $h1_flags =~ s@\\Recent\s?@@gi; + $h1_flags = flags_regex($h1_flags) if @regexflag; + $h1_flags = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); + + + # compare flags - set flags if there a difference + my @h1_flags = sort split(' ', $h1_flags ); + my @h2_flags = sort split(' ', $h2_flags ); + my $diff = compare_lists(\@h1_flags, \@h2_flags); + + $diff and $debug and print "msg $h2_fold/$h2_msg replacing h2 flags($h2_flags) with h1 flags($h1_flags)\n"; + + # This sets flags so flags can be removed with this + # When you remove a \Seen flag on host1 you want to it + # to be removed on host2. Just add flags is not what + # we need most of the time. + + if (!$dry and $diff and !$imap2->store($h2_msg, "FLAGS.SILENT (@h1_flags)") ) { + warn "- msg $h2_fold/$h2_msg could not add flags @h1_flags", + $imap2->LastError, "\n"; + #$nb_errors++; + } + last FOLDER if $imap2->IsUnconnected(); + + $debug and do { + my @h2_flags = @{ $imap2->flags($h2_msg) || [] }; + last FOLDER if $imap2->IsUnconnected(); + + print "host1 flags: $h1_flags\n", + "host2 flags: @h2_flags\n"; + + print "Looking dates\n"; + #my $h1_idate = $imap1->internaldate($h1_msg); + #my $h2_idate = $imap2->internaldate($h2_msg); + my $h1_idate = $h1_hash{$m_id}{'D'}; + my $h2_idate = $h2_hash{$m_id}{'D'}; + print + "host1 internal date: $h1_idate\n", + "host2 internal date: $h2_idate\n"; + + #unless ($h1_idate eq $h2_idate) { + # print "!!! Dates differs !!!\n"; + #} + }; + unless ($skipsize or ($h1_size == $h2_size)) { + # Bad size + print + "- msg $h1_fold/$h1_msg size diff $h1_size != $h2_size $h2_fold/$h2_msg\n"; + $nb_errors++; + } + else { + # Good + $debug and print + "msg $h1_fold/$h1_msg sizes ok $h1_size <=> $h2_size $h2_fold/$h2_msg\n"; + if($delete) { + print "msg $h1_fold/$h1_msg deleted on host1\n"; + unless($dry) { + $imap1->delete_message($h1_msg); + $h1_nb_msg_deleted += 1; + $imap1->expunge() if ($expunge); + } + } + } + } + if ($expunge1){ + print "Expunging host1 folder $h1_fold\n"; + unless($dry) { $imap1->expunge() }; + } + if ($expunge2){ + print "Expunging host2 folder $h2_fold\n"; + unless($dry) { $imap2->expunge() }; + } + +$debug and print "Time: ", timenext(), " s\n"; +} + +print "++++ End looping on each folder\n"; +#print memory_consumption(); + +my $memory_consumption = memory_consumption(); +my $memory_ratio = ($max_msg_size_in_bytes) ? + sprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : "NA"; + + +$imap1->logout(); +$imap2->logout(); + +my $host1_reconnect_count = $imap1->Reconnect_counter() || 0; +my $host2_reconnect_count = $imap2->Reconnect_counter() || 0; + + +$timeend = time(); +$timediff = $timeend - $timestart; + +stats(); +exit_clean(1) if($nb_errors); +exit_clean(0); + +# END of main program + +# subroutines + +sub max { + return(undef) if (0 == scalar(@_)); + my @sorted = sort { $a <=> $b } @_; + return(pop(@sorted)); +} + +sub tests_max { + ok(0 == max(0), "max 0"); + ok(1 == max(1), "max 1"); + ok(-1 == max(-1), "max -1"); + ok(! defined(max()), "max no arg"); + ok(100 == max(1, 100), "max 1 100"); + ok(100 == max(100, 1), "max 100 1"); + ok(100 == max(100, 42, 1), "max 100 42 1"); + ok(100 == max(100, "42", 1), "max 100 42 1"); + ok(100 == max("100", "42", 1), "max 100 42 1"); + #ok(100 == max(100, "haha", 1), "max 100 42 1"); +} + +sub check_lib_version { + $debug and print "IMAPClient $Mail::IMAPClient::VERSION\n"; + if ($Mail::IMAPClient::VERSION eq '2.2.9') { + override_imapclient(); + return(1); + } + else{ + # 3.x.x is no longer buggy with imapsync. + if ($allow3xx) { + return(1); + }else{ + return(0); + } + } +} + +sub modules_VERSION { + + my @list_version; + + foreach my $module (qw( +Mail::IMAPClient +IO::Socket +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); +} + +# Construct a command line copy with passwords replaced by MASKED. +sub command_line_nopassword { + my @argv_copy = @_; + my @argv_nopassword; + while (@argv_copy) { + my $arg = shift(@argv_copy); # option name or value + if ($arg =~ m/-password[12]/) { + shift(@argv_copy); # password value + push(@argv_nopassword, $arg, "MASKED"); # option name and fake value + }else{ + push(@argv_nopassword, $arg); # same option or value + } + } + return("@argv_nopassword"); +} + +sub tests_command_line_nopassword { + + ok('' eq command_line_nopassword(), 'command_line_nopassword void'); + ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla'); + #print command_line_nopassword((qw{ --password1 secret1 })), "\n"; + ok('--password1 MASKED' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1'); + ok('--blabla --password1 MASKED --blibli' + eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli'); + + +} + +sub ask_for_password { + my ($user, $host) = @_; + print "What's the password for $user\@$host? "; + Term::ReadKey::ReadMode(2); + my $password = <>; + chomp $password; + printf "\n"; + Term::ReadKey::ReadMode(0); + return $password; +} + + +sub myconnect { + my $self = shift; + + $debug and print "Entering myconnect\n"; + %$self = (%$self, @_); + + my $sock = (($self->Ssl) ? IO::Socket::SSL->new : IO::Socket::INET->new); + my $dp = ($self->Ssl ? 'imaps(993)' : 'imap(143)'); + + $debug and print "Calling configure\n"; + my $ret = $sock->configure({ + PeerAddr => $self->Server , + PeerPort => $self->Port||$dp , + Proto => 'tcp' , + Timeout => $self->Timeout||0 , + Debug => $self->Debug , + }); + unless ( defined($ret) ) { + $self->LastError( "$@\n"); + $@ = "$@"; + carp "$@" + unless defined wantarray; + return undef; + } + $sock->autoflush(1); + + my $banner = $sock->getline(); + $debug and print "Read: $banner"; + + $self->Banner($banner); + $self->RawSocket2($sock); + $self->State(Connected); + + if ($self->Tls) { + starttls($self); + } + + $self->Ignoresizeerrors($allowsizemismatch); + + if ($self->User and $self->Password) { + $debug and print "Calling login\n"; + return $self->login ; + } + else { + return $self; + } +} + + + + +sub starttls { + my $self = shift; + my $socket = $self->RawSocket2(); + + $debug and print "Entering starttls\n"; + unless ($self->has_capability("STARTTLS")) { + die_clean( "No STARTTLS capability" ); + } + print $socket, "\n"; + print $socket "z00 STARTTLS\015\012"; + CORE::select( undef, undef, undef, 0.025 ); + my $txt = $socket->getline(); + $debug and print "Read tls: $txt"; + unless($txt =~ /^z00 OK/){ + die_clean( "Invalid response for STARTTLS: $txt\n" ); + } + $debug and print "Calling start_SSL\n"; + unless(IO::Socket::SSL->start_SSL($socket, + { + SSL_version => "TLSV1", + SSL_startHandshake => 1, + SSL_verify_depth => 1, + })) + { + die_clean( "Couldn't start TLS: ".IO::Socket::SSL::errstr()."\n"); + } + if (ref($socket) ne "IO::Socket::SSL") { + die_clean( "Socket has NOT been converted to SSL"); + }else{ + $debug and print "Socket successfuly converted to SSL\n"; + } + $debug and print "Ending starttls\n"; +} + + + +sub connect_imap { + my($host, $port, $debugimap, $ssl, $tls) = @_; + my $imap = Mail::IMAPClient->new(); + $imap->Ssl($ssl) if ($ssl); + $imap->Tls($tls) if ($tls); + $imap->Server($host); + $imap->Port($port); + $imap->Debug($debugimap); + #$imap->connect() + myconnect($imap) + or die_clean("Can not open imap connection on [$host]: $@\n"); +} + +sub justconnect { + my $imap1 = (); + my $imap2 = (); + + $imap1 = connect_imap($host1, $port1, $debugimap1, $ssl1, $tls1); + print "Host1 software: ", server_banner($imap1); + print "Host1 capability: ", join(" ", $imap1->capability()), "\n"; + $imap2 = connect_imap($host2, $port2, $debugimap2, $ssl2, $tls2); + print "Host2 software: ", server_banner($imap2); + print "Host2 capability: ", join(" ", $imap2->capability()), "\n"; + $imap1->logout(); + $imap2->logout(); + +} + + +sub login_imap { + my($host, $port, $user, $domain, $password, + $debugimap, $timeout, $fastio, + $ssl, $tls, $authmech, $authuser, $reconnectretry, + $proxyauth, $uid) = @_; + my ($imap); + + $imap = Mail::IMAPClient->new(); + + $imap->Ssl($ssl) if ($ssl); + $imap->Tls($tls) if ($tls); + $imap->Clear(1); + $imap->Server($host); + $imap->Port($port); + $imap->Fast_io($fastio); + $imap->Buffer($buffersize || 4096); + $imap->Uid($uid); + #$imap->Uid(0); + $imap->Peek(1); + $imap->Debug($debugimap); + $timeout and $imap->Timeout($timeout); + + $imap->Reconnectretry($reconnectretry) if ($reconnectretry); + + #$imap->connect() + myconnect($imap) + or die_clean("Can not open imap connection on [$host] with user [$user]: $@\n"); + + print "Banner: ", server_banner($imap); + + if ($imap->has_capability("AUTH=$authmech") + or $imap->has_capability($authmech) + ) { + printf("Host %s says it has CAPABILITY for AUTHENTICATE %s\n", + $imap->Server, $authmech); + } + else { + printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n", + $imap->Server, $authmech); + if ($authmech eq 'PLAIN') { + print "Frequently PLAIN is only supported with SSL, ", + "try --ssl1 or --ssl2 option\n"; + } + } + + if ($proxyauth) { + $imap->Authmechanism(""); + } else { + $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); + } + + $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; + + + if ($proxyauth) { + $imap->User($authuser); + $imap->Domain($domain) if (defined($domain)); + $imap->Authuser($authuser); + $imap->Password($password); + } else { + $imap->User($user); + $imap->Domain($domain) if (defined($domain)); + $imap->Authuser($authuser); + $imap->Password($password); + } + + unless ($imap->login()) { + my $info = "Error login: [$host] with user [$user] auth"; + my $einfo = $imap->LastError || @{$imap->History}[-1]; + chomp($einfo); + my $error = "$info [$authmech]: $einfo\n"; + print $error; # note: duplicating error on stdout/stderr + die_clean($error) if ($authmech eq 'LOGIN' or $imap->IsUnconnected() or $authuser); + print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n"; + $imap->Authmechanism(""); + $imap->login() or + die_clean("$info [LOGIN]: ", $imap->LastError, "\n"); + } + $proxyauth && $imap->proxyauth($user); + + print "Success login on [$host] with user [$user] auth [$authmech]\n"; + return($imap); +} + + +sub plainauth() { + my $code = shift; + my $imap = shift; + + my $string = sprintf("%s\x00%s\x00%s", $imap->User, + $imap->Authuser, $imap->Password); + return encode_base64("$string", ""); +} + + +sub server_banner { + my $imap = shift; + my $banner = $imap->Banner() || "No banner\n"; + return $banner; + } + + +sub banner_imapsync { + + my @argv_copy = @_; + my $banner_imapsync = join("", + '$RCSfile: imapsync,v $ ', + '$Revision: 1.383 $ ', + '$Date: 2010/11/28 04:28:52 $ ', + "\n",localhost_info(), "\n", + "Command line used:\n", + "$0 ", command_line_nopassword(@argv_copy), "\n", + ); +} + +sub is_valid_directory { + my $dir = shift; + return(1) if (-d $dir and -r _ and -w _); + # Trying to create it + mkpath($dir) or die "Error creating tmpdir $tmpdir : $!"; + die "Error with tmpdir $tmpdir : $!" if not (-d $dir and -r _ and -w _); + return(1); +} + + +sub write_pidfile { + my $pidfile = shift; + + print "PID file is $pidfile\n"; + if (-e $pidfile) { + warn "$pidfile already exists, overwriting it\n"; + } + open(PIDFILE, ">$pidfile") or do { + warn "Could not open $pidfile for writing"; + return undef; + }; + + print PIDFILE $PROCESS_ID; + close PIDFILE; + return($PROCESS_ID); +} + +sub exit_clean { + my $status = shift; + + unlink($pidfile); + exit($status); +} + +sub die_clean { + + unlink($pidfile); + die @_; +} + +sub missing_option { + my ($option) = @_; + die_clean("$option option must be used, run $0 --help for help\n"); +} + + + +sub tests_folder_routines { + ok( !is_requested_folder('folder_foo') ); + ok( add_to_requested_folders('folder_foo') ); + ok( is_requested_folder('folder_foo') ); + ok( !is_requested_folder('folder_NO_EXIST') ); + ok( !remove_from_requested_folders('folder_foo'), "removed folder_foo"); + ok( !is_requested_folder('folder_foo') ); + my @f; + ok( @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f"); + ok( is_requested_folder('folder_bar') ); + ok( is_requested_folder('folder_toto') ); + ok( remove_from_requested_folders('folder_toto') ); + ok( !is_requested_folder('folder_toto') ); +} + + +sub is_requested_folder { + my ( $folder ) = @_; + + defined( $requested_folder{ $folder } ); +} + + +sub add_to_requested_folders { + my @wanted_folders = @_; + + foreach my $folder ( @wanted_folders ) { + ++$requested_folder{ $folder }; + } + return( keys( %requested_folder ) ); +} + +sub remove_from_requested_folders { + my @wanted_folders = @_; + + foreach my $folder (@wanted_folders) { + delete $requested_folder{$folder}; + } + return( keys(%requested_folder) ); +} + +sub compare_lists { + my ($list_1_ref, $list_2_ref) = @_; + + return(-1) if ((not defined($list_1_ref)) and defined($list_2_ref)); + return(0) if ((not defined($list_1_ref)) and not defined($list_2_ref)); # end if no list + return(1) if (not defined($list_2_ref)); # end if only one list + + if (not ref($list_1_ref)) {$list_1_ref = [$list_1_ref]}; + if (not ref($list_2_ref)) {$list_2_ref = [$list_2_ref]}; + + + my $last_used_indice = -1; + #print "\$#$list_1_ref:", $#$list_1_ref, "\n"; + #print "\$#$list_2_ref:", $#$list_2_ref, "\n"; + ELEMENT: + foreach my $indice ( 0 .. $#$list_1_ref ) { + $last_used_indice = $indice; + + # End of list_2 + return 1 if ($indice > $#$list_2_ref); + + my $element_list_1 = $list_1_ref->[$indice]; + my $element_list_2 = $list_2_ref->[$indice]; + my $balance = $element_list_1 cmp $element_list_2 ; + next ELEMENT if ($balance == 0) ; + return $balance; + } + # each element equal until last indice of list_1 + return -1 if ($last_used_indice < $#$list_2_ref); + + # same size, each element equal + return 0 +} + +sub tests_compare_lists { + + + my $empty_list_ref = []; + + ok( 0 == compare_lists() , 'compare_lists, no args'); + ok( 0 == compare_lists(undef) , 'compare_lists, undef = nothing'); + ok( 0 == compare_lists(undef, undef) , 'compare_lists, undef = undef'); + ok(-1 == compare_lists(undef , []) , 'compare_lists, undef < []'); + ok(-1 == compare_lists(undef , [1]) , 'compare_lists, undef < [1]'); + ok(-1 == compare_lists(undef , [0]) , 'compare_lists, undef < [0]'); + ok(+1 == compare_lists([]) , 'compare_lists, [] > nothing'); + ok(+1 == compare_lists([], undef) , 'compare_lists, [] > undef'); + ok( 0 == compare_lists([] , []) , 'compare_lists, [] = []'); + + ok(-1 == compare_lists([] , [1]) , 'compare_lists, [] < [1]'); + ok(+1 == compare_lists([1] , []) , 'compare_lists, [1] > []'); + + + ok( 0 == compare_lists([1], 1 ) , "compare_lists, [1] = 1 ") ; + ok( 0 == compare_lists( 1 , [1]) , "compare_lists, 1 = [1]") ; + ok( 0 == compare_lists( 1 , 1 ) , "compare_lists, 1 = 1 ") ; + ok(-1 == compare_lists( 0 , 1 ) , "compare_lists, 0 < 1 ") ; + ok(-1 == compare_lists(-1 , 0 ) , "compare_lists, -1 < 0 ") ; + ok(-1 == compare_lists( 1 , 2 ) , "compare_lists, 1 < 2 ") ; + ok(+1 == compare_lists( 2 , 1 ) , "compare_lists, 2 > 1 ") ; + + + ok( 0 == compare_lists([1,2], [1,2]) , "compare_lists, [1,2] = [1,2]") ; + ok(-1 == compare_lists([1], [1,2]) , "compare_lists, [1] < [1,2]") ; + ok(+1 == compare_lists([2], [1,2]) , "compare_lists, [2] > [1,2]") ; + ok(-1 == compare_lists([1], [1,1]) , "compare_lists, [1] < [1,1]") ; + ok(+1 == compare_lists([1, 1], [1]) , "compare_lists, [1, 1] > [1]") ; + ok( 0 == compare_lists([1 .. 20_000] , [1 .. 20_000]) + , "compare_lists, [1..20_000] = [1..20_000]") ; + ok(-1 == compare_lists([1], [3]) , 'compare_lists, [1] < [3]') ; + ok( 0 == compare_lists([2], [2]) , 'compare_lists, [0] = [2]') ; + ok(+1 == compare_lists([3], [1]) , 'compare_lists, [3] > [1]') ; + + ok(-1 == compare_lists(["a"], ["b"]) , 'compare_lists, ["a"] < ["b"]') ; + ok( 0 == compare_lists(["a"], ["a"]) , 'compare_lists, ["a"] = ["a"]') ; + ok( 0 == compare_lists(["ab"], ["ab"]) , 'compare_lists, ["ab"] = ["ab"]') ; + ok(+1 == compare_lists(["b"], ["a"]) , 'compare_lists, ["b"] > ["a"]') ; + ok(-1 == compare_lists(["a"], ["aa"]) , 'compare_lists, ["a"] < ["aa"]') ; + ok(-1 == compare_lists(["a"], ["a", "a"]), 'compare_lists, ["a"] < ["a", "a"]') ; + ok( 0 == compare_lists([split(" ", "a b")], ["a", "b"]), 'compare_lists, split') ; + ok( 0 == compare_lists([sort split(" ", "b a")], ["a", "b"]), 'compare_lists, sort split') ; +} + + + +sub get_prefix { + my($imap, $prefix_in, $prefix_opt) = @_; + my($prefix_out); + + $debug and print "Getting prefix namespace\n"; + if (defined($prefix_in)) { + print "Using [$prefix_in] given by $prefix_opt\n"; + $prefix_out = $prefix_in; + return($prefix_out); + } + $debug and print "Calling namespace capability\n"; + if ($imap->has_capability("namespace")) { + my $r_namespace = $imap->namespace(); + $prefix_out = $r_namespace->[0][0][0]; + return($prefix_out); + } + else{ + print + "No NAMESPACE capability in imap server ", + $imap->Server(),"\n", + "Give the prefix namespace with the $prefix_opt option\n"; + exit_clean(1); + } +} + + +sub get_separator { + my($imap, $sep_in, $sep_opt) = @_; + my($sep_out); + + + if ($sep_in) { + print "Using [$sep_in] given by $sep_opt\n"; + $sep_out = $sep_in; + return($sep_out); + } + $debug and print "Calling namespace capability\n"; + if ($imap->has_capability("namespace")) { + $sep_out = $imap->separator(); + return($sep_out) if defined $sep_out; + warn + "NAMESPACE request failed for ", + $imap->Server(), ": ", $imap->LastError, "\n"; + exit_clean(1); + } + else{ + warn + "No NAMESPACE capability in imap server ", + $imap->Server(),"\n", + "Give the separator character with the $sep_opt option\n"; + exit_clean(1); + } +} + +sub separator_invert { + # The separator we hope we'll never encounter: 00000000 + my $o_sep="\000"; + + my($h1_fold, $h1_sep, $h2_sep) = @_; + + my $h2_fold = $h1_fold; + $h2_fold =~ s@\Q$h2_sep@$o_sep@g; + $h2_fold =~ s@\Q$h1_sep@$h2_sep@g; + $h2_fold =~ s@\Q$o_sep@$h1_sep@g; + return($h2_fold); +} + + +sub tests_imap2_folder_name { + +$h1_prefix = $h2_prefix = ''; +$h1_sep = '/'; +$h2_sep = '.'; + +$debug and print +"prefix1: [$h1_prefix] +prefix2: [$h2_prefix] +sep1:[$h1_sep] +sep2:[$h2_sep] +"; + +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam'); +ok('spam/spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam'); +ok('spam.spam/spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam'); +@regextrans2 = ('s,/,X,g'); +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string [s,/,X,g]'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,/,X,g]'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam [s,/,X,g]'); +ok('spamXspam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam [s,/,X,g]'); +ok('spam.spamXspam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam [s,/,X,g]'); + +@regextrans2 = ('s, ,_,g'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s, ,_,g]'); +ok('bla_bla' eq imap2_folder_name('bla bla'), 'imap2_folder_name: blabla [s, ,_,g]'); + +@regextrans2 = ('s,(.*),\U$1,'); +ok('BLABLA' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,\U(.*)\E,$1,]'); + + +} + +sub imap2_folder_name { + my ($h2_fold); + my ($x_fold) = @_; + # first we remove the prefix + $x_fold =~ s/^\Q$h1_prefix\E//; + $debug and print "removed host1 prefix: [$x_fold]\n"; + $h2_fold = separator_invert($x_fold,$h1_sep, $h2_sep); + $debug and print "inverted separators: [$h2_fold]\n"; + # Adding the prefix supplied by namespace or the --prefix2 option + $h2_fold = $h2_prefix . $h2_fold + unless(($h2_prefix eq "INBOX" . $h2_sep) and ($h2_fold =~ m/^INBOX$/i)); + $debug and print "added host2 prefix: [$h2_fold]\n"; + + # Transforming the folder name by the --regextrans2 option(s) + foreach my $regextrans2 (@regextrans2) { + my $h2_fold_before = $h2_fold; + eval("\$h2_fold =~ $regextrans2"); + $debug and print "[$h2_fold_before] -> [$h2_fold] using re [$regextrans2]\n"; + die_clean("error: eval regextrans2 '$regextrans2': $@\n") if $@; + } + return($h2_fold); +} + + +sub foldersizes { + + my ($side, $imap, @folders) = @_; + my $tot = 0; + my $tmess = 0; + + print "++++ Calculating sizes\n"; + foreach my $folder (@folders) { + my $stot = 0; + my $smess = 0; + printf("$side folder %-35s", "[$folder]"); + unless($imap->exists($folder)) { + print("does not exist yet\n"); + next; + } + unless ($imap->examine($folder)) { + warn + "$side Folder $folder: Could not examine: ", + $imap->LastError, "\n"; + $nb_errors++; + next; + } + + my $hash_ref = {}; + my @msgs = select_msgs($imap); + $smess = scalar(@msgs); + @$hash_ref{@msgs} = (undef); + unless ($smess == 0) { + $imap->fetch_hash_2("RFC822.SIZE",$hash_ref) or die_clean("$@"); + #print map {$hash_ref->{$_}->{"RFC822.SIZE"}, " "} keys %$hash_ref; + map {$stot += $hash_ref->{$_}->{"RFC822.SIZE"}} keys %$hash_ref; + } + + printf(" Size: %9s", $stot); + printf(" Messages: %5s\n", $smess); + $tot += $stot; + $tmess += $smess; + } + print "Total size: $tot\n"; + print "Total messages: $tmess\n"; + print "Time: ", timenext(), " s\n"; +} + +sub timenext { + my ($timenow, $timerel); + # $timebefore is global, beurk ! + $timenow = time; + $timerel = $timenow - $timebefore; + $timebefore = $timenow; + return($timerel); +} + + +sub tests_flags_regex { + + my $string; + ok('' eq flags_regex(''), "flags_regex, null string ''"); + ok('\Seen NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, nothing to do'); + ok('\Seen NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex,'); + @regexflag = ('s/NonJunk//g'); + ok('\Seen $Spam' eq flags_regex('\Seen NonJunk $Spam'), "flags_regex, remove NonJunk: 's/NonJunk//g'"); + @regexflag = ('s/\$Spam//g'); + ok('\Seen NonJunk ' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, remove $Spam: '."'s/\$Spam//g'"); + + @regexflag = ('s/\\\\Seen//g'); + + ok(' NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, remove \Seen: '. "'s/\\\\\\\\Seen//g'"); + + @regexflag = ('s/(\s|^)[^\\\\]\w+//g'); + ok('\Seen \Middle \End' eq flags_regex('\Seen NonJunk \Middle $Spam \End'), 'flags_regex, only \word [' . flags_regex('\Seen NonJunk \Middle $Spam \End'.']')); + ok(' \Seen \Middle \End1' eq flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'), 'flags_regex, only \word [' . flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'.']')); + + @regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g'); + ok('Keep1 Keep2 ReB' eq flags_regex('ReA Keep1 REM Keep2 ReB'), "Keep only regex"); + #ok('Keep1 Keep2' eq flags_regex('Keep1 Keep2 Remove1'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM REM Keep1 Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM Keep1'), "Keep only regex"); + + @regexflag = ('s/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g'); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 ReB'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 REM REM REM'), "Keep only regex"); + ok('Keep2 ' eq flags_regex('Keep2 REM REM REM'), "Keep only regex"); + #ok('' eq flags_regex('REM REM'), "Keep only regex"); + + @regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g', + 's/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g'); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM REM Keep1 REM REM REM '), "Keep only regex"); + ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex"); + + @regexflag = ('s/(.*)/$1 jrdH8u/'); + ok('REM REM REM REM REM jrdH8u' eq flags_regex('REM REM REM REM REM'), "Keep only regex 's/(.*)/\$1 jrdH8u/'"); + @regexflag = ('s/jrdH8u *//'); + ok('REM REM REM REM REM ' eq flags_regex('REM REM REM REM REM jrdH8u'), "Keep only regex s/jrdH8u *//"); + + @regexflag = ( + 's/(.*)/$1 jrdH8u/', + 's/.*?(Keep1|Keep2|Keep3|jrdH8u)/$1 /g', + 's/(Keep1|Keep2|Keep3|jrdH8u) (?!(Keep1|Keep2|Keep3|jrdH8u)).*/$1 /g', + 's/jrdH8u *//' + ); + + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex 'REM Keep1 REM Keep2 REM'"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM REM Keep1 REM REM REM '), "Keep only regex"); + ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex"); + ok('' eq flags_regex('REM REM REM REM REM'), "Keep only regex"); + + @regexflag = ( + 's/(.*)/$1 jrdH8u/', + 's/.*?(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)/$1 /g', + 's/(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u) (?!(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)).*/$1 /g', + 's/jrdH8u *//' + ); + + ok('\\Deleted \\Answered ' + eq flags_regex('Blabla $Junk \\Deleted machin \\Answered truc'), "Keep only regex: Exchange case"); + ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string"); + ok('' + eq flags_regex('Blabla $Junk machin truc'), "Keep only regex: Exchange case, no accepted flags "); + ok('\\Deleted \\Answered \\Draft \\Flagged ' + eq flags_regex('\\Deleted \\Answered \\Draft \\Flagged '), "Keep only regex: Exchange case"); + + + @regexflag = ( + 's/.*?(?:(\\\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg' + ); + + ok('\\Deleted \\Answered ' + eq flags_regex('Blabla \$Junk \\Deleted machin \\Answered truc'), + "Keep only regex: Exchange case (Phil)"); + + ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string (Phil)"); + + ok('' + eq flags_regex('Blabla $Junk machin truc'), + "Keep only regex: Exchange case, no accepted flags (Phil)"); + + ok('\\Deleted \\Answered \\Draft \\Flagged ' + eq flags_regex('\\Deleted \\Answered \\Draft \\Flagged '), + "Keep only regex: Exchange case (Phil)"); + + +} + +sub flags_regex { + my ($h1_flags) = @_; + foreach my $regexflag (@regexflag) { + my $h1_flags_orig = $h1_flags; + $debug and print "eval \$h1_flags =~ $regexflag\n"; + eval("\$h1_flags =~ $regexflag"); + die_clean("error: eval regexflag '$regexflag': $@\n") if $@; + $debug and print "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n"; + } + return($h1_flags); +} + +sub acls_sync { + my($h1_fold, $h2_fold) = @_; + if ($syncacls) { + my $h1_hash = $imap1->getacl($h1_fold) + or warn "Could not getacl for $h1_fold: $@\n"; + my $h2_hash = $imap2->getacl($h2_fold) + or warn "Could not getacl for $h2_fold: $@\n"; + my %users = map({ ($_, 1) } (keys(%$h1_hash), keys(%$h2_hash))); + foreach my $user (sort(keys(%users))) { + my $acl = $h1_hash->{$user} || "none"; + print "acl $user: [$acl]\n"; + next if ($h1_hash->{$user} && $h2_hash->{$user} && + $h1_hash->{$user} eq $h2_hash->{$user}); + unless ($dry) { + print "setting acl $h2_fold $user $acl\n"; + $imap2->setacl($h2_fold, $user, $acl) + or warn "Could not set acl: $@\n"; + } + } + } +} + + +sub tests_permanentflags { + + my $string; + ok('' eq permanentflags(' * OK [PERMANENTFLAGS (\* \Draft \Answered)] Limited'), + 'permanentflags \*'); + ok('\Draft \Answered' eq permanentflags(' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited'), + 'permanentflags \Draft \Answered'); + ok('\Draft \Answered' + eq permanentflags('Blabla', + ' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited', + 'Blabla'), + 'permanentflags \Draft \Answered' + ); + ok('' eq permanentflags('Blabla'), 'permanentflags nothing'); +} + +sub permanentflags { + my @lines = @_; + + foreach my $line (@lines) { + if ($line =~ m{\[PERMANENTFLAGS \(([^)]+?)\)\]}) { + #print "%%%$1%%%\n"; + my $permanentflags = $1; + if ($permanentflags =~ m{\\\*}) { + $permanentflags = ''; + } + return($permanentflags); + }; + } +} + +sub tests_flags_filter { + + ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' ); + ok( '' eq flags_filter('\Seen', '\Draft \Answered'), 'flags_filter ' ); + ok( '\Seen' eq flags_filter('\Seen', '\Seen'), 'flags_filter ' ); + ok( '\Seen' eq flags_filter('\Seen', ' \Seen '), 'flags_filter ' ); + ok( '\Seen \Draft' + eq flags_filter('\Seen \Draft', '\Draft \Seen \Answered'), 'flags_filter ' ); + ok( '\Seen \Draft' + eq flags_filter('\Seen \Draft', ' \Draft \Seen \Answered '), 'flags_filter ' ); + +} + +sub flags_filter { + my($flags, $allowed_flags) = @_; + + my @flags = split(/\s+/, $flags); + my %allowed_flags = map { $_ => 1 } split(' ', $allowed_flags ); + my @flags_out = map { exists $allowed_flags{$_} ? $_ : () } @flags; + + my $flags_out = join(' ', @flags_out); + #print "%%%$flags_out%%%\n"; + return($flags_out); +} + + + +sub select_msgs { + my ($imap) = @_; + my (@msgs,@max,@min,@union,@inter); + + unless (defined($maxage) or defined($minage)) { + #@msgs = $imap->search("ALL"); + @msgs = $imap->messages(); + return(@msgs); + } + if (defined($maxage)) { + @max = $imap->sentsince(time - 86400 * $maxage); + } + if (defined($minage)) { + @min = $imap->sentbefore(time - 86400 * $minage); + } + SWITCH: { + unless(defined($minage)) {@msgs = @max; last SWITCH}; + unless(defined($maxage)) {@msgs = @min; last SWITCH}; + my (%union, %inter); + foreach my $m (@min, @max) {$union{$m}++ && $inter{$m}++} + @inter = keys(%inter); + @union = keys(%union); + # normal case + if ($minage <= $maxage) {@msgs = @inter; last SWITCH}; + # just exclude messages between + if ($minage > $maxage) {@msgs = @union; last SWITCH}; + + } + return(@msgs); +} + + + + +sub tests_regexmess { + + ok("blabla" eq regexmess("blabla"), "regexmess, no regexmess, nothing to do"); + + @regexmess = ('s/p/Z/g'); + ok("ZoZoZo" eq regexmess("popopo"), "regexmess, s/p/Z/g"); + + @regexmess = 's{c}{C}gxms'; + ok("H1: abC\nH2: Cde\n\nBody abC" + eq regexmess("H1: abc\nH2: cde\n\nBody abc"), + "regexmess, c->C"); + + @regexmess = 's{\AFrom\ }{From:}gxms'; + ok( '' + eq regexmess(''), + 'From mbox 1 add colon blank'); + + ok( 'From:' + eq regexmess('From '), + 'From mbox 2 add colo'); + + ok( "\n" . 'From ' + eq regexmess("\n" . 'From '), + 'From mbox 3 add colo'); + + ok( "From: zzz\n" . 'From ' + eq regexmess("From zzz\n" . 'From '), + 'From mbox 4 add colo'); + + @regexmess = 's{\AFrom\ [^\n]*(\n)?}{}gxms'; + ok( '' + eq regexmess(''), + 'From mbox 1 remove, blank'); + + ok( '' + eq regexmess('From '), + 'From mbox 2 remove'); + + ok( "\n" . 'From ' + eq regexmess("\n" . 'From '), + 'From mbox 3 remove'); + + #print "[", regexmess("From zzz\n" . 'From '), "]"; + ok( "" . 'From ' + eq regexmess("From zzz\n" . 'From '), + 'From mbox 4 remove'); + + + ok( +'Date: Sat, 10 Jul 2010 05:34:45 -0700 +From: + +Hello, +Bye.' + eq regexmess( +'From zzz +Date: Sat, 10 Jul 2010 05:34:45 -0700 +From: + +Hello, +Bye.' + ), + 'From mbox 5 remove'); +} + +sub regexmess { + my ($string) = @_; + foreach my $regexmess (@regexmess) { + $debug and print "eval \$string =~ $regexmess\n"; + eval("\$string =~ $regexmess"); + die_clean("error: eval regexmess '$regexmess': $@\n") if $@; + } + return($string); +} + + +sub stats { + print "++++ Statistics\n"; + print "Transfer time : $timediff sec\n"; + print "Messages transferred : $nb_msg_transferred "; + print "(could be $nb_msg_skipped_dry_mode without dry mode)" if ($dry); + print "\n"; + print "Messages skipped : $nb_msg_skipped\n"; + print "Messages found duplicate on host1 : $h1_nb_msg_duplicate\n"; + print "Messages found duplicate on host2 : $h2_nb_msg_duplicate\n"; + print "Messages void (noheader) on host1 : $h1_nb_msg_noheader\n"; + print "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n"; + print "Messages deleted on host1 : $h1_nb_msg_deleted\n"; + print "Messages deleted on host2 : $h2_nb_msg_deleted\n"; + print "Total bytes transferred : $total_bytes_transferred\n"; + print "Total bytes duplicate host1 : $h1_total_bytes_duplicate\n"; + print "Total bytes duplicate host2 : $h2_total_bytes_duplicate\n"; + print "Total bytes skipped : $total_bytes_skipped\n"; + print "Total bytes error : $total_bytes_error\n"; + $timediff ||= 1; # No division per 0 + printf ("Message rate : %.1f messages/s\n", $nb_msg_transferred / $timediff); + printf ("Average bandwidth rate : %.1f KiB/s\n", $total_bytes_transferred / 1024 / $timediff); + print "Reconnections to host1 : $host1_reconnect_count\n"; + print "Reconnections to host2 : $host2_reconnect_count\n"; + printf ("Memory consumption : %.1f MB\n", $memory_consumption / 1024 / 1024); + print "Memory/biggest message ratio : $memory_ratio\n"; + print "Detected $nb_errors errors\n\n"; + + print $warn_release, "\n"; + print thank_author(); +} + +sub thank_author { + + return("Homepage: http://www.linux-france.org/prj/imapsync/\n"); + + my $basename = imapsync_basename(); + $debug and print "[$basename]\n"; + return("Homepage: http://www.linux-france.org/prj/imapsync/\n") + if ( $basename =~ /\.exe$|\.bin$/ ); + + return(join("", "Happy with this free, open and gratis DWTFPL software?\n", + "Encourage the author (Gilles LAMIRAL) by giving him a book\n", + "or just money via paypal:\n", + "http://www.linux-france.org/prj/imapsync/\n")); +} + +sub get_options { + my $numopt = scalar(@ARGV); + my $argv = join("¤", @ARGV); + + $test_builder = Test::More->builder; + $test_builder->no_ending(1); + + if($argv =~ m/-delete¤2/) { + print "May be you mean --delete2 instead of --delete 2\n"; + exit 1; + } + my $opt_ret = GetOptions( + "debug!" => \$debug, + "debugimap!" => \$debugimap, + "debugimap1!" => \$debugimap1, + "debugimap2!" => \$debugimap2, + "host1=s" => \$host1, + "host2=s" => \$host2, + "port1=i" => \$port1, + "port2=i" => \$port2, + "user1=s" => \$user1, + "user2=s" => \$user2, + "domain1=s" => \$domain1, + "domain2=s" => \$domain2, + "password1=s" => \$password1, + "password2=s" => \$password2, + "passfile1=s" => \$passfile1, + "passfile2=s" => \$passfile2, + "authmd5!" => \$authmd5, + "sep1=s" => \$sep1, + "sep2=s" => \$sep2, + "folder=s" => \@folder, + "folderrec=s" => \@folderrec, + "include=s" => \@include, + "exclude=s" => \@exclude, + "prefix1=s" => \$prefix1, + "prefix2=s" => \$prefix2, + "regextrans2=s" => \@regextrans2, + "regexmess=s" => \@regexmess, + "regexflag=s" => \@regexflag, + "delete!" => \$delete, + "delete2!" => \$delete2, + "delete2folders!" => \$delete2folders, + "syncinternaldates!" => \$syncinternaldates, + "idatefromheader!" => \$idatefromheader, + "syncacls!" => \$syncacls, + "maxsize=i" => \$maxsize, + "minsize=i" => \$minsize, + "maxage=i" => \$maxage, + "minage=i" => \$minage, + "buffersize=i" => \$buffersize, + "foldersizes!" => \$foldersizes, + "dry!" => \$dry, + "expunge!" => \$expunge, + "expunge1!" => \$expunge1, + "expunge2!" => \$expunge2, + "uidexpunge2!" => \$uidexpunge2, + "subscribed!" => \$subscribed, + "subscribe!" => \$subscribe, + "subscribe_all!" => \$subscribe_all, + "justbanner!" => \$justbanner, + "justconnect!"=> \$justconnect, + "justfolders!"=> \$justfolders, + "justfoldersizes!" => \$justfoldersizes, + "fast!" => \$fast, + "version" => \$version, + "help" => \$help, + "timeout=i" => \$timeout, + "skipheader=s" => \$skipheader, + "useheader=s" => \@useheader, + "skipsize!" => \$skipsize, + "allowsizemismatch!" => \$allowsizemismatch, + "fastio1!" => \$fastio1, + "fastio2!" => \$fastio2, + "ssl1!" => \$ssl1, + "ssl2!" => \$ssl2, + "tls1!" => \$tls1, + "tls2!" => \$tls2, + "uid1!" => \$uid1, + "uid2!" => \$uid2, + "authmech1=s" => \$authmech1, + "authmech2=s" => \$authmech2, + "authuser1=s" => \$authuser1, + "authuser2=s" => \$authuser2, + "proxyauth1" => \$proxyauth1, + "proxyauth2" => \$proxyauth1, + "split1=i" => \$split1, + "split2=i" => \$split2, + "reconnectretry1=i" => \$reconnectretry1, + "reconnectretry2=i" => \$reconnectretry2, + "tests" => \$tests, + "tests_debug" => \$tests_debug, + "allow3xx!" => \$allow3xx, + "justlogin!" => \$justlogin, + "tmpdir=s" => \$tmpdir, + "pidfile=s" => \$pidfile, + "releasecheck!" => \$releasecheck, + "modules_version!" => \$modules_version, + ); + + $debug and print "get options: [$opt_ret]\n"; + + # just the version + print imapsync_version(), "\n" and exit if ($version) ; + + if ($tests) { + $test_builder->no_ending(0); + tests(); + exit; + } + if ($tests_debug) { + $test_builder->no_ending(0); + tests_debug(); + exit; + } + + $help = 1 if ! $numopt; + load_modules(); + + # exit with --help option or no option at all + usage() and exit if ($help or ! $numopt) ; + + # don't go on if options are not all known. + exit(EX_USAGE()) unless ($opt_ret) ; + +} + + +sub load_modules { + + require IO::Socket::SSL if ($ssl1 or $ssl2 or $tls1 or $tls2); + + require Term::ReadKey if ( + ((not($password1 or $passfile1)) + or (not($password2 or $passfile2))) + and (not $help)); + + #require Data::Dumper if ($debug); +} + + + +sub parse_header_msg { + my ($imap, $m_uid, $s_heads, $s_fir, $s, $s_hash) = @_; + + my $head = $s_heads->{$m_uid}; + my $headnum = scalar(keys(%$head)); + $debug and print "Head NUM:", $headnum, "\n"; + unless($headnum) { print "Warning: no header used or found for message $m_uid\n"; } + my $headstr; + + foreach my $h (sort keys(%$head)){ + foreach my $val (sort @{$head->{$h}}) { + # no 8-bit data in headers ! + $val =~ s/[\x80-\xff]/X/g; + + # remove the first blanks (dbmail bug ?) + $val =~ s/^\s*(.+)$/$1/; + + # and uppercase header line + # (dbmail and dovecot) + + my $H = uc("$h: $val"); + # show stuff in debug mode + $debug and print "${s}H $H", "\n"; + + if ($skipheader and $H =~ m/$skipheader/i) { + $debug and print "Skipping header $H\n"; + next; + } + $headstr .= "$H"; + } + } + #return unless ($headstr); + unless ($headstr){ + # taking everything is too heavy, + # should take only 1 Ko + print "no header so taking body first 2Ko\n"; + #$headstr = $imap->message_string($m_uid); + $imap->fetch($m_uid, "BODY.PEEK[TEXT]<0.2048>"); + $headstr = $imap->_transaction_literals; + #print "no header so we ignore this message\n"; + #return undef; + } + my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"}; + my $flags = $s_fir->{$m_uid}->{"FLAGS"}; + my $idate = $s_fir->{$m_uid}->{"INTERNALDATE"}; + $size = length($headstr) unless ($size); + my $m_md5 = md5_base64($headstr); + $debug and print "$s msg $m_uid:$m_md5:$size\n"; + my $key; + 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; +} + + +sub firstline { + # extract the first line of a file (without \n) + + my($file) = @_; + my $line = ""; + + open FILE, $file or die_clean("error [$file]: $! "); + chomp($line = ); + 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); +} + + +sub string_to_file { + my($string, $file) = @_; + sysopen(FILE, $file,O_WRONLY|O_TRUNC|O_CREAT, 0600) or die_clean("$! $file"); + print FILE $string; + close FILE; +} + +sub tests_is_a_release_number { + ok(is_a_release_number(1.351), 'is_a_release_number 1.351'); + ok(is_a_release_number(42.4242), 'is_a_release_number 42.4242'); + ok(is_a_release_number(imapsync_version()), 'is_a_release_number imapsync_version()'); + ok(! is_a_release_number('blabla' ), '! is_a_release_number blabla'); + +} + +sub is_a_release_number { + my $number = shift; + + $number =~ m{\d\.\d+}; +} + +sub check_last_release { + + my $public_release = not_long('imapsync_version_lfo'); + return('unknown') if ($public_release eq 'unknown'); + return('unknown') if (! is_a_release_number($public_release)); + return('timeout') if ($public_release eq 'timeout'); + + my $imapsync_here = imapsync_version(); + + if ($public_release > $imapsync_here) { + return("New imapsync release $public_release available"); + }else{ + return("This current imapsync is up to date"); + } +} + +sub imapsync_version { + my $rcs = '$Id: imapsync,v 1.383 2010/11/28 04:28:52 gilles Exp $ '; + $rcs =~ m/,v (\d+\.\d+)/; + my $VERSION = ($1) ? $1: "UNKNOWN"; + return($VERSION); +} + +sub tests_imapsync_basename { + + ok('imapsync' eq imapsync_basename(), 'imapsync_basename: imapsync'); + ok('blabla' ne imapsync_basename(), '! imapsync_basename: blabla'); +} + +sub imapsync_basename { + + return basename($0); + +} + +sub imapsync_version_lfo { + + my $local_version = imapsync_version(); + my $imapsync_basename = imapsync_basename(); + my $agent_info = "$OSNAME system, perl " + . sprintf("%vd", $PERL_VERSION) + . ", Mail::IMAPClient $Mail::IMAPClient::VERSION" + . " $imapsync_basename"; + my $sock = new IO::Socket::INET ( + PeerAddr => 'imapsync.lamiral.info', + PeerPort => '80', + Proto => 'tcp'); + return('unknown') if not $sock; + print $sock + "GET /prj/imapsync/VERSION HTTP/1.0\n", + "User-Agent: imapsync/$local_version ($agent_info)\n", + "Host: www.linux-france.org\n\n"; + my @line = <$sock>; + close($sock); + my $last_release = $line[-1]; + chomp($last_release); + return($last_release); +} + +sub not_long { + #print "Entering not_long\n"; + my ($func) = @_; + my $val; + + # Doesn't work with gethostbyname (see perlipc) + #local $SIG{ALRM} = sub { die "alarm\n" }; + + if ('MSWin32' eq $OSNAME) { + local $SIG{ALRM} = sub { die "alarm\n" }; + }else{ + + POSIX::sigaction(SIGALRM, + POSIX::SigAction->new(sub { die "alarm" })) + or warn "Error setting SIGALRM handler: $!\n"; + } + + eval { + + alarm(3); + #print $func, "\n"; + { + no strict "refs"; + #print "Calling $func\n"; + $val = &$func(); + #print "End of $func\n"; + } + alarm(0); + }; + if ($@) { + if ($@ =~ /alarm/) { + # timed out + return('timeout'); + }else{ + alarm(0); + return('unknown'); # propagate unexpected errors + } + }else { + # didn't + return($val); + } +} + +sub localhost_info { + + my($infos) = join("", + "Here is a [$OSNAME] system (", + join(" ", + uname(), + ), + ")\n", + "With perl ", + sprintf("%vd", $PERL_VERSION), + " Mail::IMAPClient $Mail::IMAPClient::VERSION", + ); + return($infos); + +} + +sub usage { + my $localhost_info = localhost_info(); + my $thank = thank_author(); + my $warn_release =''; + $warn_release = check_last_release() if (not defined($releasecheck)); + print < : "from" imap server. Mandatory. +--port1 : port to connect on host1. Default is 143. +--user1 : user to login on host1. Mandatory. +--domain1 : domain on host1 (NTLM authentication). +--authuser1 : user to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. +--proxyauth1 : Use proxyauth on host1. Requires --authuser1. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user +--password1 : password for the user1. Dangerous, use --passfile1 +--passfile1 : password file for the user1. Contains the password. +--host2 : "destination" imap server. Mandatory. +--port2 : port to connect on host2. Default is 143. +--user2 : user to login on host2. Mandatory. +--domain2 : domain on host2 (NTLM authentication). +--authuser2 : user to auth with on host2 (admin user). +--proxyauth2 : Use proxyauth on host2. Requires --authuser2. + Required by Sun/iPlanet/Netscape IMAP servers to + be able to use an administrative user +--password2 : password for the user2. Dangerous, use --passfile2 +--passfile2 : password file for the user2. Contains the password. +--noauthmd5 : don't use MD5 authentification. +--authmech1 : auth mechanism to use with host1: + PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. +--authmech2 : auth mechanism to use with host2. See --authmech1 +--ssl1 : use an SSL connection on host1. +--ssl2 : use an SSL connection on host2. +--tls1 : use an TLS connection on host1. +--tls2 : use an TLS connection on host2. +--folder : sync this folder. +--folder : and this one, etc. +--folderrec : sync this folder recursively. +--folderrec : and this one, etc. +--include : sync folders matching this regular expression +--include : or this one, etc. + in case both --include --exclude options are + use, include is done before. +--exclude : skips folders matching this regular expression + Several folders to avoid: + --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. +--exclude : or this one, etc. +--tmpdir : where to store temporary files and subdirectories. + Will be created if it doesn't exist. + Default is system specific and should be ok. +--pidfile : the file where imapsync pid is written. +--prefix1 : remove prefix to all destination folders + (usually INBOX. for cyrus imap servers) + you can use --prefix1 if your source imap server + does not have NAMESPACE capability. +--prefix2 : add prefix to all destination folders + (usually INBOX. for cyrus imap servers) + use --prefix2 if your target imap server does not + have NAMESPACE capability. +--regextrans2 : Apply the whole regex to each destination folders. +--regextrans2 : and this one. etc. + When you play with the --regextrans2 option, first + add also the safe options --dry --justfolders + Then, when happy, remove --dry, remove --justfolders +--regexmess : Apply the whole regex to each message before transfer. + Example: 's/\\000/ /g' # to replace null by space. +--regexmess : and this one. +--regexmess : and this one, etc. +--regexflag : Apply the whole regex to each flags list. + Example: 's/\"Junk"//g' # to remove "Junk" flag. +--regexflag : and this one, etc. +--sep1 : separator in case namespace is not supported. +--sep2 : idem. +--delete : delete messages on host1 server after + a successful transfer. Useful in case you + want to migrate from one server to another one. + With imap, "delete" tags messages as deleted, they + are not really deleted. See expunge. +--delete2 : delete messages in host2 that are not in + host1 server. +--delete2folders : delete folders in host2 that are not in + host1 server. For safety try it like this: + --delete2folders --dry --justfolders --nofoldersizes +--expunge : expunge messages on host1. + expunge really deletes messages marked deleted. + expunge is made at the beginning, on host1 only. + Newly transferred messages are expunged if + option --expunge is given. + No expunge is done on destination account + (see --expunge2) but it may change in future releases. +--expunge1 : expunge messages on host1. +--expunge2 : expunge messages on host2. +--uidexpunge2 : uidexpunge messages on the destination imap server + that are not on the source server, requires --delete2 +--syncinternaldates : sets the internal dates on host2 same as host1. + Turned on by default. Internal date is the date + a message arrived on a host (mtime). +--idatefromheader : sets the internal dates on host2 same as the + "Date:" headers. +--buffersize : sets the size of a block of I/O. +--maxsize : skip messages larger (or equal) than bytes +--minsize : skip messages smaller (or equal) than bytes +--maxage : skip messages older than days. + final stats (skipped) don't count older messages + see also --minage +--minage : skip messages newer than days. + final stats (skipped) don't count newer messages + You can do (+ are the messages selected): + past|----maxage+++++++++++++++>now + past|+++++++++++++++minage---->now + past|----maxage+++++minage---->now (intersection) + past|++++minage-----maxage++++>now (union) +--skipheader : Don't take into account header keyword + matching ex: --skipheader 'X.*' +--useheader : Use this header to compare messages on both sides. + Ex: Message-ID or Subject or Date. +--useheader and this one, etc. +--skipsize : Don't take message size into account to compare + messages on both sides. On by default. + Use --no-skipsize for using size comparaison. +--allowsizemismatch : allow RFC822.SIZE != fetched msg size + consider also --skipsize to avoid duplicate messages + when running syncs more than one time per mailbox +--dry : do nothing, just print what would be done. +--subscribed : transfers subscribed folders. +--subscribe : subscribe to the folders transferred on the + host2 that are subscribed on host1. +--subscribe_all : subscribe to the folders transferred on the + host2 even if they are not subscribed on host1. +--nofoldersizes : Do not calculate the size of each folder in bytes + and message counts. Default is to calculate them. +--justfoldersizes : exit after printed the folder sizes. +--syncacls : Synchronises acls (Access Control Lists). +--nosyncacls : Does not synchronise acls. This is the default. +--debug : debug mode. +--debugimap1 : imap debug mode for host1. imap debug is very verbose. +--debugimap2 : imap debug mode for host2. +--debugimap : imap debug mode for host1 and host2. +--version : print software version. +--noreleasecheck : do not check for new imapsync release (a http request). +--justconnect : just connect to both servers and print useful + information. Need only --host1 and --host2 options. +--justlogin : just login to both host1 and host2 with users + credentials, then exit. +--justfolders : just do things about folders (ignore messages). +--fast : be faster (just does not sync flags of messages + already transfered). +--reconnectretry1 : reconnect to host1 if connection is lost up to + times per imap command (default is 3) +--reconnectretry2 : same as --reconnectretry1 but for host2 +--split1 : split the requests in several parts on host1. + is the number of messages handled per request. + default is like --split1 1000. +--split2 : same thing on host2. +--fastio1 : use fastio with host1. +--fastio2 : use fastio with host2. +--timeout : imap connect timeout. +--help : print this help. + +Example: to synchronise imap account "foo" on "imap.truc.org" + to imap account "bar" on "imap.trac.org" + with foo password "secret1" + and bar password "secret2" + +$0 \\ + --host1 imap.truc.org --user1 foo --password1 secret1 \\ + --host2 imap.trac.org --user2 bar --password2 secret2 + +$localhost_info +$rcs +$warn_release + +$thank +EOF +} + + +sub good_date { + # two incoming formats: + # header Tue, 24 Aug 2010 16:00:00 +0200 + # internal 24-Aug-2010 16:00:00 +0200 + + # outgoing format: internal date format + # 24-Aug-2010 16:00:00 +0200 + + my ($d) = @_; + return ('') if not defined($d); + + if ( $d =~ m{(\d?)(\d-...-\d{4})( \d{2}:\d{2}:\d{2})( (?:\+|-)\d{4})?}o ) { + #print "internal: [$1][$2][$3][$4]\n"; + my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4); + $day_1 = '0' if ($day_1 eq ''); + $zone = '' if not defined($zone); + $d = $day_1 . $date_rest . $hour . $zone; + + + }elsif ($d =~ m{(?:.{3}, )(\d?)(\d) (...) (\d{4})( \d{2}:\d{2}:\d{2})( (?:\+|-)\d{4})?}o ) { + #print "header: [$1][$2][$3][$4][$5][$6]\n"; + my ($day_1, $day_rest, $month, $year, $hour, $zone) = ($1,$2,$3,$4,$5,$6); + $day_1 = '0' if ($day_1 eq ''); + $zone = '' if not defined($zone); + $d = $day_1 . "$day_rest-$month-$year" . $hour . $zone; + + }else{ + # unknown/unmatch => return same string + return($d); + } + + $d = qq("$d"); + return($d); +} + +sub memory_consumption { + # memory consumed by imapsync until now in bytes + return((memory_consumption_of_pids())[0]); +} + +sub memory_consumption_of_pids { + + my @PID = (@_) ? @_ : ($PROCESS_ID); + + #print "PIDs: @PID\n"; + my @val; + if ('MSWin32' eq $OSNAME) { + @val = memory_consumption_of_pids_win32(@PID); + }else{ + # Unix + my @ps = qx{ ps -o vsz @PID }; + shift @ps; # First line is column name "VSZ" + chomp @ps; + # convert to + @val = map { $_ * 1024 } @ps; + return(@val); + } +} + +sub memory_consumption_of_pids_win32 { + # Windows + my @PID = @_; + my %PID; + # hash of pids as key values + map { $PID{$_}++ } @PID; + + # Does not work but should reading the tasklist documentation + #@ps = qx{ tasklist /FI "PID eq @PID" }; + + my @ps = qx{ tasklist /NH /FO CSV }; + #print "-" x 80, "\n", @ps, "-" x 80, "\n"; + my @val; + foreach my $line (@ps) { + my($name, $pid, $mem) = (split(',', $line))[0,1,4]; + next if (! $pid); + #print "[$name][$pid][$mem]"; + if ($PID{remove_qq($pid)}) { + #print "MATCH !\n"; + chomp($mem); + $mem = remove_qq($mem); + $mem = remove_Ko($mem); + $mem = remove_not_num($mem); + #print "[$mem]\n"; + push(@val, $mem * 1024); + } + } + return(@val); +} + +sub remove_not_num { + + my $string = shift; + $string =~ tr/0-9//cd; + #print "tr [$string]\n"; + return($string); +} + +sub tests_remove_not_num { + + ok('123' eq remove_not_num(123), 'remove_not_num( 123 )'); + ok('123' eq remove_not_num('123'), "remove_not_num( '123' )"); + ok('123' eq remove_not_num('12 3'), "remove_not_num( '12 3' )"); + ok('123' eq remove_not_num('a 12 3 Ko'), "remove_not_num( 'a 12 3 Ko' )"); +} + +sub remove_Ko { + my $string = shift; + if ($string =~ /^(.*) Ko$/) { + return($1); + }else{ + return($string); + } +} + +sub remove_qq { + my $string = shift; + if ($string =~ /^"(.*)"$/) { + return($1); + }else{ + return($string); + } +} + +sub memory_consumption_ratio { + + my ($base) = @_; + $base ||= 1; + my $consu = memory_consumption(); + return($consu / $base); +} + +sub tests_memory_consumption { + + ok(print join("\n", memory_consumption_of_pids()), "\n"); + ok(print join("\n", memory_consumption_of_pids('1')), "\n"); + ok(print join("\n", memory_consumption_of_pids('1', $$)), "\n"); + + ok(print memory_consumption_ratio(), "\n"); + ok(print memory_consumption_ratio(1), "\n"); + ok(print memory_consumption_ratio(10), "\n"); + + ok(print memory_consumption(), "\n"); +} + +sub tests_good_date { + + ok('' eq good_date(), 'good_date no arg'); + ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24-Aug-2010 16:00:00 +0200'), 'good_date internal 2digit zone'); + ok('"24-Aug-2010 16:00:00"' eq good_date('24-Aug-2010 16:00:00'), 'good_date internal 2digit no zone'); + ok('"01-Sep-2010 16:00:00 +0200"' eq good_date( '1-Sep-2010 16:00:00 +0200'), 'good_date internal SP 1digit'); + ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('Tue, 24 Aug 2010 16:00:00 +0200'), 'good_date header 2digit zone'); + ok('"01-Sep-2010 16:00:00"' eq good_date('Wed, 1 Sep 2010 16:00:00'), 'good_date header SP 1digit zone'); + ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200'), 'good_date header SP 1digit zone'); + ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200 (CEST)'), 'good_date header SP 1digit zone'); + +} + + +sub tests_list_keys_in_2_not_in_1 { + + my @list; + ok( ! list_keys_in_2_not_in_1( {}, {}), 'list_keys_in_2_not_in_1: {} {}'); + ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {}, {} ) ] ), 'list_keys_in_2_not_in_1: {} {}'); + ok( 0 == compare_lists( ['a','b'], [ list_keys_in_2_not_in_1( {}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {} {a, b}'); + ok( 0 == compare_lists( ['b'], [ list_keys_in_2_not_in_1( {'a' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a} {a, b}'); + ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b} {a, b}'); + ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}'); + ok( 0 == compare_lists( ['b'], [ list_keys_in_2_not_in_1( {'a' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}'); + +} + +sub list_keys_in_2_not_in_1 { + + my $folders1_ref = shift; + my $folders2_ref = shift; + my @list; + + foreach my $folder ( sort keys %$folders2_ref ) { + next if exists($folders1_ref->{$folder}); + push(@list, $folder); + } + return(@list); +} + + +sub list_folders_in_2_not_in_1 { + + my (@h2_folders_not_in_1, %h2_folders_not_in_1); + @h2_folders_not_in_1 = list_keys_in_2_not_in_1( \%h1_folders_all, \%h2_folders_all); + map { $h2_folders_not_in_1{$_} = 1} @h2_folders_not_in_1; + @h2_folders_not_in_1 = list_keys_in_2_not_in_1( \%h2_folders_from_1, \%h2_folders_not_in_1); + + return( reverse @h2_folders_not_in_1 ); +} + +sub delete_folders_in_2_not_in_1 { + + my $dry_message = ''; + $dry_message = "\t(not really since --dry mode)" if $dry; + foreach my $folder (@h2_folders_not_in_1) { + + my $res = $dry; # always success in dry mode! + $res = $imap2->delete($folder) if ( ! $dry ) ; + if ($res) { + print "Delete $folder", "$dry_message", "\n"; + }else{ + print "Delete $folder failure", "\n"; + } + } +} + +sub tests_debug { + + SKIP: { + skip "No test in normal run" if (not $tests_debug); + tests_list_keys_in_2_not_in_1(); + } +} + +sub tests { + + SKIP: { + skip "No test in normal run" if (not $tests); + tests_folder_routines(); + tests_compare_lists(); + tests_regexmess(); + tests_flags_regex(); + tests_permanentflags(); + tests_flags_filter(); + tests_imap2_folder_name(); + tests_command_line_nopassword(); + tests_good_date(); + tests_max(); + tests_remove_not_num(); + tests_memory_consumption(); + tests_is_a_release_number(); + tests_imapsync_basename(); + tests_list_keys_in_2_not_in_1(); + } +} + +# 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; +}; + + +*Mail::IMAPClient::append_file = sub { + + my $self = shift; + my $folder = $self->Massage(shift); + my $file = shift; + my $control = shift || undef; + my $count = $self->Count($self->Count+1); + my $flags = shift || undef; + my $date = shift || undef; + + if (defined($flags)) { + $flags =~ s/^\s+//g; + $flags =~ s/\s+$//g; + } + + if (defined($date)) { + $date =~ s/^\s+//g; + $date =~ s/\s+$//g; + } + + $flags = "($flags)" if $flags and $flags !~ /^\(.*\)$/ ; + $date = qq/"$date"/ if $date and $date !~ /^"/ ; + + + unless ( -f $file ) { + $self->LastError("File $file not found.\n"); + return undef; + } + + my $fh = IO::File->new($file) ; + + unless ($fh) { + $self->LastError("Unable to open $file: $!\n"); + $@ = "Unable to open $file: $!" ; + carp "unable to open $file: $!"; + return undef; + } + + my $bare_nl_count = scalar grep { /^\x0a$|[^\x0d]\x0a$/} <$fh>; + + seek($fh,0,0); + + my $clear = $self->Clear; + + $self->Clear($clear) + if $self->Count >= $clear and $clear > 0; + + my $length = ( -s $file ) + $bare_nl_count; + + my $string = "$count APPEND $folder " . + ( $flags ? "$flags " : "" ) . + ( $date ? "$date " : "" ) . + "{" . $length . "}\x0d\x0a" ; + + $self->_record($count,[ $self->_next_index($count), "INPUT", "$string" ] ); + + my $feedback = $self->_send_line("$string"); + + unless ($feedback) { + $self->LastError("Error sending '$string' to IMAP: $!\n"); + $fh->close; + return undef; + } + + my ($code, $output) = ("",""); + + until ( $code ) { + $output = $self->_read_line or $fh->close, return undef; + foreach my $o (@$output) { + $self->_record($count,$o); # $o is already an array ref + ($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i; + if ($o->[DATA] =~ /^\*\s+BYE/) { + carp $o->[DATA]; + $self->State(Unconnected); + $fh->close; + return undef ; + } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { + carp $o->[DATA]; + $fh->close; + return undef; + } + } + } + + { # Narrow scope + # Slurp up headers: later we'll make this more efficient I guess + local $/ = "\x0d\x0a\x0d\x0a"; + my $text = <$fh>; + $text =~ s/\x0d?\x0a/\x0d\x0a/g; + $self->_record($count,[ $self->_next_index($count), "INPUT", "{From file $file}" ] ) ; + $feedback = $self->_send_line($text); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + $fh->close; + return undef; + } + _debug($self, "control points to $$control\n") if ref($control) and $self->Debug; + $/ = ref($control) ? "\x0a" : $control ? $control : "\x0a"; + while (defined($text = <$fh>)) { + $text =~ s/\x0d?\x0a/\x0d\x0a/g; + $self->_record( $count, + [ $self->_next_index($count), "INPUT", "{from $file}\x0d\x0a" ] + ); + $feedback = $self->_send_line($text,1); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + $fh->close; + return undef; + } + } + $feedback = $self->_send_line("\x0d\x0a"); + + unless ($feedback) { + $self->LastError("Error sending append msg text to IMAP: $!\n"); + $fh->close; + return undef; + } + } + + # Now for the crucial test: Did the append work or not? + ($code, $output) = ("",""); + + my $uid = undef; + until ( $code ) { + $output = $self->_read_line or return undef; + foreach my $o (@$output) { + $self->_record($count,$o); # $o is already an array ref + $self->_debug("append_file: Deciding if " . $o->[DATA] . " has the code.\n") + if $self->Debug; + ($code) = $o->[DATA] =~ /^\d+\s(NO|BAD|OK)/i; + # try to grab new msg's uid from o/p + $o->[DATA] =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1; + if ($o->[DATA] =~ /^\*\s+BYE/) { + carp $o->[DATA]; + $self->State(Unconnected); + $fh->close; + return undef ; + } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { + carp $o->[DATA]; + $fh->close; + return undef; + } + } + } + $fh->close; + + if ($code !~ /^OK/i) { + return undef; + } + + + return defined($uid) ? $uid : $self; +}; + + + + +*Mail::IMAPClient::fetch_hash = sub { + # taken from original lib, + # just added split code. + my $self = shift; + my $hash = 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 = scalar($self->messages); + 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 ( exists $hash->{$uid} ) { + $entry = $hash->{$uid} ; + } + else { + $hash->{$uid} ||= $entry; + } + } + else { + my($mid) = $l =~ /^\* (\d+) FETCH/i; + next unless $mid; + if ( exists $hash->{$mid} ) { + $entry = $hash->{$mid} ; + } + else { + $hash->{$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 : $hash; +}; + + + +*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 ) { + warn "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::exists = sub { + 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 + +package Mail::IMAPClient; + +sub Split { + my $self = shift; + + if (@_) { + $self->{SPLIT} = shift; + $self->{Maxcommandlength} = 10 * $self->{SPLIT}; + } + return $self->{SPLIT}; +} + +sub Tls { + my $self = shift; + + if (@_) { $self->{TLS} = shift } + return $self->{TLS}; +} + +sub Reconnect_counter { + my $self = shift; + if (@_) { $self->{Reconnect_counter} = shift } + return $self->{Reconnect_counter}; + +} + + +sub Banner { + my $self = shift; + + if (@_) { $self->{BANNER} = shift } + return $self->{BANNER}; +} + + +sub RawSocket2 { + my ( $self, $sock ) = @_; + defined $sock + or return $self->{Socket}; + + $self->{Socket} = $sock; + $self->{_select} = IO::Select->new($sock); + delete $self->{_fcntl}; + #$self->Fast_io( $self->Fast_io ); + $sock; +} + +sub capability_update { + my $self = shift; + + delete $self->{CAPABILITY}; + $self->capability; +} + +sub fetch_hash_2 { + # 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; +} diff --git a/index.shtml b/index.shtml index 35f2adc..38beb6c 100644 --- a/index.shtml +++ b/index.shtml @@ -5,7 +5,7 @@ imapsync <!--#exec cmd="cat VERSION" --> - + @@ -14,15 +14,13 @@ + @@ -31,14 +29,20 @@ text-align: center; + + +
-imapsync logo +imapsync logo + +

Welcome to the imapsync web site!

- -

imapsync web site

-

What is imapsync?

imapsync software is a command line tool allowing incremental and @@ -49,103 +53,163 @@ or in your local network.

imapsync is useful for imap account migration or imap account backup.

-

imapsync is not adequat for maintening two active imap accounts in synchronization +

imapsync is not adequate for maintaining two active imap accounts in synchronization where the user plays independently on both sides. Use offlineimap (written by John Goerzen) for this purpose.

-

AUTHOR

+

Who is the author?

Gilles LAMIRAL
Email: gilles.lamiral@laposte.net

Good feedback is always welcome, bad feedback is often welcome.

-

A nice place to talk about imapsync is the public - imapsync mailing-list (see below).

+

Where to talk about imapsync?

-

If you use imapsync as a professionnal worker you may - read this call - for rewarding. +

A nice place to talk about imapsync is the public + imapsync mailing-list (see below section Mailing-List).

-

Other ways to consider the situation:

-
    -
  • stop beeing a - leech. -
    • -
  • think about - helping back - a software developper and helper. -
    • -
- + -

imapsync call for donation

-

Are you happy with this free, open and gratis software?

-

Then you can help me back to maintain imapsync -and support you!
-I will personally thank each donation -with an email and add an entry in the imapsync CREDITS file.

+ +

Latest release is imapsync + +

+ + +

Written on

+ + + +

See ChangeLog to know what's new.

+ + + +

New features since previous release 1.383:

+ +
    +
  • new option --usecache to speedup transfers when using multiple runs.
    • +
  • new option --delete2foldersonly to select which host2 folder hierarchy can be removed if it is away from host1.
    • +
  • new option --delete2foldersbutnot to avoid removing host2 folder hierarchy even if it is away from host1.
    • +
  • Added info about the biggest messages (imapsync uses about 18 times in RAM the size of the biggest transfered message)
    • +
+ + +

The next imapsync release should see:

+
    +
  • An option to sync to and from files (local backup)
    • +
+ + +

Buy imapsync source code

+ +

+The Perl imapsync source code will run anywhere a Perl interpreter can run: any Unix, Linux, Windows, or Mac OS operating system. +

+ +

Buy latest imapsync Perl source code
++ standalone imapsync.exe for win32
++ standalone x86_elf binary for 30 EUR (~40 USD): +

-Technical support option (+ 80 EUR) + + +

+ + - +

+ +

You will receive a download link in few minutes (contact me if the delay is over 20 minutes).
+30 days money-back guarantee.

+ +

Standalone imapsync.exe for win32

+ +

Struggle free from source code and Perl installation by
+buying the latest win32 standalone imapsync.exe for 22 EUR (~29 USD):

+ + +

-You can also offer me a book on my imapsync amazon -wishlist
+

- + + +
Technical support option (+ 80 EUR)

-If you prefer making your donation with cash or cheque then my postal address is:
-Gilles LAMIRAL
-4 La Billais
-35580 Baulon
-FRANCE
 + + + +

+
+ +

You will receive a download link in few minutes (contact me if the delay is over 20 minutes).
+30 days money-back guarantee.

+ + -() - - -

See ChangeLog to know what's new.

- -

imapsync source download

- -

Standalone -imapsync executable for win32, thanks to Strawberry Perl 5.12 and Par::Packer module.
-The imapsync.exe built time is .
-The build system for imapsync.exe is XP Pro SP2 on a Intel Celeron 400 MHz 256 Mo RAM. +The imapsync.exe built time is .
+The build system for imapsync.exe is XP Pro SP2 on a Intel Celeron 400 MHz 256 Mo RAM.

+--> + + +

Documentation

+ +

Read the INSTALL file to know how to install imapsync on your system.

-

imapsync installation

+

The README file has many tips to understand imapsync and succeed in your migration or backup. +

-

README

+

The FAQ file presents Frequently Asked Questions (and not so frequently asked ones). +

-

Frequently Asked Questions

+

The TODO file list what may be coded or done in the future.
+See also the wanted section. +

+ +

All the people I thank are in the CREDITS file. +

+ +

What you can do with imapsync is listed in COPYING. +

-

MAILING-LIST

+

The imapsync mailing list

The public mailing-list may be the best way to get free support.
@@ -194,47 +258,152 @@ The build system for imapsync.exe is XP Pro SP2 on a Intel Celeron 400 MHz 256 M

-

- -WANTED

- +

WANTED!

I code new features and fix bugs for free when I have time and when I find it useful.
If you really want a feature or a fix you can donate money and my next development time will be to code it or fix it.

-

Some features and their time/money to be done evaluation

+

On january 2011: 1 EUR ~ 1.3 USD.

+ + +
+

+ + + + +

+
+ + +

Some features and their time/money to be done evaluation:

- - - - - - - - - + + + + + + + + + + + +
DONEFeature Time guessedTime spentMoney receivedMoney needed
NoEfficient Gmail backup 8 hours 80 min 0 $ 240 $
NoSpeedup 50% 10 hours 80 min 10 $ 300 $
NoBackup to files 8 hours 60 min 0 $ 240 $
Yes--delete2folders 3 hours 270 min 90 $ 0 $
NoNTLM auth 3 hours 60 min 0 $ 90 $
YesWin32 imapsync.exe 8 hours 520 min 0 $ 240 $
YesWin32 bug fixes various 370 min 100 $ 85 $
YesFix capability changes 1 hour 80 min 0 $ 30 $
YesLarge mailbox --maxage 4 hours 270 min 0 $ 120 $
NoBackup to files 20 hours 60 min 0 $ 800 $
NoEfficient Gmail backup 20 hours 80 min 0 $ 800 $
YesAdd cache 10 hours 1310 min 400 $ 400 $
YesSpeedup 50% 10 hours 80 min 10 $ 400 $
Yes--delete2folders 3 hours 270 min 90 $ 0 $
YesNTLM auth 3 hours 300 min 15 $ 150 $
YesWin32 imapsync.exe 8 hours 520 min 45 $ 240 $
YesWin32 bug fixes various 370 min 100 $ 85 $
YesFix capability changes 1 hour 80 min 0 $ 40 $
YesLarge mailbox --maxage 4 hours 270 min 0 $ 160 $
Yesdkimap support 3 hours 120 min 0 $ 120 $
Nogratis from here 4 hours 0 min 0 $ 120000 $
-

COPYING

+

Lists of imap server software failures and success stories

-

ChangeLog

+

Let's start with reported failure stories over the past +(maybe new imapsync release can run successfully with them). +

-

CREDITS

+
    +
  • DBMail 0.9, 2.0.7 (GPL). But most other DBMail releases work (see below)
    • +
  • Imail 7.04 (maybe).
    • +
  • MailEnable 1.54 (Proprietary) http://www.mailenable.com/
    • +
+ +

Now the long reported success stories list +([host1] means "source server", +[host2] means "destination server"): +

+ + + +
    +
  • 1und1 H mimap1 84498 [host1]
    • +
  • Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] + (OSL 3.0) http://www.archiveopteryx.org/
    • +
  • BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
    • +
  • CommuniGatePro server (Redhat 8.0) (Solaris), CommuniGate Pro 5.2.17[host2] (CentOS 5.4)
    • +
  • Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL) + (http://www.courier-mta.org/)
    • +
  • Critical Path (7.0.020)
    • +
  • Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18 + 2.2.1, 2.2.2-BETA, 2.2.10, 2.2.12, + v2.2.3-Invoca-RPM-2.2.3-8, + 2.3-alpha (OSI Approved), + v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1, + 2.2.13, + v2.3.1-Invoca-RPM-2.3.1-2.7.fc5, + v2.3.7, + (http://asg.web.cmu.edu/cyrus/) +
    • +
  • David Tobit V8 (proprietary Message system).
    • +
  • DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). + 2.0.7 seems buggy.
    • +
  • Deerfield VisNetic MailServer 5.8.6 [host1]
    • +
  • dkimap4 [host1]
    • +
  • Domino (Notes) 4.61[host1], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1[host1], 8.0.1[host1]
    • +
  • Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, + 1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/)
    • +
  • Eudora WorldMail v2
    • +
  • GMX IMAP4 StreamProxy.
    • +
  • Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ.
    • +
  • hMailServer 5.3.3 [host2], 4.4.1 [host1]
    • +
  • iPlanet Messaging server 4.15, 5.1, 5.2
    • +
  • IMail 7.15 (Ipswitch/Win2003), 8.12
    • +
  • MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform)
    • +
  • 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], Exchange 2007 SP1 (with Update Rollup 2), + Exchange2007-EP-SP2, + Exchange 2010 RTM (Release to Manufacturing) [host2]
    • +
  • Mirapoint server
    • +
  • Netscape Mail Server 3.6 (Wintel)
    • +
  • Netscape Messaging Server 4.15 Patch 7
    • +
  • OpenMail IMAP server B.07.00.k0
    • +
  • OpenWave
    • +
  • Oracle Beehive [host1]
    • +
  • Qualcomm Worldmail (NT)
    • +
  • Rockliffe Mailsite 5.3.11, 4.5.6
    • +
  • Samsung Contact IMAP server 8.5.0
    • +
  • Scalix v10.1, 10.0.1.3, 11.0.0.431
    • +
  • SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [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
    • +
  • 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/)
    • +
  • UW - QMail v2.1
    • +
  • VMS, Imap part of TCP/IP suite of VMS 7.3.2
    • +
  • Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, 5.5, 6.x
    • +

- Valid XHTML 1.0 Strict + + Valid XHTML 1.0 Strict + + + CSS Valide ! + + + + + +

+ +
+

-This document last modified
-$Id: index.shtml,v 1.31 2010/10/25 00:05:35 gilles Exp gilles $ +This document last modified on +($Id: index.shtml,v 1.50 2011/01/18 04:01:20 gilles Exp gilles $)

diff --git a/learn/fetch_with_size b/learn/fetch_with_size new file mode 100755 index 0000000..8ea7b95 --- /dev/null +++ b/learn/fetch_with_size @@ -0,0 +1,54 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use English; +use Mail::IMAPClient; + +$ARGV[3] or die "usage: $0 host user password folder uid\n"; + +my $host = $ARGV[0]; +my $user = $ARGV[1]; +my $password = $ARGV[2]; +my $folder = $ARGV[3]; +my $uid = $ARGV[4]; + +my $imap = Mail::IMAPClient->new(); +$imap->Debug(0); +$imap->Server($host); +$imap->connect() or die; +$imap->User($user); +$imap->Password($password); +$imap->login() or die; +$imap->Uid(1); +$imap->Peek(1); +$imap->Clear(1); + +#print map {"$_\n"} $imap->folders(); + +$imap->select($folder) or die; +my @msgs = $imap->messages or die "Could not messages: $@\n"; +print "@msgs\n"; +foreach my $msg (@msgs) { + $imap->fetch($msg, "BODY.PEEK[TEXT]<0.3000>"); + my $text = $imap->_transaction_literals; + print '#' x 72, " $msg TEXT = \n$text\n"; + my $part = $imap->bodypart_string($msg, '', 3000, 0); + print '#' x 72, " $msg PART = \n$part\n"; +} +$imap->close(); + + +package Mail::IMAPClient; + +sub _transaction_literals() { + 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; +} + diff --git a/learn/imapclient3xx_skeleton_test b/learn/imapclient3xx_skeleton_test index 5524e44..9ea29e8 100644 --- a/learn/imapclient3xx_skeleton_test +++ b/learn/imapclient3xx_skeleton_test @@ -20,4 +20,4 @@ $imap->login() or die; $imap->Uid(1); $imap->Peek(1); $imap->select($folder) or die; -$imap->close(); +$imap->logout(); diff --git a/learn/io_socket_get b/learn/io_socket_get index e7037f6..8a1931b 100755 --- a/learn/io_socket_get +++ b/learn/io_socket_get @@ -3,10 +3,15 @@ use warnings; use strict; use IO::Socket; +use English ; +use POSIX qw(uname SIGALRM); +use lib ( '../Mail-IMAPClient-3.25/lib' ) ; +use Mail::IMAPClient; sub last_release { + my $host = shift || 'linux-france.org' ; my $sock = new IO::Socket::INET ( - PeerAddr => 'linux-france.org', + PeerAddr => $host, PeerPort => '80', Proto => 'tcp'); return('unknown') if not $sock; @@ -44,5 +49,67 @@ sub not_long { } } -print last_release(), "\n"; -print not_long('last_release'), "\n"; +sub not_long2 { + #print "Entering not_long\n"; + my ( $func ) = shift ; + my ( @argv ) = @_ ; + my $val ; + + # Doesn't work with gethostbyname (see perlipc) + #local $SIG{ALRM} = sub { die "alarm\n" }; + + if ('MSWin32' eq $OSNAME) { + local $SIG{ALRM} = sub { die "alarm\n" }; + }else{ + + POSIX::sigaction(SIGALRM, + POSIX::SigAction->new(sub { die "alarm" })) + or warn "Error setting SIGALRM handler: $!\n"; + } + + eval { + + alarm(3); + print "$func @argv", "\n"; + { + no strict "refs"; + #print "Calling $func\n"; + $val = &$func( @argv ) ; + #print "End of $func\n"; + } + alarm(0); + }; + if ( $@ ) { + #print "$@"; + if ($@ =~ /alarm/) { + # timed out + return('timeout'); + }else{ + alarm(0); + return('unknown'); # propagate unexpected errors + } + }else { + # didn't + return($val); + } +} + +sub connect_test { + my $host = 'localhost' ; + + my $imap = Mail::IMAPClient->new( ) ; + $imap->Debug( 1 ) ; + $imap->Server( $host ) ; + $imap->connect( ) or die ; + $imap->IsUnconnected( ) ; + $imap->logout( ) ; +} + + +#print last_release(), "\n" ; +#print not_long('last_release'), "\n" ; +connect_test( ) ; +print not_long2( 'last_release', ), "\n" ; +#print not_long2( 'last_release' ), "\n" ; + +connect_test( ) ; diff --git a/learn/zzz b/learn/zzz new file mode 100644 index 0000000..72e95a1 --- /dev/null +++ b/learn/zzz @@ -0,0 +1,1226 @@ +execve("./io_socket_get", ["./io_socket_get"], [/* 44 vars */]) = 0 +brk(0) = 0x9865000 +access("/etc/ld.so.nohwcap", F_OK) = -1 ENOENT (No such file or directory) +mmap2(NULL, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7888000 +access("/etc/ld.so.preload", R_OK) = -1 ENOENT (No such file or directory) +open("/etc/ld.so.cache", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=70776, ...}) = 0 +mmap2(NULL, 70776, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7876000 +close(3) = 0 +access("/etc/ld.so.nohwcap", F_OK) = -1 ENOENT (No such file or directory) +open("/lib/tls/i686/cmov/libdl.so.2", O_RDONLY) = 3 +read(3, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0 \n\0\0004\0\0\0D"..., 512) = 512 +fstat64(3, {st_mode=S_IFREG|0644, st_size=9676, ...}) = 0 +mmap2(NULL, 12408, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 3, 0) = 0xb7872000 +mmap2(0xb7874000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 3, 0x1) = 0xb7874000 +close(3) = 0 +access("/etc/ld.so.nohwcap", F_OK) = -1 ENOENT (No such file or directory) +open("/lib/tls/i686/cmov/libm.so.6", O_RDONLY) = 3 +read(3, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0@4\0\0004\0\0\0P"..., 512) = 512 +fstat64(3, {st_mode=S_IFREG|0644, st_size=149328, ...}) = 0 +mmap2(NULL, 151680, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 3, 0) = 0xb784c000 +mmap2(0xb7870000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 3, 0x23) = 0xb7870000 +close(3) = 0 +access("/etc/ld.so.nohwcap", F_OK) = -1 ENOENT (No such file or directory) +open("/lib/tls/i686/cmov/libpthread.so.0", O_RDONLY) = 3 +read(3, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0000H\0\0004\0\0\0\330"..., 512) = 512 +fstat64(3, {st_mode=S_IFREG|0755, st_size=116405, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb784b000 +mmap2(NULL, 98780, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 3, 0) = 0xb7832000 +mmap2(0xb7847000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 3, 0x14) = 0xb7847000 +mmap2(0xb7849000, 4572, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_ANONYMOUS, -1, 0) = 0xb7849000 +close(3) = 0 +access("/etc/ld.so.nohwcap", F_OK) = -1 ENOENT (No such file or directory) +open("/lib/tls/i686/cmov/libc.so.6", O_RDONLY) = 3 +read(3, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\320h\1\0004\0\0\0\344"..., 512) = 512 +fstat64(3, {st_mode=S_IFREG|0755, st_size=1442180, ...}) = 0 +mmap2(NULL, 1451632, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 3, 0) = 0xb76cf000 +mprotect(0xb782b000, 4096, PROT_NONE) = 0 +mmap2(0xb782c000, 12288, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 3, 0x15c) = 0xb782c000 +mmap2(0xb782f000, 9840, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_ANONYMOUS, -1, 0) = 0xb782f000 +close(3) = 0 +access("/etc/ld.so.nohwcap", F_OK) = -1 ENOENT (No such file or directory) +open("/lib/tls/i686/cmov/libcrypt.so.1", O_RDONLY) = 3 +read(3, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0 \7\0\0004\0\0\0008"..., 512) = 512 +fstat64(3, {st_mode=S_IFREG|0644, st_size=38296, ...}) = 0 +mmap2(NULL, 201052, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 3, 0) = 0xb769d000 +mmap2(0xb76a6000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 3, 0x8) = 0xb76a6000 +mmap2(0xb76a8000, 155996, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_ANONYMOUS, -1, 0) = 0xb76a8000 +close(3) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb769c000 +set_thread_area({entry_number:-1 -> 6, base_addr:0xb769c8d0, limit:1048575, seg_32bit:1, contents:0, read_exec_only:0, limit_in_pages:1, seg_not_present:0, useable:1}) = 0 +open("/dev/urandom", O_RDONLY) = 3 +read(3, "\323H$"..., 3) = 3 +close(3) = 0 +mprotect(0xb76a6000, 4096, PROT_READ) = 0 +mprotect(0xb782c000, 8192, PROT_READ) = 0 +mprotect(0xb7847000, 4096, PROT_READ) = 0 +mprotect(0xb7870000, 4096, PROT_READ) = 0 +mprotect(0xb7874000, 4096, PROT_READ) = 0 +mprotect(0x817c000, 4096, PROT_READ) = 0 +mprotect(0xb78a7000, 4096, PROT_READ) = 0 +munmap(0xb7876000, 70776) = 0 +set_tid_address(0xb769c918) = 11827 +set_robust_list(0xb769c920, 0xc) = 0 +futex(0xbfef7c10, FUTEX_WAKE_PRIVATE, 1) = 0 +rt_sigaction(SIGRTMIN, {0xb78362e0, [], SA_SIGINFO}, NULL, 8) = 0 +rt_sigaction(SIGRT_1, {0xb7836720, [], SA_RESTART|SA_SIGINFO}, NULL, 8) = 0 +rt_sigprocmask(SIG_UNBLOCK, [RTMIN RT_1], NULL, 8) = 0 +getrlimit(RLIMIT_STACK, {rlim_cur=8192*1024, rlim_max=RLIM_INFINITY}) = 0 +uname({sys="Linux", node="petite", ...}) = 0 +rt_sigaction(SIGFPE, {SIG_IGN}, {SIG_DFL}, 8) = 0 +brk(0) = 0x9865000 +brk(0x9886000) = 0x9886000 +getuid32() = 1000 +geteuid32() = 1000 +getgid32() = 1000 +getegid32() = 1000 +open("/usr/lib/locale/locale-archive", O_RDONLY|O_LARGEFILE) = -1 ENOENT (No such file or directory) +open("/usr/share/locale/locale.alias", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=2570, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7887000 +read(3, "# Locale name alias data base.\n# "..., 4096) = 2570 +read(3, ""..., 4096) = 0 +close(3) = 0 +munmap(0xb7887000, 4096) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_IDENTIFICATION", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_IDENTIFICATION", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=311, ...}) = 0 +mmap2(NULL, 311, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7887000 +close(3) = 0 +open("/usr/lib/gconv/gconv-modules.cache", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=26048, ...}) = 0 +mmap2(NULL, 26048, PROT_READ, MAP_SHARED, 3, 0) = 0xb7880000 +close(3) = 0 +futex(0xb782ea4c, FUTEX_WAKE_PRIVATE, 2147483647) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_MEASUREMENT", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_MEASUREMENT", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=23, ...}) = 0 +mmap2(NULL, 23, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb787f000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_TELEPHONE", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_TELEPHONE", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=56, ...}) = 0 +mmap2(NULL, 56, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb787e000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_ADDRESS", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_ADDRESS", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=153, ...}) = 0 +mmap2(NULL, 153, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb787d000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_NAME", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_NAME", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=71, ...}) = 0 +mmap2(NULL, 71, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb787c000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_PAPER", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_PAPER", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=34, ...}) = 0 +mmap2(NULL, 34, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb787b000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_MESSAGES", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_MESSAGES", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFDIR|0755, st_size=4096, ...}) = 0 +close(3) = 0 +open("/usr/lib/locale/fr_FR.utf8/LC_MESSAGES/SYS_LC_MESSAGES", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=54, ...}) = 0 +mmap2(NULL, 54, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb787a000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_MONETARY", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_MONETARY", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=290, ...}) = 0 +mmap2(NULL, 290, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7879000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_COLLATE", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_COLLATE", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=962094, ...}) = 0 +mmap2(NULL, 962094, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb75b1000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_TIME", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_TIME", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=2502, ...}) = 0 +mmap2(NULL, 2502, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7878000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_NUMERIC", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_NUMERIC", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=54, ...}) = 0 +mmap2(NULL, 54, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7877000 +close(3) = 0 +open("/usr/lib/locale/fr_FR.UTF-8/LC_CTYPE", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/lib/locale/fr_FR.utf8/LC_CTYPE", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=256316, ...}) = 0 +mmap2(NULL, 256316, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7572000 +close(3) = 0 +open("/dev/urandom", O_RDONLY|O_LARGEFILE) = 3 +read(3, "\5\20B\314"..., 4) = 4 +close(3) = 0 +time(NULL) = 1294544755 +readlink("/proc/self/exe", "/usr/bin/perl"..., 4095) = 13 +stat64("/usr/local/lib/site_perl/5.10.0/i486-linux-gnu-thread-multi", 0xbfef79a0) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/site_perl/5.10.0", 0xbfef79a0) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/site_perl/i486-linux-gnu-thread-multi", 0xbfef79a0) = -1 ENOENT (No such file or directory) +ioctl(0, SNDCTL_TMR_TIMEBASE or TCGETS, {B38400 opost isig icanon echo ...}) = 0 +_llseek(0, 0, 0xbfef7810, SEEK_CUR) = -1 ESPIPE (Illegal seek) +ioctl(1, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef77c8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(1, 0, [10770], SEEK_CUR) = 0 +ioctl(2, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef77c8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(2, 0, [10911], SEEK_CUR) = 0 +open("./io_socket_get", O_RDONLY|O_LARGEFILE) = 3 +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7898) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(3, 0, [0], SEEK_CUR) = 0 +fcntl64(3, F_SETFD, FD_CLOEXEC) = 0 +fstat64(3, {st_mode=S_IFREG|0755, st_size=2164, ...}) = 0 +rt_sigaction(SIGCHLD, NULL, {SIG_DFL}, 8) = 0 +brk(0x98a7000) = 0x98a7000 +read(3, "#!/usr/bin/perl\n\nuse warnings;\nus"..., 4096) = 2164 +stat64("/etc/perl/warnings.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/warnings.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/warnings.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/warnings.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/warnings.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/warnings.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/warnings.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/warnings.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/warnings.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/warnings.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/warnings.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/warnings.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/warnings.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/warnings.pm", {st_mode=S_IFREG|0644, st_size=13272, ...}) = 0 +open("/usr/share/perl/5.10/warnings.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "# -*- buffer-read-only: t -*-\n# !"..., 4096) = 4096 +read(4, "00\\x10\\x00\\x00\", # [38]\n 'seve"..., 4096) = 4096 +read(4, "00\\x08\\x00\", # [41]\n 'unopened"..., 4096) = 4096 +read(4, "\n return vec($callers_bitmask,"..., 4096) = 984 +read(4, ""..., 4096) = 0 +close(4) = 0 +brk(0x98c8000) = 0x98c8000 +stat64("/etc/perl/strict.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/strict.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/strict.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/strict.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/strict.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/strict.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/strict.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/strict.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/strict.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/strict.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/strict.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/strict.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/strict.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/strict.pm", {st_mode=S_IFREG|0644, st_size=879, ...}) = 0 +open("/usr/share/perl/5.10/strict.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "package strict;\n\n$strict::VERSION"..., 4096) = 879 +_llseek(4, 878, [878], SEEK_SET) = 0 +_llseek(4, 0, [878], SEEK_CUR) = 0 +close(4) = 0 +stat64("/etc/perl/IO/Socket.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Socket.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Socket.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Socket.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Socket.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Socket.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Socket.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Socket.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Socket.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Socket.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Socket.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Socket.pm", {st_mode=S_IFREG|0644, st_size=8370, ...}) = 0 +open("/usr/lib/perl/5.10/IO/Socket.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "# IO::Socket.pm\n#\n# Copyright (c)"..., 4096) = 4096 +stat64("/etc/perl/IO/Handle.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Handle.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Handle.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Handle.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Handle.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Handle.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Handle.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Handle.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Handle.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Handle.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Handle.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Handle.pm", {st_mode=S_IFREG|0644, st_size=7718, ...}) = 0 +open("/usr/lib/perl/5.10/IO/Handle.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package IO::Handle;\n\nuse 5.006_00"..., 4096) = 4096 +stat64("/etc/perl/Carp.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Carp.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Carp.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Carp.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Carp.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Carp.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Carp.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Carp.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Carp.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Carp.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Carp.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Carp.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Carp.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Carp.pm", {st_mode=S_IFREG|0644, st_size=1459, ...}) = 0 +open("/usr/share/perl/5.10/Carp.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "package Carp;\n\nour $VERSION = '1."..., 4096) = 1459 +_llseek(6, 1458, [1458], SEEK_SET) = 0 +_llseek(6, 0, [1458], SEEK_CUR) = 0 +close(6) = 0 +stat64("/etc/perl/Exporter.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Exporter.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Exporter.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Exporter.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Exporter.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Exporter.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Exporter.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Exporter.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Exporter.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Exporter.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Exporter.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Exporter.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Exporter.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Exporter.pm", {st_mode=S_IFREG|0644, st_size=2280, ...}) = 0 +open("/usr/share/perl/5.10/Exporter.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "package Exporter;\n\nrequire 5.006;"..., 4096) = 2280 +_llseek(6, 2279, [2279], SEEK_SET) = 0 +_llseek(6, 0, [2279], SEEK_CUR) = 0 +close(6) = 0 +stat64("/etc/perl/Symbol.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Symbol.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Symbol.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Symbol.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Symbol.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Symbol.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Symbol.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Symbol.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Symbol.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Symbol.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Symbol.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Symbol.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Symbol.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Symbol.pm", {st_mode=S_IFREG|0644, st_size=2099, ...}) = 0 +open("/usr/share/perl/5.10/Symbol.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "package Symbol;\n\nBEGIN { require "..., 4096) = 2099 +read(6, ""..., 4096) = 0 +close(6) = 0 +stat64("/etc/perl/SelectSaver.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/SelectSaver.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/SelectSaver.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/SelectSaver.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/SelectSaver.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/SelectSaver.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/SelectSaver.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/SelectSaver.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/SelectSaver.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/SelectSaver.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/SelectSaver.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/SelectSaver.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/SelectSaver.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/SelectSaver.pm", {st_mode=S_IFREG|0644, st_size=340, ...}) = 0 +open("/usr/share/perl/5.10/SelectSaver.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "package SelectSaver;\n\nour $VERSIO"..., 4096) = 340 +read(6, ""..., 4096) = 0 +close(6) = 0 +stat64("/etc/perl/IO.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO.pm", {st_mode=S_IFREG|0644, st_size=416, ...}) = 0 +open("/usr/lib/perl/5.10/IO.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "#\n\npackage IO;\n\nuse XSLoader ();\n"..., 4096) = 416 +stat64("/etc/perl/XSLoader.pmc", 0xbfef680c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/XSLoader.pm", 0xbfef6784) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/XSLoader.pmc", 0xbfef680c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/XSLoader.pm", 0xbfef6784) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/XSLoader.pmc", 0xbfef680c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/XSLoader.pm", 0xbfef6784) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/XSLoader.pmc", 0xbfef680c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/XSLoader.pm", 0xbfef6784) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/XSLoader.pmc", 0xbfef680c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/XSLoader.pm", 0xbfef6784) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/XSLoader.pmc", 0xbfef680c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/XSLoader.pm", {st_mode=S_IFREG|0644, st_size=3293, ...}) = 0 +open("/usr/lib/perl/5.10/XSLoader.pm", O_RDONLY|O_LARGEFILE) = 7 +ioctl(7, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6598) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(7, 0, [0], SEEK_CUR) = 0 +read(7, "# Generated from XSLoader.pm.PL ("..., 4096) = 3293 +brk(0x98e9000) = 0x98e9000 +_llseek(7, 3292, [3292], SEEK_SET) = 0 +_llseek(7, 0, [3292], SEEK_CUR) = 0 +close(7) = 0 +_llseek(6, 415, [415], SEEK_SET) = 0 +_llseek(6, 0, [415], SEEK_CUR) = 0 +close(6) = 0 +stat64("/usr/lib/perl/5.10/auto/IO/IO.so", {st_mode=S_IFREG|0644, st_size=17812, ...}) = 0 +stat64("/usr/lib/perl/5.10/auto/IO/IO.bs", 0x98650c0) = -1 ENOENT (No such file or directory) +futex(0xb787506c, FUTEX_WAKE_PRIVATE, 2147483647) = 0 +open("/usr/lib/perl/5.10/auto/IO/IO.so", O_RDONLY) = 6 +read(6, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\220\24\0\0004\0\0\0\254"..., 512) = 512 +fstat64(6, {st_mode=S_IFREG|0644, st_size=17812, ...}) = 0 +mmap2(NULL, 20716, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 6, 0) = 0xb756c000 +mmap2(0xb7570000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 6, 0x3) = 0xb7570000 +close(6) = 0 +mprotect(0xb7570000, 4096, PROT_READ) = 0 +read(5, ", $_[1], $_[2], $_[3] || 0);\n "..., 4096) = 3622 +read(5, ""..., 4096) = 0 +close(5) = 0 +stat64("/etc/perl/Socket.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Socket.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Socket.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Socket.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Socket.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Socket.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Socket.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Socket.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Socket.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Socket.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Socket.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Socket.pm", {st_mode=S_IFREG|0644, st_size=3697, ...}) = 0 +open("/usr/lib/perl/5.10/Socket.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package Socket;\n\nour($VERSION, @I"..., 4096) = 3697 +stat64("/etc/perl/warnings/register.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/warnings/register.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/warnings/register.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/warnings/register.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/warnings/register.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/warnings/register.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/warnings/register.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/warnings/register.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/warnings/register.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/warnings/register.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/warnings/register.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/warnings/register.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/warnings/register.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/warnings/register.pm", {st_mode=S_IFREG|0644, st_size=732, ...}) = 0 +open("/usr/share/perl/5.10/warnings/register.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +brk(0x990a000) = 0x990a000 +read(6, "package warnings::register;\n\nour "..., 4096) = 732 +read(6, ""..., 4096) = 0 +close(6) = 0 +read(5, ""..., 4096) = 0 +close(5) = 0 +stat64("/usr/lib/perl/5.10/auto/Socket/Socket.so", {st_mode=S_IFREG|0644, st_size=21940, ...}) = 0 +stat64("/usr/lib/perl/5.10/auto/Socket/Socket.bs", 0x98650c0) = -1 ENOENT (No such file or directory) +open("/usr/lib/perl/5.10/auto/Socket/Socket.so", O_RDONLY) = 5 +read(5, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\260\26\0\0004\0\0\0\244"..., 512) = 512 +fstat64(5, {st_mode=S_IFREG|0644, st_size=21940, ...}) = 0 +mmap2(NULL, 20692, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 5, 0) = 0xb7566000 +mmap2(0xb756a000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 5, 0x4) = 0xb756a000 +close(5) = 0 +mprotect(0xb756a000, 4096, PROT_READ) = 0 +stat64("/etc/perl/Errno.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Errno.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Errno.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Errno.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Errno.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Errno.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Errno.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Errno.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Errno.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Errno.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Errno.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Errno.pm", {st_mode=S_IFREG|0644, st_size=5964, ...}) = 0 +open("/usr/lib/perl/5.10/Errno.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "#\n# This file is auto-generated. "..., 4096) = 4096 +brk(0x992b000) = 0x992b000 +read(5, "3 }\nsub ESOCKTNOSUPPORT () { 94 }"..., 4096) = 1868 +_llseek(5, 5963, [5963], SEEK_SET) = 0 +_llseek(5, 0, [5963], SEEK_CUR) = 0 +close(5) = 0 +read(4, " set blocking behaviour.\n\n # N"..., 4096) = 4096 +read(4, "= shift;\n ${*$sock}{'io_socket"..., 4096) = 178 +_llseek(4, 8369, [8369], SEEK_SET) = 0 +_llseek(4, 0, [8369], SEEK_CUR) = 0 +close(4) = 0 +stat64("/etc/perl/IO/Socket/INET.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Socket/INET.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Socket/INET.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Socket/INET.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Socket/INET.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Socket/INET.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Socket/INET.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Socket/INET.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Socket/INET.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Socket/INET.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Socket/INET.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Socket/INET.pm", {st_mode=S_IFREG|0644, st_size=7456, ...}) = 0 +open("/usr/lib/perl/5.10/IO/Socket/INET.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "# IO::Socket::INET.pm\n#\n# Copyrig"..., 4096) = 4096 +stat64("/etc/perl/Exporter/Heavy.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Exporter/Heavy.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Exporter/Heavy.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Exporter/Heavy.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Exporter/Heavy.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Exporter/Heavy.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Exporter/Heavy.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Exporter/Heavy.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Exporter/Heavy.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Exporter/Heavy.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Exporter/Heavy.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Exporter/Heavy.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Exporter/Heavy.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Exporter/Heavy.pm", {st_mode=S_IFREG|0644, st_size=6335, ...}) = 0 +open("/usr/share/perl/5.10/Exporter/Heavy.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +brk(0x994c000) = 0x994c000 +read(5, "package Exporter::Heavy;\n\nuse str"..., 4096) = 4096 +read(5, "a leading &.\n\t # (Technique co"..., 4096) = 2239 +read(5, ""..., 4096) = 0 +close(5) = 0 +brk(0x996d000) = 0x996d000 +read(4, "hostname '\",$arg->{PeerAddr},\"'\")"..., 4096) = 3360 +_llseek(4, 7455, [7455], SEEK_SET) = 0 +_llseek(4, 0, [7455], SEEK_CUR) = 0 +close(4) = 0 +stat64("/etc/perl/IO/Socket/UNIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Socket/UNIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Socket/UNIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Socket/UNIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Socket/UNIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Socket/UNIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Socket/UNIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Socket/UNIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Socket/UNIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Socket/UNIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Socket/UNIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Socket/UNIX.pm", {st_mode=S_IFREG|0644, st_size=1375, ...}) = 0 +open("/usr/lib/perl/5.10/IO/Socket/UNIX.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "# IO::Socket::UNIX.pm\n#\n# Copyrig"..., 4096) = 1375 +_llseek(4, 1374, [1374], SEEK_SET) = 0 +_llseek(4, 0, [1374], SEEK_CUR) = 0 +close(4) = 0 +stat64("/etc/perl/English.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/English.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/English.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/English.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/English.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/English.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/English.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/English.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/English.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/English.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/English.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/English.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/English.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/English.pm", {st_mode=S_IFREG|0644, st_size=4488, ...}) = 0 +open("/usr/share/perl/5.10/English.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "package English;\n\nour $VERSION = "..., 4096) = 4096 +stat64("/etc/perl/Tie/Hash/NamedCapture.pmc", 0xbfef694c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Tie/Hash/NamedCapture.pm", 0xbfef68c4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Tie/Hash/NamedCapture.pmc", 0xbfef694c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Tie/Hash/NamedCapture.pm", 0xbfef68c4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Tie/Hash/NamedCapture.pmc", 0xbfef694c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Tie/Hash/NamedCapture.pm", 0xbfef68c4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Tie/Hash/NamedCapture.pmc", 0xbfef694c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Tie/Hash/NamedCapture.pm", 0xbfef68c4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Tie/Hash/NamedCapture.pmc", 0xbfef694c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Tie/Hash/NamedCapture.pm", 0xbfef68c4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Tie/Hash/NamedCapture.pmc", 0xbfef694c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Tie/Hash/NamedCapture.pm", 0xbfef68c4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Tie/Hash/NamedCapture.pmc", 0xbfef694c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Tie/Hash/NamedCapture.pm", {st_mode=S_IFREG|0644, st_size=1861, ...}) = 0 +open("/usr/share/perl/5.10/Tie/Hash/NamedCapture.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef66d8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package Tie::Hash::NamedCapture;\n"..., 4096) = 1861 +_llseek(5, 482, [482], SEEK_SET) = 0 +_llseek(5, 0, [482], SEEK_CUR) = 0 +close(5) = 0 +read(4, "ULATOR\t\t\t\t= *^A\t;\n\t*COMPILING\t\t\t\t"..., 4096) = 392 +brk(0x998e000) = 0x998e000 +read(4, ""..., 4096) = 0 +close(4) = 0 +stat64("/etc/perl/POSIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/POSIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/POSIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/POSIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/POSIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/POSIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/POSIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/POSIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/POSIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/POSIX.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/POSIX.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/POSIX.pm", {st_mode=S_IFREG|0644, st_size=2057, ...}) = 0 +open("/usr/lib/perl/5.10/POSIX.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "package POSIX;\nuse strict;\nuse wa"..., 4096) = 2057 +stat64("/etc/perl/AutoLoader.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/AutoLoader.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/AutoLoader.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/AutoLoader.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/AutoLoader.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/AutoLoader.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/AutoLoader.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/AutoLoader.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/AutoLoader.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/AutoLoader.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/AutoLoader.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/AutoLoader.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/AutoLoader.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/AutoLoader.pm", {st_mode=S_IFREG|0644, st_size=5638, ...}) = 0 +open("/usr/share/perl/5.10/AutoLoader.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package AutoLoader;\n\nuse strict;\n"..., 4096) = 4096 +read(5, "^&?AUTOLOAD$/ ) {\n\t no strict "..., 4096) = 1542 +_llseek(5, 5637, [5637], SEEK_SET) = 0 +_llseek(5, 0, [5637], SEEK_CUR) = 0 +close(5) = 0 +stat64("/usr/lib/perl/5.10/auto/POSIX/autosplit.ix", {st_mode=S_IFREG|0644, st_size=2463, ...}) = 0 +open("/usr/lib/perl/5.10/auto/POSIX/autosplit.ix", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "# Index created by AutoSplit for "..., 4096) = 2463 +read(5, ""..., 4096) = 0 +close(5) = 0 +stat64("/etc/perl/Fcntl.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Fcntl.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Fcntl.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Fcntl.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Fcntl.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Fcntl.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Fcntl.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Fcntl.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Fcntl.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Fcntl.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Fcntl.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Fcntl.pm", {st_mode=S_IFREG|0644, st_size=3557, ...}) = 0 +open("/usr/lib/perl/5.10/Fcntl.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package Fcntl;\n\nuse strict;\nour($"..., 4096) = 3557 +stat64("/usr/lib/perl/5.10/auto/Fcntl/Fcntl.so", {st_mode=S_IFREG|0644, st_size=13680, ...}) = 0 +stat64("/usr/lib/perl/5.10/auto/Fcntl/Fcntl.bs", 0x98650c0) = -1 ENOENT (No such file or directory) +open("/usr/lib/perl/5.10/auto/Fcntl/Fcntl.so", O_RDONLY) = 6 +read(6, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\300\17\0\0004\0\0\0`"..., 512) = 512 +fstat64(6, {st_mode=S_IFREG|0644, st_size=13680, ...}) = 0 +mmap2(NULL, 16528, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 6, 0) = 0xb7561000 +mmap2(0xb7564000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 6, 0x2) = 0xb7564000 +close(6) = 0 +mprotect(0xb7564000, 4096, PROT_READ) = 0 +read(5, ""..., 4096) = 0 +close(5) = 0 +stat64("/etc/perl/Tie/Hash.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Tie/Hash.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Tie/Hash.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Tie/Hash.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Tie/Hash.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Tie/Hash.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Tie/Hash.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Tie/Hash.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Tie/Hash.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Tie/Hash.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Tie/Hash.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Tie/Hash.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Tie/Hash.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/Tie/Hash.pm", {st_mode=S_IFREG|0644, st_size=1722, ...}) = 0 +open("/usr/share/perl/5.10/Tie/Hash.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +brk(0x99af000) = 0x99af000 +read(5, "package Tie::Hash;\n\nour $VERSION "..., 4096) = 1722 +read(5, ""..., 4096) = 0 +close(5) = 0 +stat64("/etc/perl/vars.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/vars.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/vars.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/vars.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/vars.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/vars.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/vars.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/vars.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/vars.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/vars.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/vars.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/vars.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/vars.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/vars.pm", {st_mode=S_IFREG|0644, st_size=1149, ...}) = 0 +open("/usr/share/perl/5.10/vars.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package vars;\n\nuse 5.006;\n\nour $V"..., 4096) = 1149 +_llseek(5, 1148, [1148], SEEK_SET) = 0 +_llseek(5, 0, [1148], SEEK_CUR) = 0 +close(5) = 0 +read(4, ""..., 4096) = 0 +close(4) = 0 +stat64("/usr/lib/perl/5.10/auto/POSIX/POSIX.so", {st_mode=S_IFREG|0644, st_size=108480, ...}) = 0 +stat64("/usr/lib/perl/5.10/auto/POSIX/POSIX.bs", 0x98650c0) = -1 ENOENT (No such file or directory) +open("/usr/lib/perl/5.10/auto/POSIX/POSIX.so", O_RDONLY) = 4 +read(4, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0@Q\0\0004\0\0\0\260"..., 512) = 512 +fstat64(4, {st_mode=S_IFREG|0644, st_size=108480, ...}) = 0 +mmap2(NULL, 111328, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 4, 0) = 0xb7545000 +mmap2(0xb755e000, 12288, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 4, 0x18) = 0xb755e000 +close(4) = 0 +mprotect(0xb755e000, 8192, PROT_READ) = 0 +stat64("/usr/lib/perl/5.10/auto/POSIX/load_imports.al", {st_mode=S_IFREG|0644, st_size=6878, ...}) = 0 +getgroups32(0, NULL) = 12 +getgroups32(12, [4, 6, 20, 24, 33, 46, 106, 121, 122, 129, 1000, 1003]) = 12 +open("/usr/share/locale/fr_FR.UTF-8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale/fr_FR.utf8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale/fr_FR/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale/fr.UTF-8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale/fr.utf8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale/fr/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale-langpack/fr_FR.UTF-8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale-langpack/fr_FR.utf8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale-langpack/fr_FR/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale-langpack/fr.UTF-8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale-langpack/fr.utf8/LC_MESSAGES/libc.mo", O_RDONLY) = -1 ENOENT (No such file or directory) +open("/usr/share/locale-langpack/fr/LC_MESSAGES/libc.mo", O_RDONLY) = 4 +fstat64(4, {st_mode=S_IFREG|0644, st_size=137860, ...}) = 0 +mmap2(NULL, 137860, PROT_READ, MAP_PRIVATE, 4, 0) = 0xb7523000 +close(4) = 0 +stat64("/usr/lib/perl/5.10/auto/POSIX/load_imports.al", {st_mode=S_IFREG|0644, st_size=6878, ...}) = 0 +open("/usr/lib/perl/5.10/auto/POSIX/load_imports.al", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "# NOTE: Derived from ../../lib/PO"..., 4096) = 4096 +brk(0x99d0000) = 0x99d0000 +read(4, "trspn strstr\n\t\tstrtok strxfrm)],\n"..., 4096) = 2782 +read(4, ""..., 4096) = 0 +close(4) = 0 +stat64("/etc/perl/lib.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/lib.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/lib.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/lib.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/lib.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/lib.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/lib.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/lib.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/lib.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/lib.pm", 0xbfef7534) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/lib.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/lib.pm", {st_mode=S_IFREG|0644, st_size=3111, ...}) = 0 +open("/usr/lib/perl/5.10/lib.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +brk(0x99f1000) = 0x99f1000 +read(4, "package lib;\n\n# THIS FILE IS AUTO"..., 4096) = 3111 +stat64("/etc/perl/Config.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/Config.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Config.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/Config.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Config.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/Config.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Config.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/Config.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Config.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/Config.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Config.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/Config.pm", {st_mode=S_IFREG|0644, st_size=2553, ...}) = 0 +open("/usr/lib/perl/5.10/Config.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "# This file was created by config"..., 4096) = 2553 +read(5, ""..., 4096) = 0 +close(5) = 0 +_llseek(4, 3110, [3110], SEEK_SET) = 0 +_llseek(4, 0, [3110], SEEK_CUR) = 0 +close(4) = 0 +stat64("../Mail-IMAPClient-3.25/lib", {st_mode=S_IFDIR|0755, st_size=4096, ...}) = 0 +stat64("../Mail-IMAPClient-3.25/lib/i486-linux-gnu-thread-multi/auto", 0x98650c0) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/5.10.0", 0x98650c0) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/5.10.0/i486-linux-gnu-thread-multi", 0x98650c0) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pmc", 0xbfef75bc) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pm", {st_mode=S_IFREG|0644, st_size=102353, ...}) = 0 +open("../Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pm", O_RDONLY|O_LARGEFILE) = 4 +ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7348) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(4, 0, [0], SEEK_CUR) = 0 +read(4, "\n# _{name} methods are undocument"..., 4096) = 4096 +stat64("../Mail-IMAPClient-3.25/lib/Mail/IMAPClient/MessageSet.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/Mail/IMAPClient/MessageSet.pm", {st_mode=S_IFREG|0444, st_size=9027, ...}) = 0 +open("../Mail-IMAPClient-3.25/lib/Mail/IMAPClient/MessageSet.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "use warnings;\nuse strict;\n\npackag"..., 4096) = 4096 +stat64("../Mail-IMAPClient-3.25/lib/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/overload.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/overload.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/overload.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/overload.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/overload.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/overload.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/overload.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/overload.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/overload.pm", {st_mode=S_IFREG|0644, st_size=4355, ...}) = 0 +open("/usr/share/perl/5.10/overload.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "package overload;\n\nour $VERSION ="..., 4096) = 4096 +read(6, " else {\n $^H{$_[0]} = $"..., 4096) = 259 +_llseek(6, 4354, [4354], SEEK_SET) = 0 +_llseek(6, 0, [4354], SEEK_CUR) = 0 +close(6) = 0 +brk(0x9a12000) = 0x9a12000 +read(5, "ll numbered sequentially. Delimit"..., 4096) = 4096 +read(5, "hether it was already like that o"..., 4096) = 835 +read(5, ""..., 4096) = 0 +close(5) = 0 +stat64("../Mail-IMAPClient-3.25/lib/IO/Select.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/IO/Select.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Select.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Select.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Select.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Select.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Select.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Select.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Select.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Select.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Select.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Select.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Select.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Select.pm", {st_mode=S_IFREG|0644, st_size=4026, ...}) = 0 +open("/usr/lib/perl/5.10/IO/Select.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "# IO::Select.pm\n#\n# Copyright (c)"..., 4096) = 4026 +_llseek(5, 4025, [4025], SEEK_SET) = 0 +_llseek(5, 0, [4025], SEEK_CUR) = 0 +close(5) = 0 +stat64("../Mail-IMAPClient-3.25/lib/IO/File.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/IO/File.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/File.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/File.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/File.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/File.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/File.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/File.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/File.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/File.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/File.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/File.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/File.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/File.pm", {st_mode=S_IFREG|0644, st_size=1680, ...}) = 0 +open("/usr/lib/perl/5.10/IO/File.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "#\n\npackage IO::File;\n\nuse 5.006_0"..., 4096) = 1680 +stat64("../Mail-IMAPClient-3.25/lib/IO/Seekable.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/IO/Seekable.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Seekable.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/IO/Seekable.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Seekable.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/IO/Seekable.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Seekable.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/IO/Seekable.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Seekable.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/IO/Seekable.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Seekable.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/IO/Seekable.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Seekable.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/IO/Seekable.pm", {st_mode=S_IFREG|0644, st_size=686, ...}) = 0 +open("/usr/lib/perl/5.10/IO/Seekable.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "#\n\npackage IO::Seekable;\n\nuse 5.0"..., 4096) = 686 +read(6, ""..., 4096) = 0 +close(6) = 0 +stat64("../Mail-IMAPClient-3.25/lib/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/File/Spec.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/File/Spec.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/File/Spec.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/File/Spec.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/File/Spec.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/File/Spec.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/File/Spec.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/File/Spec.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/File/Spec.pm", {st_mode=S_IFREG|0644, st_size=597, ...}) = 0 +open("/usr/share/perl/5.10/File/Spec.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "package File::Spec;\n\nuse strict;\n"..., 4096) = 597 +_llseek(6, 596, [596], SEEK_SET) = 0 +_llseek(6, 0, [596], SEEK_CUR) = 0 +close(6) = 0 +stat64("../Mail-IMAPClient-3.25/lib/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/File/Spec/Unix.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/File/Spec/Unix.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/File/Spec/Unix.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/File/Spec/Unix.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/File/Spec/Unix.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/File/Spec/Unix.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/File/Spec/Unix.pm", 0xbfef6c14) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/File/Spec/Unix.pmc", 0xbfef6c9c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/File/Spec/Unix.pm", {st_mode=S_IFREG|0644, st_size=7428, ...}) = 0 +open("/usr/share/perl/5.10/File/Spec/Unix.pm", O_RDONLY|O_LARGEFILE) = 6 +ioctl(6, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6a28) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(6, 0, [0], SEEK_CUR) = 0 +read(6, "package File::Spec::Unix;\n\nuse st"..., 4096) = 4096 +brk(0x9a33000) = 0x9a33000 +read(6, "volume) = $self->splitpath($base,"..., 4096) = 3332 +read(6, ""..., 4096) = 0 +close(6) = 0 +read(5, ""..., 4096) = 0 +close(5) = 0 +stat64("../Mail-IMAPClient-3.25/lib/List/Util.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/List/Util.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/List/Util.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/List/Util.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/List/Util.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/List/Util.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/List/Util.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/List/Util.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/List/Util.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/List/Util.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/List/Util.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/List/Util.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/List/Util.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/List/Util.pm", {st_mode=S_IFREG|0644, st_size=1910, ...}) = 0 +open("/usr/lib/perl/5.10/List/Util.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "# List::Util.pm\n#\n# Copyright (c)"..., 4096) = 1910 +_llseek(5, 1909, [1909], SEEK_SET) = 0 +_llseek(5, 0, [1909], SEEK_CUR) = 0 +close(5) = 0 +stat64("/usr/lib/perl/5.10/auto/List/Util/Util.so", {st_mode=S_IFREG|0644, st_size=34316, ...}) = 0 +stat64("/usr/lib/perl/5.10/auto/List/Util/Util.bs", 0x98650c0) = -1 ENOENT (No such file or directory) +open("/usr/lib/perl/5.10/auto/List/Util/Util.so", O_RDONLY) = 5 +read(5, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0P\35\0\0004\0\0\0$"..., 512) = 512 +fstat64(5, {st_mode=S_IFREG|0644, st_size=34316, ...}) = 0 +mmap2(NULL, 37220, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 5, 0) = 0xb7519000 +mmap2(0xb7521000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 5, 0x7) = 0xb7521000 +close(5) = 0 +mprotect(0xb7521000, 4096, PROT_READ) = 0 +stat64("../Mail-IMAPClient-3.25/lib/MIME/Base64.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/MIME/Base64.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/MIME/Base64.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/MIME/Base64.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/MIME/Base64.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/MIME/Base64.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/MIME/Base64.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/MIME/Base64.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/MIME/Base64.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/MIME/Base64.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/MIME/Base64.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/MIME/Base64.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/MIME/Base64.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/MIME/Base64.pm", {st_mode=S_IFREG|0644, st_size=4911, ...}) = 0 +open("/usr/lib/perl/5.10/MIME/Base64.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package MIME::Base64;\n\n# $Id: Bas"..., 4096) = 4096 +_llseek(5, 363, [363], SEEK_SET) = 0 +_llseek(5, 0, [363], SEEK_CUR) = 0 +close(5) = 0 +stat64("/usr/lib/perl/5.10/auto/MIME/Base64/Base64.so", {st_mode=S_IFREG|0644, st_size=13620, ...}) = 0 +stat64("/usr/lib/perl/5.10/auto/MIME/Base64/Base64.bs", 0x98650c0) = -1 ENOENT (No such file or directory) +open("/usr/lib/perl/5.10/auto/MIME/Base64/Base64.so", O_RDONLY) = 5 +read(5, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\360\v\0\0004\0\0\0L"..., 512) = 512 +fstat64(5, {st_mode=S_IFREG|0644, st_size=13620, ...}) = 0 +mmap2(NULL, 16520, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 5, 0) = 0xb7514000 +mmap2(0xb7517000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 5, 0x2) = 0xb7517000 +close(5) = 0 +mprotect(0xb7517000, 4096, PROT_READ) = 0 +stat64("../Mail-IMAPClient-3.25/lib/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("../Mail-IMAPClient-3.25/lib/constant.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/constant.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/constant.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/constant.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/constant.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/constant.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/constant.pm", 0xbfef70a4) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/constant.pmc", 0xbfef712c) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/constant.pm", {st_mode=S_IFREG|0644, st_size=3586, ...}) = 0 +open("/usr/share/perl/5.10/constant.pm", O_RDONLY|O_LARGEFILE) = 5 +ioctl(5, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef6eb8) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(5, 0, [0], SEEK_CUR) = 0 +read(5, "package constant;\nuse 5.005;\nuse "..., 4096) = 3586 +_llseek(5, 3585, [3585], SEEK_SET) = 0 +_llseek(5, 0, [3585], SEEK_CUR) = 0 +close(5) = 0 +read(4, "$fcntl;\n $newflags |= O_NONBLO"..., 4096) = 4096 +brk(0x9a54000) = 0x9a54000 +read(4, "? $self->connect : $self;\n}\n\nsub "..., 4096) = 4096 +read(4, " $self;\n}\n\nsub noop {\n my ( $"..., 4096) = 4096 +read(4, "} = \\@folders unless $what;\n r"..., 4096) = 4096 +brk(0x9a75000) = 0x9a75000 +read(4, "ypart_string {\n my ( $self, $m"..., 4096) = 4096 +read(4, " # If msg size is less tha"..., 4096) = 4096 +read(4, "nless ( $self->_send_line($newstr"..., 4096) = 4096 +brk(0x9a96000) = 0x9a96000 +read(4, "g> OK [APPENDUID ] AP"..., 4096) = 4096 +read(4, "}\n } while $ret > 0;\n\n # se"..., 4096) = 4096 +read(4, " $self->Count( $self->Count + 1 )"..., 4096) = 4096 +brk(0x9ab7000) = 0x9ab7000 +read(4, "ount, $array ) = @_;\n if ( $ar"..., 4096) = 4096 +read(4, "\\$iBuffer, $readlen, length $iBuf"..., 4096) = 4096 +read(4, " # EOF: note IO::Soc"..., 4096) = 4096 +read(4, "trans ) = @_;\n my @a = $self->"..., 4096) = 4096 +brk(0x9ad8000) = 0x9ad8000 +read(4, "tput=$output\");\n }\n "..., 4096) = 4096 +read(4, "$uids = ref $_[-1] ? pop @_ : {}"..., 4096) = 4096 +read(4, "return wantarray ? $self->History"..., 4096) = 4096 +brk(0x9af9000) = 0x9af9000 +read(4, "fetch($string) or return undef;\n "..., 4096) = 4096 +read(4, " + 1900 );\n }\n else {\n "..., 4096) = 4096 +read(4, "} $self->History;\n defined $vl"..., 4096) = 4096 +brk(0x9b1a000) = 0x9b1a000 +read(4, " ? join( $CRLF, @_ ) : shift;\n\n "..., 4096) = 4096 +read(4, "savebuff : \"\";\n $buflen = "..., 4096) = 4096 +read(4, "herwise \" (OK|BAD|NO)\"\n u"..., 4096) = 4096 +brk(0x9b3b000) = 0x9b3b000 +read(4, ">LastError ) {\n my $info ="..., 4096) = 4049 +read(4, ""..., 4096) = 0 +close(4) = 0 +read(3, ""..., 4096) = 0 +close(3) = 0 +write(2, "Connecting via IO::Socket::INET t"..., 61Connecting via IO::Socket::INET to localhost:143 Timeout 600 +) = 61 +open("/etc/resolv.conf", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=52, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7876000 +read(3, "# Generated by NetworkManager\n#na"..., 4096) = 52 +read(3, ""..., 4096) = 0 +close(3) = 0 +munmap(0xb7876000, 4096) = 0 +uname({sys="Linux", node="petite", ...}) = 0 +stat64("/etc/resolv.conf", {st_mode=S_IFREG|0644, st_size=52, ...}) = 0 +open("/etc/resolv.conf", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=52, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7876000 +read(3, "# Generated by NetworkManager\n#na"..., 4096) = 52 +read(3, ""..., 4096) = 0 +close(3) = 0 +munmap(0xb7876000, 4096) = 0 +uname({sys="Linux", node="petite", ...}) = 0 +socket(PF_FILE, 0x80801 /* SOCK_??? */, 0) = 3 +connect(3, {sa_family=AF_FILE, path="/var/run/nscd/socket"...}, 110) = -1 ENOENT (No such file or directory) +close(3) = 0 +socket(PF_FILE, 0x80801 /* SOCK_??? */, 0) = 3 +connect(3, {sa_family=AF_FILE, path="/var/run/nscd/socket"...}, 110) = -1 ENOENT (No such file or directory) +close(3) = 0 +open("/etc/nsswitch.conf", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=513, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7876000 +read(3, "# /etc/nsswitch.conf\n#\n# Example "..., 4096) = 513 +read(3, ""..., 4096) = 0 +close(3) = 0 +munmap(0xb7876000, 4096) = 0 +open("/etc/ld.so.cache", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=70776, ...}) = 0 +mmap2(NULL, 70776, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7502000 +close(3) = 0 +access("/etc/ld.so.nohwcap", F_OK) = -1 ENOENT (No such file or directory) +open("/lib/tls/i686/cmov/libnss_files.so.2", O_RDONLY) = 3 +read(3, "\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\20\31\0\0004\0\0\0\250"..., 512) = 512 +fstat64(3, {st_mode=S_IFREG|0644, st_size=42504, ...}) = 0 +mmap2(NULL, 45720, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 3, 0) = 0xb74f6000 +mmap2(0xb7500000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 3, 0x9) = 0xb7500000 +close(3) = 0 +mprotect(0xb7500000, 4096, PROT_READ) = 0 +munmap(0xb7502000, 70776) = 0 +open("/etc/host.conf", O_RDONLY) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=92, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7876000 +read(3, "# The \"order\" line is only used b"..., 4096) = 92 +read(3, ""..., 4096) = 0 +close(3) = 0 +munmap(0xb7876000, 4096) = 0 +futex(0xb7830844, FUTEX_WAKE_PRIVATE, 2147483647) = 0 +open("/etc/hosts", O_RDONLY|O_CLOEXEC) = 3 +fcntl64(3, F_GETFD) = 0x1 (flags FD_CLOEXEC) +fstat64(3, {st_mode=S_IFREG|0644, st_size=519, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7876000 +read(3, "127.0.0.1\tpetite.lamiral.info pet"..., 4096) = 519 +read(3, ""..., 4096) = 0 +close(3) = 0 +munmap(0xb7876000, 4096) = 0 +socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) = 3 +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7908) = -1 EINVAL (Invalid argument) +_llseek(3, 0, 0xbfef7950, SEEK_CUR) = -1 ESPIPE (Illegal seek) +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7908) = -1 EINVAL (Invalid argument) +_llseek(3, 0, 0xbfef7950, SEEK_CUR) = -1 ESPIPE (Illegal seek) +fcntl64(3, F_SETFD, FD_CLOEXEC) = 0 +fcntl64(3, F_GETFL) = 0x2 (flags O_RDWR) +fcntl64(3, F_SETFL, O_RDWR|O_NONBLOCK) = 0 +connect(3, {sa_family=AF_INET, sin_port=htons(143), sin_addr=inet_addr("127.0.0.1")}, 16) = -1 EINPROGRESS (Operation now in progress) +select(8, NULL, [3], NULL, {600, 0}) = 1 (out [3], left {599, 999988}) +connect(3, {sa_family=AF_INET, sin_port=htons(143), sin_addr=inet_addr("127.0.0.1")}, 16) = 0 +fcntl64(3, F_GETFL) = 0x802 (flags O_RDWR|O_NONBLOCK) +fcntl64(3, F_SETFL, O_RDWR) = 0 +write(2, "Connected to localhost\n"..., 23Connected to localhost +) = 23 +fcntl64(3, F_GETFL) = 0x2 (flags O_RDWR) +fcntl64(3, F_SETFL, O_RDWR|O_NONBLOCK) = 0 +select(8, [3], NULL, [3], {600, 0}) = 1 (left {599, 999513}) +read(3, "* OK [CAPABILITY IMAP4rev1 UIDPLU"..., 4096) = 242 +write(2, "Read: \t* OK [CAPABILITY IMAP4rev1"..., 248Read: * OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA IDLE ACL ACL2=UNION STARTTLS] Courier-IMAP ready. Copyright 1998-2008 Double Precision, Inc. See COPYING for distribution information. +) = 248 +write(2, "Sending: 1 LOGOUT\n"..., 18Sending: 1 LOGOUT +) = 18 +rt_sigaction(SIGPIPE, NULL, {SIG_DFL}, 8) = 0 +rt_sigprocmask(SIG_BLOCK, [PIPE], [], 8) = 0 +rt_sigaction(SIGPIPE, {SIG_DFL}, {SIG_DFL}, 8) = 0 +rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0 +rt_sigprocmask(SIG_BLOCK, [PIPE], [], 8) = 0 +rt_sigaction(SIGPIPE, {SIG_IGN}, {SIG_DFL}, 8) = 0 +rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0 +write(3, "1 LOGOUT\r\n"..., 10) = 10 +write(2, "Sent 10 bytes\n"..., 14Sent 10 bytes +) = 14 +rt_sigprocmask(SIG_BLOCK, [PIPE], [], 8) = 0 +rt_sigaction(SIGPIPE, {SIG_DFL}, {SIG_IGN}, 8) = 0 +rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0 +select(8, [3], NULL, [3], {600, 0}) = 1 (left {599, 999988}) +read(3, "* BYE Courier-IMAP server shuttin"..., 4096) = 64 +write(2, "Read: \t* BYE Courier-IMAP server "..., 72Read: * BYE Courier-IMAP server shutting down + 1 OK LOGOUT completed +) = 72 +close(3) = 0 +stat64("../Mail-IMAPClient-3.25/lib/auto/POSIX/SigAction/new.al", 0xbfef7964) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/auto/POSIX/SigAction/new.al", 0xbfef7964) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/auto/POSIX/SigAction/new.al", 0xbfef7964) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/auto/POSIX/SigAction/new.al", 0xbfef7964) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/auto/POSIX/SigAction/new.al", 0xbfef7964) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/auto/POSIX/SigAction/new.al", 0xbfef7964) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/auto/POSIX/SigAction/new.al", {st_mode=S_IFREG|0644, st_size=388, ...}) = 0 +open("/usr/lib/perl/5.10/auto/POSIX/SigAction/new.al", O_RDONLY|O_LARGEFILE) = 3 +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7778) = -1 ENOTTY (Inappropriate ioctl for device) +_llseek(3, 0, [0], SEEK_CUR) = 0 +read(3, "# NOTE: Derived from ../../lib/PO"..., 4096) = 388 +brk(0x9b5c000) = 0x9b5c000 +read(3, ""..., 4096) = 0 +close(3) = 0 +rt_sigprocmask(SIG_BLOCK, ~[RTMIN RT_1], [], 8) = 0 +rt_sigprocmask(SIG_BLOCK, [ALRM], ~[KILL STOP RTMIN RT_1], 8) = 0 +rt_sigaction(SIGALRM, {0x809aa00, [], 0}, {SIG_DFL}, 8) = 0 +rt_sigprocmask(SIG_SETMASK, ~[KILL STOP RTMIN RT_1], NULL, 8) = 0 +rt_sigaction(SIGALRM, {0x809a220, [], 0}, NULL, 8) = 0 +rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0 +stat64("../Mail-IMAPClient-3.25/lib/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/etc/perl/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/perl/5.10.0/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/usr/local/share/perl/5.10.0/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl5/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl5/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/usr/lib/perl/5.10/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/usr/share/perl/5.10/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("/usr/local/lib/site_perl/auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +stat64("./auto/POSIX/SigAction/DESTROY.al", 0xbfef7744) = -1 ENOENT (No such file or directory) +alarm(3) = 0 +socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) = 3 +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7908) = -1 EINVAL (Invalid argument) +_llseek(3, 0, 0xbfef7950, SEEK_CUR) = -1 ESPIPE (Illegal seek) +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7908) = -1 EINVAL (Invalid argument) +_llseek(3, 0, 0xbfef7950, SEEK_CUR) = -1 ESPIPE (Illegal seek) +fcntl64(3, F_SETFD, FD_CLOEXEC) = 0 +connect(3, {sa_family=AF_INET, sin_port=htons(80), sin_addr=inet_addr("10.10.10.10")}, 16) = -1 EHOSTUNREACH (No route to host) +close(3) = 0 +alarm(0) = 1 +write(2, "Connecting via IO::Socket::INET t"..., 61Connecting via IO::Socket::INET to localhost:143 Timeout 600 +) = 61 +stat64("/etc/resolv.conf", {st_mode=S_IFREG|0644, st_size=52, ...}) = 0 +stat64("/etc/resolv.conf", {st_mode=S_IFREG|0644, st_size=52, ...}) = 0 +open("/etc/hosts", O_RDONLY|O_CLOEXEC) = 3 +fstat64(3, {st_mode=S_IFREG|0644, st_size=519, ...}) = 0 +mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0) = 0xb7876000 +read(3, "127.0.0.1\tpetite.lamiral.info pet"..., 4096) = 519 +read(3, ""..., 4096) = 0 +close(3) = 0 +munmap(0xb7876000, 4096) = 0 +socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) = 3 +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7908) = -1 EINVAL (Invalid argument) +_llseek(3, 0, 0xbfef7950, SEEK_CUR) = -1 ESPIPE (Illegal seek) +ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbfef7908) = -1 EINVAL (Invalid argument) +_llseek(3, 0, 0xbfef7950, SEEK_CUR) = -1 ESPIPE (Illegal seek) +fcntl64(3, F_SETFD, FD_CLOEXEC) = 0 +fcntl64(3, F_GETFL) = 0x2 (flags O_RDWR) +fcntl64(3, F_SETFL, O_RDWR|O_NONBLOCK) = 0 +connect(3, {sa_family=AF_INET, sin_port=htons(143), sin_addr=inet_addr("127.0.0.1")}, 16) = -1 EINPROGRESS (Operation now in progress) +select(8, NULL, [3], NULL, {600, 0}) = 1 (out [3], left {599, 999985}) +connect(3, {sa_family=AF_INET, sin_port=htons(143), sin_addr=inet_addr("127.0.0.1")}, 16) = 0 +fcntl64(3, F_GETFL) = 0x802 (flags O_RDWR|O_NONBLOCK) +fcntl64(3, F_SETFL, O_RDWR) = 0 +write(2, "Connected to localhost\n"..., 23Connected to localhost +) = 23 +fcntl64(3, F_GETFL) = 0x2 (flags O_RDWR) +fcntl64(3, F_SETFL, O_RDWR|O_NONBLOCK) = 0 +select(8, [3], NULL, [3], {600, 0}) = 1 (left {599, 999989}) +read(3, "* OK [CAPABILITY IMAP4rev1 UIDPLU"..., 4096) = 242 +write(2, "Read: \t* OK [CAPABILITY IMAP4rev1"..., 248Read: * OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA IDLE ACL ACL2=UNION STARTTLS] Courier-IMAP ready. Copyright 1998-2008 Double Precision, Inc. See COPYING for distribution information. +) = 248 +write(2, "Sending: 1 LOGOUT\n"..., 18Sending: 1 LOGOUT +) = 18 +rt_sigprocmask(SIG_BLOCK, [PIPE], [], 8) = 0 +rt_sigaction(SIGPIPE, {SIG_DFL}, {SIG_DFL}, 8) = 0 +rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0 +rt_sigprocmask(SIG_BLOCK, [PIPE], [], 8) = 0 +rt_sigaction(SIGPIPE, {SIG_IGN}, {SIG_DFL}, 8) = 0 +rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0 +write(3, "1 LOGOUT\r\n"..., 10) = 10 +write(2, "Sent 10 bytes\n"..., 14Sent 10 bytes +) = 14 +rt_sigprocmask(SIG_BLOCK, [PIPE], [], 8) = 0 +rt_sigaction(SIGPIPE, {SIG_DFL}, {SIG_IGN}, 8) = 0 +rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0 +select(8, [3], NULL, [3], {600, 0}) = 1 (left {599, 999161}) +read(3, "* BYE Courier-IMAP server shuttin"..., 4096) = 64 +write(2, "Read: \t* BYE Courier-IMAP server "..., 72Read: * BYE Courier-IMAP server shutting down + 1 OK LOGOUT completed +) = 72 +close(3) = 0 +write(1, "last_release 10.10.10.10\nunknown\n"..., 33last_release 10.10.10.10 +unknown +) = 33 +exit_group(0) = ? diff --git a/memo b/memo index d2116da..077a5cf 100644 --- a/memo +++ b/memo @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: memo,v 1.23 2010/10/24 23:49:28 gilles Exp gilles $ +# $Id: memo,v 1.29 2010/12/14 15:14:46 gilles Exp gilles $ software_version() { @@ -9,15 +9,15 @@ software_version() { } statistics_lfo() { +# 62.147.165.21 - - [31/Oct/2010:23:45:28 +0100] "GET /prj/imapsync/VERSION HTTP/1.0" 200 6 "-" "imapsync/1.368 (linux system, perl 5.8.8, Mail::IMAPClient 2.2.9 imapsync)" #grep prj/imapsync/VERSION /usr/local/apache/logs/access_log | sort -n | cut -d ' ' -f 1,12,13|uniq -c | sort -n # list ip cat < niouzes.xml python ./niouzes/getmynews.py --neuf niouzes.xml > niouzes-neuf.html python ./niouzes/getmynews.py --html niouzes.xml > niouzes-html.html - cd $DIR_SAVE + ) } lfo_announce() { software_version -NEWS_FILE="/home/gilles/public_html/www.linux-france.org/html/niouzes/niouzes_imapsync.xml" +NEWS_FILE="/g/public_html/www.linux-france.org/html/niouzes/niouzes_imapsync.xml" if ! newer VERSION $NEWS_FILE; then echo "$VERSION already announced" else diff --git a/patches/proxyauth-v2_1.366.patch b/patches/proxyauth-v2_1.366.patch new file mode 100644 index 0000000..b388076 --- /dev/null +++ b/patches/proxyauth-v2_1.366.patch @@ -0,0 +1,168 @@ +diff -urN imapsync-1.366.orig/FAQ imapsync-1.366/FAQ +--- imapsync-1.366.orig/FAQ 2010-10-30 12:24:10.951674625 +0200 ++++ imapsync-1.366/FAQ 2010-10-31 14:12:40.447361182 +0100 +@@ -514,6 +514,34 @@ + --exclude '^user\.' + + ====================================================================== ++Q: How to migrate from Sun Java Enterprise System / Sun One / iPlanet / ++Netscape servers with an admin account? ++ ++R: Those imap servers don't allow the typical use of --authuser1 to use an ++administrative account. They expect the use of an IMAP command called ++proxyauth that is issued after login in as an administrative account. ++ ++For example, consider the administrative account 'administrator' and your ++real user 'real_user'. The IMAP sequence would be: ++ ++ OK [CAPABILITY IMAP4 IMAP4rev1 ACL QUOTA LITERAL+ NAMESPACE UIDPLUS ++ CHILDREN BINARY UNSELECT LANGUAGE STARTTLS XSENDER X-NETSCAPE XSERVERINFO ++ AUTH=PLAIN] imap.server IMAP4 service (Sun Java(tm) System Messaging ++ Server ...)) ++ 1 LOGIN administrator password ++ 1 OK User logged in ++ 2 PROXYAUTH real_user ++ 2 OK Completed ++ ++In imapsync, you can achieve this by using the following options: ++ ++ --host1 source.imap.server \ ++ --user1 real_user \ ++ --authuser1 administrator \ ++ --proxyauth1 \ ++ --passfile admin.txt ++ ++====================================================================== + Q. Is there anyway of making imapsync purge the destination folder + when the source folder is deleted? + +diff -urN imapsync-1.366.orig/imapsync imapsync-1.366/imapsync +--- imapsync-1.366.orig/imapsync 2010-10-30 12:24:10.965674761 +0200 ++++ imapsync-1.366/imapsync 2010-10-31 13:09:59.922679699 +0100 +@@ -204,6 +204,9 @@ + with --authuser1 "adminuser", it will not work. + Same behavior with the --authuser2 option. + ++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 + + =head1 EXIT STATUS + +@@ -560,6 +563,7 @@ + $ssl1, $ssl2, + $tls1, $tls2, + $authuser1, $authuser2, ++ $proxyauth1, $proxyauth2, + $authmech1, $authmech2, + $split1, $split2, + $reconnectretry1, $reconnectretry2, +@@ -680,6 +684,14 @@ + $authmech1 = uc($authmech1); + $authmech2 = uc($authmech2); + ++if (defined $proxyauth1 && !$authuser1) { ++ missing_option("With --proxyauth1, --authuser1"); ++} ++ ++if (defined $proxyauth2 && !$authuser2) { ++ missing_option("With --proxyauth2, --authuser2"); ++} ++ + $authuser1 ||= $user1; + $authuser2 ||= $user2; + +@@ -721,12 +733,14 @@ + $debugimap1 and print "Host1 connection\n"; + $imap1 = login_imap($host1, $port1, $user1, $password1, + $debugimap1, $timeout, $fastio1, $ssl1, $tls1, +- $authmech1, $authuser1, $reconnectretry1); ++ $authmech1, $authuser1, $reconnectretry1, ++ $proxyauth1); + + $debugimap2 and print "Host2 connection\n"; + $imap2 = login_imap($host2, $port2, $user2, $password2, + $debugimap2, $timeout, $fastio2, $ssl2, $tls2, +- $authmech2, $authuser2, $reconnectretry2); ++ $authmech2, $authuser2, $reconnectretry2, ++ $proxyauth2); + + # history + +@@ -1551,7 +1565,8 @@ + sub login_imap { + my($host, $port, $user, $password, + $debugimap, $timeout, $fastio, +- $ssl, $tls, $authmech, $authuser, $reconnectretry) = @_; ++ $ssl, $tls, $authmech, $authuser, $reconnectretry, ++ $proxyauth) = @_; + my ($imap); + + $imap = Mail::IMAPClient->new(); +@@ -1591,13 +1606,25 @@ + } + } + +- $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); ++ if ($proxyauth) { ++ $imap->Authmechanism(""); ++ } else { ++ $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); ++ } ++ + $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; + + +- $imap->User($user); +- $imap->Authuser($authuser); +- $imap->Password($password); ++ if ($proxyauth) { ++ $imap->User($authuser); ++ $imap->Authuser($authuser); ++ $imap->Password($password); ++ } else { ++ $imap->User($user); ++ $imap->Authuser($authuser); ++ $imap->Password($password); ++ } ++ + unless ($imap->login()) { + my $info = "Error login: [$host] with user [$user] auth"; + my $einfo = $imap->LastError || @{$imap->History}[-1]; +@@ -1610,6 +1637,8 @@ + $imap->login() or + die_clean("$info [LOGIN]: ", $imap->LastError, "\n"); + } ++ $proxyauth && $imap->proxyauth($user); ++ + print "Success login on [$host] with user [$user] auth [$authmech]\n"; + return($imap); + } +@@ -2423,6 +2452,8 @@ + "authmech2=s" => \$authmech2, + "authuser1=s" => \$authuser1, + "authuser2=s" => \$authuser2, ++ "proxyauth1" => \$proxyauth1, ++ "proxyauth2" => \$proxyauth1, + "split1=i" => \$split1, + "split2=i" => \$split2, + "reconnectretry1=i" => \$reconnectretry1, +@@ -2722,12 +2753,18 @@ + --user1 : user to login on host1. Mandatory. + --authuser1 : user to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. ++--proxyauth1 : Use proxyauth on host1. Requires --authuser1. ++ Required by Sun/iPlanet/Netscape IMAP servers to ++ be able to use an administrative user + --password1 : password for the user1. Dangerous, use --passfile1 + --passfile1 : password file for the user1. Contains the password. + --host2 : "destination" imap server. Mandatory. + --port2 : port to connect on host2. Default is 143. + --user2 : user to login on host2. Mandatory. + --authuser2 : user to auth with on host2 (admin user). ++--proxyauth2 : Use proxyauth on host2. Requires --authuser2. ++ Required by Sun/iPlanet/Netscape IMAP servers to ++ be able to use an administrative user + --password2 : password for the user2. Dangerous, use --passfile2 + --passfile2 : password file for the user2. Contains the password. + --noauthmd5 : don't use MD5 authentification. diff --git a/patches/proxyauth_1.366.patch b/patches/proxyauth_1.366.patch new file mode 100644 index 0000000..d9baf01 --- /dev/null +++ b/patches/proxyauth_1.366.patch @@ -0,0 +1,111 @@ +diff -urN imapsync-1.366.orig/imapsync imapsync-1.366/imapsync +--- imapsync-1.366.orig/imapsync 2010-10-30 12:24:10.965674761 +0200 ++++ imapsync-1.366/imapsync 2010-10-30 14:13:31.456674582 +0200 +@@ -204,6 +204,9 @@ + with --authuser1 "adminuser", it will not work. + Same behavior with the --authuser2 option. + ++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 + + =head1 EXIT STATUS + +@@ -560,6 +563,7 @@ + $ssl1, $ssl2, + $tls1, $tls2, + $authuser1, $authuser2, ++ $proxyauth1, $proxyauth2, + $authmech1, $authmech2, + $split1, $split2, + $reconnectretry1, $reconnectretry2, +@@ -680,6 +684,14 @@ + $authmech1 = uc($authmech1); + $authmech2 = uc($authmech2); + ++if (defined $proxyauth1 && !$authuser1) { ++ missing_option("With --proxyauth1, --authuser1"); ++} ++ ++if (defined $proxyauth2 && !$authuser2) { ++ missing_option("With --proxyauth2, --authuser2"); ++} ++ + $authuser1 ||= $user1; + $authuser2 ||= $user2; + +@@ -721,12 +733,14 @@ + $debugimap1 and print "Host1 connection\n"; + $imap1 = login_imap($host1, $port1, $user1, $password1, + $debugimap1, $timeout, $fastio1, $ssl1, $tls1, +- $authmech1, $authuser1, $reconnectretry1); ++ $authmech1, $authuser1, $reconnectretry1, ++ $proxyauth1); + + $debugimap2 and print "Host2 connection\n"; + $imap2 = login_imap($host2, $port2, $user2, $password2, + $debugimap2, $timeout, $fastio2, $ssl2, $tls2, +- $authmech2, $authuser2, $reconnectretry2); ++ $authmech2, $authuser2, $reconnectretry2, ++ $proxyauth2); + + # history + +@@ -1551,7 +1565,8 @@ + sub login_imap { + my($host, $port, $user, $password, + $debugimap, $timeout, $fastio, +- $ssl, $tls, $authmech, $authuser, $reconnectretry) = @_; ++ $ssl, $tls, $authmech, $authuser, $reconnectretry, ++ $proxyauth) = @_; + my ($imap); + + $imap = Mail::IMAPClient->new(); +@@ -1591,13 +1606,25 @@ + } + } + +- $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); ++ if ($proxyauth) { ++ $imap->Authmechanism(""); ++ } else { ++ $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); ++ } ++ + $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; + + +- $imap->User($user); +- $imap->Authuser($authuser); +- $imap->Password($password); ++ if ($proxyauth) { ++ $imap->User($authuser); ++ $imap->Authuser($authuser); ++ $imap->Password($password); ++ } else { ++ $imap->User($user); ++ $imap->Authuser($authuser); ++ $imap->Password($password); ++ } ++ + unless ($imap->login()) { + my $info = "Error login: [$host] with user [$user] auth"; + my $einfo = $imap->LastError || @{$imap->History}[-1]; +@@ -1610,6 +1637,8 @@ + $imap->login() or + die_clean("$info [LOGIN]: ", $imap->LastError, "\n"); + } ++ $proxyauth && $imap->proxyauth($user); ++ + print "Success login on [$host] with user [$user] auth [$authmech]\n"; + return($imap); + } +@@ -2423,6 +2452,8 @@ + "authmech2=s" => \$authmech2, + "authuser1=s" => \$authuser1, + "authuser2=s" => \$authuser2, ++ "proxyauth1" => \$proxyauth1, ++ "proxyauth2" => \$proxyauth1, + "split1=i" => \$split1, + "split2=i" => \$split2, + "reconnectretry1=i" => \$reconnectretry1, diff --git a/paypal.html b/paypal.html deleted file mode 100644 index bdca039..0000000 --- a/paypal.html +++ /dev/null @@ -1,18 +0,0 @@ - - - -

imapsync donation

- -Help the author to maintain imapsync: -
- - - - -
- -Thanks in advance! - - - diff --git a/paypal.shtml b/paypal.shtml new file mode 100644 index 0000000..0285d86 --- /dev/null +++ b/paypal.shtml @@ -0,0 +1,73 @@ + + + + +imapsync donation + + + + + + + + + + + + + + + + + +

imapsync donation

+ +

Help the author to maintain imapsync:
+(1 EUR ~ 1.3 USD on 01/2011) +

+
+

+ + + + +

+
+ +

Thanks in advance!

+ +
+

+ Valid XHTML 1.0 Strict + + + CSS Valide ! + + + + +This document last modified on +($Id: paypal.shtml,v 1.4 2011/01/18 02:54:01 gilles Exp gilles $) +

+ + + + diff --git a/paypal_reply/8859_utf8 b/paypal_reply/8859_utf8 new file mode 100755 index 0000000..02f5630 --- /dev/null +++ b/paypal_reply/8859_utf8 @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w + +# $Id: 8859_utf8,v 1.1 2010/10/01 13:00:09 gilles Exp gilles $ + +use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); + +die unless (utf8_supported_charset('ISO-8859-1')); + +while (<>) { + print to_utf8({ -string => $_, -charset => 'ISO-8859-1' }); +} + + diff --git a/paypal_reply/TODO b/paypal_reply/TODO new file mode 100644 index 0000000..63227b7 --- /dev/null +++ b/paypal_reply/TODO @@ -0,0 +1,6 @@ + + +Rewrite all with less scripts +use Email::Simple module + + diff --git a/paypal_reply/paypal_build_reply b/paypal_reply/paypal_build_reply new file mode 100755 index 0000000..37b6222 --- /dev/null +++ b/paypal_reply/paypal_build_reply @@ -0,0 +1,140 @@ +#!/usr/bin/perl + +# $Id: paypal_build_reply,v 1.8 2010/12/29 23:51:23 gilles Exp gilles $ + +use warnings; +use strict; + +my ($msg_id_file, $msg_id); +my ($amount, $name, $email); +my ( + $buyer, $object, $support, $description, + $url_source, $url_exe, $url, $release, +); + +$msg_id_file = $ARGV[1]; +$msg_id = firstline($msg_id_file); + +while(<>) { + next if ( ! /^Vous avez re.*paiement d'un montant de (.*) de la part de (.*) \((.*)\)/); + ($amount, $name, $email) = ($1, $2, $3); + last; +} + +$url_source = firstline('/g/var/paypal_reply/url_source'); +$url_exe = firstline('/g/var/paypal_reply/url_exe'); +$release = firstline('/g/var/paypal_reply/url_release'); + +# source code wanted +if (('$35,00 USD' eq $amount) or ('$50,00 USD' eq $amount)) { + $object = 'imapsync source code'; + $support = ''; + $url = $url_source; +} + +# win32 binary wanted +if (('$25,00 USD' eq $amount) or ('$15,00 USD' eq $amount)) { + $object = 'imapsync.exe binary'; + $support = ''; + $url = $url_exe; +} + +# source code + technical support wanted +if ('$135,00 USD' eq $amount) { + $object = 'imapsync source code'; + $support = "\nI'm ready to help you by email until success (I hope).\n"; + $url = $url_source; +} + +# win32 binary + technical support wanted +if ('$125,00 USD' eq $amount) { + $object = 'imapsync.exe binary'; + $support = "\nI'm ready to help you by email until success (I hope).\n"; + $url = $url_exe; +} + + + +while(<>) { + next if ( ! /^Acheteur/ ); + $buyer .= "===== Acheteur =====\n"; + last; +} + +while(<>) { + $buyer .= $_ if ( ! /^Instructions/ ); + last if ( /^Instructions/ ); +} + +while(<>) { + next if ( ! /^Description :(.*)/ ); + $description = "===== Details =====\n"; + $description .= $_; + last; +} + +while(<>) { + $description .= $_; + last if ( /^Paiement envoy/ ); +} + +my $address = 'gilles.lamiral@laposte.net'; +my $address2 = 'gilles@lamiral.info'; +my $rcstag = '$Id: paypal_build_reply,v 1.8 2010/12/29 23:51:23 gilles Exp gilles $'; + +my $message = < +To: <$email> +Bcc: Gilles LAMIRAL <$address>, <$address2> +Subject: [imapsync download] $object release $release [$email] + +Hello $name, + +You will find the latest $object release $release at the following link: +$url + +I thank you for buying and using imapsync, +I wish you successful transfers! +$support +$buyer +$description +==== Vendeur ==== +Gilles LAMIRAL +4 La Billais +35580 Baulon +FRANCE + +Tel: +33 951 84 42 42 +Mob: +33 620 79 76 06 +Fax: +33 956 84 42 42 + +email: $address + +-- +Au revoir, 09 51 84 42 42 +Gilles Lamiral. France, Baulon (35580) 06 20 79 76 06 +EOM +; + +=pod +=cut + + +print $message; +#print "[$amount] [$name] [$email] [$object]\n"; + + +sub firstline { + # extract the first line of a file (without \n) + + my($file) = @_; + my $line = ""; + + open FILE, $file or die("error [$file]: $! "); + chomp($line = ); + close FILE; + $line = ($line) ? $line: "error !EMPTY! [$file]"; + return $line; +} diff --git a/paypal_reply/paypal_functions b/paypal_reply/paypal_functions new file mode 100755 index 0000000..36e4762 --- /dev/null +++ b/paypal_reply/paypal_functions @@ -0,0 +1,182 @@ +#!/bin/sh + +# $Id: paypal_functions,v 1.10 2011/01/11 01:41:31 gilles Exp gilles $ + + + +paypal_prerequisites() { + perl -mMIME::Lite -e '' || echo 'sudo aptitude install libmime-lite-perl' + perl -mMIME::Parser -e '' || echo 'sudo aptitude install libmime-tools-perl' + perl -mUnicode::MapUTF8 -e '' || echo 'sudo aptitude install libunicode-maputf8-perl' +} + +paypal_init_laposte() { + user=gilles.lamiral + passfile=/g/var/pass/secret.gilles_laposte + host=imap.laposte.net + tmpdir=/g/var/paypal_reply + folder=INBOX +} + +paypal_init_petite() { + user=gilles@est.belle + passfile=/g/var/pass/secret.gilles_mbox + host=p + tmpdir=/g/var/paypal_reply + folder='INBOX.03_imapsync.imapsync_paypal' +} + +paypal_init_petite_INBOX() { + user=gilles@est.belle + passfile=/g/var/pass/secret.gilles_mbox + host=p + tmpdir=/g/var/paypal_reply + folder='INBOX' +} + + +paypal_init_test() { + user=gilles@est.belle + passfile=/g/var/pass/secret.gilles_mbox + host=p + tmpdir=/g/var/paypal_reply_test + folder='INBOX.03_imapsync.imapsync_paypal' +} + + + +get_mail() { + # creation des répertoires + mkdir -p $tmpdir/msg_in/ + mkdir -p $tmpdir/msg_id/ + ( + cd $tmpdir/msg_in/ + # recuperation des messages de la boite sans destruction des messages + # transférés + paypal_imapget --host $host --user $user --passfile $passfile \ + --folder $folder + ) +} + + +extract_mail() { + test -z "`ls $tmpdir/msg_in/`" && echo no mail && return + mkdir -p $tmpdir/msg_out/ + ( + cd $tmpdir/msg_out/ + test -z "`ls .`" || rm -rf *_d + paypal_mimeexplode ../msg_in/* + ) + #ls -d $tmpdir/msg_out/ +} + +extract_mail_test() { + test -z "`ls $tmpdir/msg_in/`" && echo no mail && return + mkdir -p $tmpdir/msg_out/ + ( + cd $tmpdir/msg_out/ + test -z "`ls .`" || rm -rf *_d + paypal_mimeexplode ../msg_in/* + ) + #ls -d $tmpdir/msg_out/ +} + + + + +convert_utf8() { + test -z "`ls $tmpdir/msg_out/`" && echo no mail && return + mkdir -p $tmpdir/msg_out_utf8/ + for f in $tmpdir/msg_out/*_d/*.txt; do + b=`basename "$f"` + d=`dirname "$f"` + bd=`basename "$d"` + d_utf8="$tmpdir/msg_out_utf8/$bd" + f_utf8="$d_utf8/$b" + test -d "$d_utf8" && continue + echo converting "$f" to "$f_utf8" + mkdir "$d_utf8" + 8859_utf8 "$f" > "$f_utf8" + done +} + + +troncate_last_2_chars() { + length=`expr length "$1"` + length_2=`expr $length - 2` + expr substr "$1" 1 $length_2 + +} + +build_reply() { + mkdir -p $tmpdir/msg_reply/ + for f in $tmpdir/msg_out_utf8/*/*.txt; do + #echo "$f" + d=`dirname "$f"` + bd=`basename "$d"` + file_id=`troncate_last_2_chars $bd` + d_reply="$tmpdir/msg_reply/$file_id" + test -f "$d_reply/$file_id.txt" && continue + mkdir -p "$d_reply" + echo building "$d_reply/$file_id.txt" + paypal_build_reply "$f" "$tmpdir/msg_id/$file_id" > "$d_reply/$file_id.txt" + done +} + + +send_reply() { + mkdir -p $tmpdir/msg_sent/ + for f in $tmpdir/msg_reply/*/*.txt; do + b=`basename "$f"` + d=`dirname "$f"` + bd=`basename "$d"` + d_sent="$tmpdir/msg_sent/$bd" + test -f "$d_sent/$b" && continue + mkdir -p "$d_sent" + test X"--send" = X"$1" && paypal_send --send "$f" && touch "$d_sent/$b" + test X"" = X"$1" && paypal_send "$f" + done +} + +paypal_all() { + paypal_prerequisites + echo "Will get messages in $tmpdir/msg_in/" + get_mail + echo "Done get messages in $tmpdir/msg_in/" + + echo "Will extract_mail in $tmpdir/msg_out/" + extract_mail + echo "Done extract_mail in $tmpdir/msg_out/" + echo "Will converting to utf8 in $tmpdir/msg_out_utf8/" + convert_utf8 + echo "Done converting to utf8 in $tmpdir/msg_out_utf8/" + echo "Will build_reply in $tmpdir/msg_reply/" + build_reply + echo "Done build_reply in $tmpdir/msg_reply/" + echo "Will send_reply $@" + send_reply "$@" + echo "Done send_reply $@" +} + +#echo 'paypal_reply_petite' +paypal_reply_petite() { + echo "Doing paypal_reply_petite" + echo paypal_init_petite + paypal_init_petite + paypal_all "$@" + echo paypal_init_petite_INBOX + paypal_init_petite_INBOX + paypal_all "$@" + echo "Done paypal_reply_petite" +} + +#echo 'paypal_reply_laposte' +paypal_reply_laposte() { + echo "Doing paypal_reply_laposte" + echo paypal_init_laposte + paypal_init_laposte + paypal_all "$@" + echo "Done paypal_reply_laposte" +} + + diff --git a/paypal_reply/paypal_imapget b/paypal_reply/paypal_imapget new file mode 100755 index 0000000..e048495 --- /dev/null +++ b/paypal_reply/paypal_imapget @@ -0,0 +1,129 @@ +#!/usr/bin/perl -w + +# $Id: paypal_imapget,v 1.6 2010/12/29 23:50:45 gilles Exp gilles $ + +use Getopt::Long; +use Mail::IMAPClient; +use FileHandle; + + +my $host; +my $port = 143; +my $debugimap = 0; +my $debug = 0; +my $user; +my $password; +my $passfile; +my $folder = 'INBOX'; +my $help; + +my $numopt = scalar(@ARGV); +my $opt_ret = GetOptions( + "host=s" => \$host, + "user=s" => \$user, + "password=s" => \$password, + "passfile=s" => \$passfile, + "folder=s" => \$folder, + "help" => \$help, + "delete!" => \$delete, + "expunge!" => \$expunge, + "debugimap!" => \$debugimap, + "debug!" => \$debug, +); +usage() and exit if ($help or ! $numopt) ; + +$password = (defined($passfile)) ? firstline ($passfile) : $password; + +my $imap = Mail::IMAPClient->new(); + +$imap->Server($host); +$imap->Port($port); +$imap->Uid(1); +$imap->Peek(1); +$imap->Debug($debugimap); +$imap->connect() + or die "Can not open imap connection on [$host] with user [$user] : $@\n"; +$imap->User($user); +$imap->Password($password); +$imap->login() or die "Error login : [$host] with user [$user] : $@"; + +$imap->select($folder) or die "Error select folder [$folder] host [$host] user [$user] : $@"; + +#my @uids = $imap->search('HEADER', 'SUBJECT',"=?windows-1252?Q?Avis_de_r=E9ception_d=27un_paiement?="); +#my @uids = $imap->search('HEADER', 'Sender','sendmail@paypal.com'); +my @uids = $imap->search('TEXT', 'PP341'); +print "Search: [@uids]\n"; + +foreach $msg (@uids) { + my $msg_id = $imap->get_header( $msg, "Message-Id" ); + $debug and print "$msg_id\n"; + my $msg_code = format_msg_id($msg_id); + my $file = "$msg_code"; + if (-f $msg_code and -f "../msg_id/$msg_code") { + $debug and print "Already have $msg_code $msg\n"; + next; + } + print "writing message $msg to $file\n"; + unlink($file); + if ($imap->message_to_file($file, $msg)) { + $imap->delete_message($msg) if $delete; + $imap->expunge() if $expunge; + }else{ + print "Error writing $file: $@\n"; + } + write_to_file("../msg_id/$msg_code", $msg_id); +} + +$imap->logout(); + + +sub usage { + print < : imap server. Mandatory. +--user : user to login. Mandatory. +--password : password for the user1. Mandatory. +--delete : mark messages well dumped as deleted +--expunge : expunge folder. + +Example: +$0 \\ + --host imap.troc.org --user foo --password secret +EOF +} + +sub firstline { + # extract the first line of a file (without \n) + + my($file) = @_; + my $line = ""; + + open FILE, $file or die("error [$file]: $! "); + chomp($line = ); + close FILE; + $line = ($line) ? $line: "error !EMPTY! [$file]"; + return $line; +} + +sub format_msg_id { + my $msg_id = shift; + + $msg_id =~ tr/a-zA-Z0-9/_/cs; + $debug and print "$msg_id\n"; + return($msg_id); +} + +sub write_to_file { + my $file = shift; + my $string = shift; + + $fh = FileHandle->new("> $file"); + if (defined $fh) { + print $fh $string; + $fh->close; + } +} diff --git a/paypal_reply/paypal_mimeexplode b/paypal_reply/paypal_mimeexplode new file mode 100755 index 0000000..afba608 --- /dev/null +++ b/paypal_reply/paypal_mimeexplode @@ -0,0 +1,187 @@ +#!/usr/bin/perl -w + +# $Id: paypal_mimeexplode,v 1.1 2010/11/23 01:26:24 gilles Exp gilles $ + +=head1 NAME + +mimeexplode - explode one or more MIME messages + +=head1 SYNOPSIS + + mimeexplode ... + + someprocess | mimeexplode - + +=head1 DESCRIPTION + +Takes one or more files from the command line that contain MIME +messages, and explodes their contents out into subdirectories +of the current working directory. The subdirectories are +just called C, C, C, etc. Existing directories are +skipped over. + +The message information is output to the stdout, like this: + + Message: msg3 (inputfile1.msg) + Part: msg3/filename-1.dat (text/plain) + Part: msg3/filename-2.dat (text/plain) + Message: msg5 (input-file2.msg) + Part: msg5/dir.gif (image/gif) + Part: msg5/face.jpg (image/jpeg) + Message: msg6 (infile3) + Part: msg6/filename-1.dat (text/plain) + +This was written as an example of the MIME:: modules in the +MIME-parser package I wrote. It may prove useful as a quick-and-dirty +way of splitting a MIME message if you need to decode something, and +you don't have a MIME mail reader on hand. + +=head1 COMMAND LINE OPTIONS + +None yet. + +=head1 AUTHOR + +Eryq C, in a big hurry... + +=cut + +BEGIN { unshift @INC, ".." } # to test MIME:: stuff before installing it! + +require 5.001; +use strict; +use Getopt::Long; +use vars qw($Msgno); + +use MIME::Parser; +use Getopt::Std; +use File::Basename; + + +my $numopt = scalar(@ARGV); +my $help; +my $debug; + +my $opt_ret = GetOptions( + "help" => \$help, + "debug!" => \$debug, +); +usage() and exit if ($help or ! $numopt) ; + + +sub usage { + print <parts; + + if (@parts) { # multipart... + map { dump_entity($_) } @parts; + } + else { # single part... + $debug and print " Part: ", $ent->bodyhandle->path, + " (", scalar($ent->head->mime_type), ")\n"; + } +} + +#------------------------------------------------------------ +# main +#------------------------------------------------------------ +sub main { + my $file; + my $entity; + + # Sanity: + (-w ".") or die "cwd not writable, you naughty boy..."; + + # Go through messages: + @ARGV or unshift @ARGV, "-"; + while (defined($file = shift @ARGV)) { + + my $msgdir = make_msg_dir($file); + next if not $msgdir; + $debug and print "Message: $msgdir ($file)\n"; + + # Create a new parser object: + my $parser = new MIME::Parser; + ### $parser->parse_nested_messages('REPLACE'); + + # Optional: set up parameters that will affect how it extracts + # documents from the input stream: + $parser->output_dir($msgdir); + + # Parse an input stream: + open FILE, $file or die "couldn't open $file"; + $entity = $parser->read(\*FILE) or + print STDERR "Couldn't parse MIME in $file; continuing...\n"; + close FILE; + + # Congratulations: you now have a (possibly multipart) MIME entity! + dump_entity($entity) if $entity; + ### $entity->dump_skeleton if $entity; + } + 1; +} + +exit (&main ? 0 : -1); +#------------------------------------------------------------ +1; + + + + + + diff --git a/paypal_reply/paypal_run_laposte b/paypal_reply/paypal_run_laposte new file mode 100755 index 0000000..dad363d --- /dev/null +++ b/paypal_reply/paypal_run_laposte @@ -0,0 +1,30 @@ +#!/bin/sh + +# $Id: paypal_run_laposte,v 1.2 2010/11/28 05:27:12 gilles Exp gilles $ + +set -e +#set -x + + +# Add path to commands at home +PATH=$PATH:/g/public_html/imapsync/paypal_reply +PERL5LIB=/g/public_html/imapsync/Mail-IMAPClient-3.25/lib +export PERL5LIB + +test -f /g/public_html/imapsync/paypal_reply/paypal_functions \ +&& . /g/public_html/imapsync/paypal_reply/paypal_functions + + +DATE_1=`date` + +echo "==== paypal_reply_laposte ====" +paypal_reply_laposte "$@" +echo + + + +DATE_2=`date` + +echo "Debut : $DATE_1" +echo "Fin : $DATE_2" +echo "Yo Bery GOOD !" diff --git a/paypal_reply/paypal_run_petite b/paypal_reply/paypal_run_petite new file mode 100755 index 0000000..742c0b3 --- /dev/null +++ b/paypal_reply/paypal_run_petite @@ -0,0 +1,30 @@ +#!/bin/sh + +# $Id: paypal_run_petite,v 1.4 2010/12/14 15:40:13 gilles Exp gilles $ + +set -e +#set -x + + +# Add path to commands at home +PATH=$PATH:/g/public_html/imapsync/paypal_reply +PERL5LIB=/g/public_html/imapsync/Mail-IMAPClient-3.25/lib +export PERL5LIB + +test -f /g/public_html/imapsync/paypal_reply/paypal_functions \ +&& . /g/public_html/imapsync/paypal_reply/paypal_functions + + +DATE_1=`date` + +echo "==== paypal_reply_petite ====" +paypal_reply_petite "$@" +echo + + + +DATE_2=`date` + +echo "Debut : $DATE_1" +echo "Fin : $DATE_2" +echo "Yo Bery GOOD !" diff --git a/paypal_reply/paypal_run_test b/paypal_reply/paypal_run_test new file mode 100755 index 0000000..b3f262c --- /dev/null +++ b/paypal_reply/paypal_run_test @@ -0,0 +1,30 @@ +#!/bin/sh + +# $Id: paypal_run_test,v 1.1 2010/11/28 01:00:45 gilles Exp gilles $ + +set -e +#set -x + + +# Add path to commands at home +PATH=$PATH:/g/public_html/imapsync/paypal_reply +PERL5LIB=/g/public_html/imapsync/Mail-IMAPClient-3.25/lib +export PERL5LIB + +test -f /g/public_html/imapsync/paypal_reply/paypal_functions \ +&& . /g/public_html/imapsync/paypal_reply/paypal_functions + + +DATE_1=`date` + +echo "==== paypal_reply_test ====" +paypal_reply_test +echo + + + +DATE_2=`date` + +echo "Debut : $DATE_1" +echo "Fin : $DATE_2" +echo "Yo Bery GOOD !" diff --git a/paypal_reply/paypal_send b/paypal_reply/paypal_send new file mode 100755 index 0000000..185ca40 --- /dev/null +++ b/paypal_reply/paypal_send @@ -0,0 +1,71 @@ +#!/usr/bin/perl + +# $Id: paypal_send,v 1.3 2010/12/29 23:50:24 gilles Exp gilles $ + +use strict; +use warnings; +use Getopt::Long; +use MIME::Lite; + +my ( + $help, + $debug, + $send, +); + +my $numopt = scalar(@ARGV); +my $opt_ret = GetOptions( + "help" => \$help, + "debug!" => \$debug, + "send!" => \$send, +); + +usage() and exit if ($help or ! $numopt or ! $opt_ret) ; + +my @reply = <>; +my %header; + +while (my $line = shift @reply) { + #print $line; + chomp($line); + last if ($line =~ /^$/) ; + my($blank, $key, $value) = split /^(.+?:)\s*/, $line; + #print "[$key] [$value]\n"; + $header{$key} = $value; +} + +my $data = join('', @reply); + +#print "[", $data, "]\n"; + +my $message = MIME::Lite->new(); +$message->attr("content-type" => "text/plain"); +$message->attr("content-type.charset" => "UTF-8"); + +$message->build(%header); +$message->build(Data => $data); +$message->print(\*STDOUT); + + +if ($send) { + $message->send; + print "Sent to ", $header{'To:'},"\n"; +} + + + +sub usage { + print <