diff --git a/CREDITS b/CREDITS index 9db572a..db2c399 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.141 2010/07/14 13:52:04 gilles Exp gilles $ +# $Id: CREDITS,v 1.142 2010/08/09 01:16:01 gilles Exp gilles $ If you want to make a donation to the author, Gilles LAMIRAL: @@ -20,11 +20,23 @@ to remove one. I thank very much all of these people. +Martin Werthmoeller +Gave a patch ./patches/imapsync-1.337_tobit_V6.patch + +Jeremy Stent +Contributed by giving the book +13.60 "Unfolding the Napkin: The Hands-On Method for Solving Complex Problems with Simple Pictures" + +BudgetDedicated +Contributed by giving money 5 USD + +Wilton de Oliveira Garcia +Contributed by giving money 10 USD + David Osbo Contributed by giving the book 15.61 "The Complete Idiot's Guide to Conversational Sign Language Illustrated" - Jeroen Ticheler Contributed by giving the book 23.77 "Maps of Narrative Practice" diff --git a/ChangeLog b/ChangeLog index 42234dd..a26cc7d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,29 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.337 +head: 1.340 branch: locks: strict - gilles: 1.337 + gilles: 1.340 access list: symbolic names: keyword substitution: kv -total revisions: 337; selected revisions: 337 +total revisions: 340; selected revisions: 340 description: ---------------------------- -revision 1.337 locked by: gilles; +revision 1.340 locked by: gilles; +date: 2010/08/09 00:03:21; author: gilles; state: Exp; lines: +7 -7 +Bug fix. Stupid undef breaking --syncinternaldates +---------------------------- +revision 1.339 +date: 2010/07/28 15:07:56; author: gilles; state: Exp; lines: +27 -20 +Made a justconnect() routine. +---------------------------- +revision 1.338 +date: 2010/07/28 14:56:26; author: gilles; state: Exp; lines: +42 -27 +Added SYNOPSIS at the top of the documentation. +---------------------------- +revision 1.337 date: 2010/07/16 23:23:40; author: gilles; state: Exp; lines: +12 -6 Added --usedatemanip option (not documented in --help) Turned off Date::Manip usage by default: release 6.x vs 5.x buggy, diff --git a/FAQ b/FAQ index 5818f77..748460b 100644 --- a/FAQ +++ b/FAQ @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ,v 1.71 2010/07/15 12:07:00 gilles Exp gilles $ +# $Id: FAQ,v 1.73 2010/08/08 23:09:04 gilles Exp gilles $ +------------------+ | FAQ for imapsync | @@ -59,6 +59,9 @@ R. Here: RFC 3501 - INTERNET MESSAGE ACCESS PROTOCOL - VERSION 4rev1 http://www.faqs.org/rfcs/rfc3501.html +RFC2683 - IMAP4 Implementation Recommendations +http://www.faqs.org/rfcs/rfc2683.html + RFC 2595 - Using TLS with IMAP, POP3 and ACAP http://www.faqs.org/rfcs/rfc2595.html @@ -68,6 +71,9 @@ http://www.faqs.org/rfcs/rfc2822.html RFC 2342 - IMAP4 Namespace http://www.faqs.org/rfcs/rfc2342.html +RFC2180 - IMAP4 Multi-Accessed Mailbox Practice +http://www.faqs.org/rfcs/rfc2180.html + RFC 4549 - Synchronization Operations for Disconnected IMAP4 Clients http://www.faqs.org/rfcs/rfc4549.html @@ -885,6 +891,16 @@ Q. Migrating from David Tobit V8 R. Use the following options : imapsync ... --prefix1 INBOX. --sep1 / --subscribe --subscribed +======================================================================= +Q. Migrating from Tobit David Server 6 + ("DvISE Mail Access Server MA-6.60a (0118)") + +R. Look at the discussion: +http://www.linux-france.org/prj/imapsync_list/msg00582.html +http://www.linux-france.org/prj/imapsync_list/threads.html#00582 +patch saved in ./patches/imapsync-1.337_tobit_V6.patch + + ======================================================================= Q. I need to migrate 1250 mailboxes from one cyrus-IMAP server to another (empty) one. (Box-swap). The passwords are in a MySQL Database. diff --git a/Makefile b/Makefile index 9cd1707..195ed37 100644 --- a/Makefile +++ b/Makefile @@ -1,14 +1,12 @@ -# $Id: Makefile,v 1.32 2010/07/17 00:17:18 gilles Exp gilles $ - -TARGET=imapsync +# $Id: Makefile,v 1.34 2010/07/25 21:30:45 gilles Exp gilles $ .PHONY: help usage all help: usage usage: - @echo " $(TARGET) $(VERSION), You can do :" + @echo " imapsync $(VERSION), You can do :" @echo "make install # as root" @echo "make testf # run tests" @echo "make testv # run tests verbosely" @@ -16,24 +14,31 @@ usage: @echo "make test229 # run tests with Mail-IMAPClient-2.2.9" @echo "make all " +DIST_NAME=imapsync-$(VERSION) +DIST_FILE=$(DIST_NAME).tgz +DEB_FILE=$(DIST_NAME).deb +VERSION=$(shell perl -I./Mail-IMAPClient-2.2.9 ./imapsync --version) + + + all: ChangeLog README VERSION .PHONY: test tests testp testf test3xx -.test: $(TARGET) tests.sh +.test: imapsync tests.sh /usr/bin/time sh tests.sh 1>/dev/null touch .test -.test_3xx: $(TARGET) tests.sh +.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 test_quick : test_quick_229 test_quick_3xx -test_quick_229: $(TARGET) tests.sh +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: $(TARGET) tests.sh +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: @@ -47,23 +52,23 @@ test3xx: .test_3xx test229: .test_229 -.test_229: $(TARGET) tests.sh +.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 testf: clean_test test testp : - perl -c $(TARGET) + perl -c imapsync -ChangeLog: $(TARGET) - rlog $(TARGET) > ChangeLog +ChangeLog: imapsync + rlog imapsync > ChangeLog -README: $(TARGET) - perldoc -t $(TARGET) > README +README: imapsync + perldoc -t imapsync > README -VERSION: $(TARGET) Makefile - perl -I./Mail-IMAPClient-2.2.9 ./$(TARGET) --version > VERSION +VERSION: imapsync Makefile + perl -I./Mail-IMAPClient-2.2.9 ./imapsync --version > VERSION .PHONY: clean clean_tilde clean_test @@ -77,25 +82,20 @@ clean_tilde: .PHONY: install dist man -man: $(TARGET).1 +man: imapsync.1 clean_man: - rm -f $(TARGET).1 + rm -f imapsync.1 -$(TARGET).1: $(TARGET) - pod2man $(TARGET) > $(TARGET).1 +imapsync.1: imapsync + pod2man imapsync > imapsync.1 -install: testp $(TARGET).1 - install -D $(TARGET) $(DESTDIR)/usr/bin/$(TARGET) - install -D $(TARGET).1 $(DESTDIR)/usr/share/man/man1/$(TARGET).1 - chmod 755 $(DESTDIR)/usr/bin/$(TARGET) +install: testp imapsync.1 + install -D imapsync $(DESTDIR)/usr/bin/imapsync + install -D imapsync.1 $(DESTDIR)/usr/share/man/man1/imapsync.1 + chmod 755 $(DESTDIR)/usr/bin/imapsync -DIST_NAME=$(TARGET)-$(VERSION) -DIST_FILE=$(DIST_NAME).tgz -DEB_FILE=$(DIST_NAME).deb -VERSION=$(shell perl -I./Mail-IMAPClient-2.2.9 ./$(TARGET) --version) - dist: cidone test clean clean_dist all INSTALL tarball @@ -126,15 +126,21 @@ clean_dist: # Local goals -.PHONY: lfo lfo_upload niouze_lfo niouze_fm public +.PHONY: lfo upload_lfo niouze_lfo niouze_fm public -lfo: dist niouze_lfo lfo_upload +upload_index: index.shtml + rsync -avH index.shtml \ + /home/gilles/public_html/www.linux-france.org/html/prj/imapsync/ + sh ~/memo/lfo-rsync -lfo_upload: + +lfo: dist niouze_lfo upload_lfo + +upload_lfo: rsync -avH --delete . \ - /home/gilles/public_html/www.linux-france.org/html/prj/$(TARGET)/ + /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/$(TARGET)/ + /home/gilles/public_html/www.linux-france.org/ftp/prj/imapsync/ sh ~/memo/lfo-rsync niouze_lfo : VERSION diff --git a/README b/README index ff85705..34e7b63 100644 --- a/README +++ b/README @@ -1,19 +1,30 @@ NAME imapsync - IMAP synchronisation, sync, copy or migration tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. - More than 32 different IMAP server softwares supported with success. + More than 36 different IMAP server softwares supported with success. - $Revision: 1.337 $ + $Revision: 1.340 $ + +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 INSTALL imapsync works fine under any Unix OS with perl. - imapsync works fine under Windows (2000, XP) and ActiveState's 5.8 Perl + imapsync works fine under Windows (2000, XP) with ActiveState's 5.8 Perl + or as a standalone binary software. - imapsync is already available directly on the following distributions (at least): - FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva and OpenBSD (yeah!). + imapsync is already available directly on the following distributions + (at least): FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva + and OpenBSD (yeah!). Get imapsync at - http://www.linux-france.org/prj/imapsync/dist/ + http://www.linux-france.org/prj/imapsync/ You'll find a compressed tarball called imapsync-x.xx.tgz where x.xx is the version number. Untar the tarball where @@ -23,12 +34,12 @@ INSTALL 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 (for windows users) - - The freshmeat record is at http://freshmeat.net/projects/imapsync/ + http://www.linux-france.org/prj/imapsync/INSTALL -SYNOPSIS - imapsync [options] + The freshmeat record is at http://freshmeat.net/projects/imapsync/ + +USAGE + imapsync [options] To get a description of each option just run imapsync like this: @@ -76,7 +87,7 @@ SYNOPSIS [--pidfile ] [--tmpdir ] [--version] [--help] - + DESCRIPTION The command imapsync is a tool allowing incremental and recursive imap transfer from one mailbox to another. @@ -88,19 +99,19 @@ DESCRIPTION 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, same message size 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. + 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. + you just want to keep a "live" copy of B in A (--delete2 may help) OPTIONS To get a description of each option just invoke: @@ -229,30 +240,32 @@ BUG REPORT GUIDELINES Help us to help you: in your report, please include: - imapsync version. - - - output given with --debug --debugimap near the failure point. + + - output given with --debug --debugimap near the failure point. Isolate a message or two in a folder 'BUG' and use - --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 + + 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 + + - 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.) + + - 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 forget it. + Way" http://www.catb.org/~esr/faqs/smart-questions.html and then forget + it. IMAP SERVERS Failure stories reported with the following 4 imap servers: @@ -385,7 +398,7 @@ SIMILAR SOFTWARES see also tools/wonko_ruby_imapsync pop2imap : http://www.linux-france.org/prj/pop2imap/ - Feedback (good or bad) will always be welcome. + Feedback (good or bad) will often be welcome. - $Id: imapsync,v 1.337 2010/07/16 23:23:40 gilles Exp gilles $ + $Id: imapsync,v 1.340 2010/08/09 00:03:21 gilles Exp gilles $ diff --git a/TIME b/TIME index 5a78c86..9d95938 100644 --- a/TIME +++ b/TIME @@ -1,4 +1,8 @@ - +50 3 replies on list. +40 http://www.linux-france.org/prj/imapsync_list/threads.html#00582 +250 ietf imap5 discussion +30 refactoring +80 read RFC2683 - IMAP4 Implementation Recommendations 140 imapsync under win32 strawberry, pp (par::packer), imapsync.exe 300 imapsync under win32. test msw, environnement, using activestate 70 Profiling tests. Interresting results! diff --git a/TODO b/TODO index 564aa77..fdedec6 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: TODO,v 1.78 2010/07/14 13:37:02 gilles Exp gilles $ +# $Id: TODO,v 1.80 2010/08/09 01:15:44 gilles Exp gilles $ TODO file for imapsync ---------------------- @@ -21,6 +21,14 @@ Evaluate http://www.rackspace.com/apps/email_hosting/migrations http://www.yippiemove.com/ +Add a well described problem for each problem detected +and counted in error counter statistics. + +Add yahoo imap support: +http://elearningcentral.blogspot.com/2010/07/how-to-use-imapsync-with-yahoo-imap.html +http://www.bwebcentral.com/utils/imapsync-yahoo +See patches/imapsync-yahoo + DONE. Bugfix. Duplicate messages on host2 are not deleted with --delete2 Reason: "Skipping msg #120:508 in host2 folder INBOX.2005-INBOX (duplicate so we ignore this message)" diff --git a/VERSION b/VERSION index 02ce9f6..890cbb7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.337 +1.340 diff --git a/imapsync b/imapsync index 2cb6d44..ced1456 100755 --- a/imapsync +++ b/imapsync @@ -16,21 +16,34 @@ imapsync - IMAP synchronisation, sync, copy or migration tool. Synchronise mailboxes between two imap servers. Good -at IMAP migration. More than 32 different IMAP server softwares +at IMAP migration. More than 36 different IMAP server softwares supported with success. -$Revision: 1.337 $ +$Revision: 1.340 $ + +=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) and ActiveState's 5.8 Perl + imapsync works fine under Windows (2000, XP) with ActiveState's 5.8 Perl + or as a standalone binary software. - imapsync is already available directly on the following distributions (at least): - FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva and OpenBSD (yeah!). +imapsync is already available directly on the following distributions +(at least): +FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva and OpenBSD (yeah!). Get imapsync at - http://www.linux-france.org/prj/imapsync/dist/ + http://www.linux-france.org/prj/imapsync/ You'll find a compressed tarball called imapsync-x.xx.tgz where x.xx is the version number. Untar the tarball where @@ -40,13 +53,13 @@ $Revision: 1.337 $ 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 (for windows users) - + http://www.linux-france.org/prj/imapsync/INSTALL + The freshmeat record is at http://freshmeat.net/projects/imapsync/ -=head1 SYNOPSIS +=head1 USAGE - imapsync [options] + imapsync [options] To get a description of each option just run imapsync like this: @@ -112,7 +125,7 @@ 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, same message size +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 @@ -126,7 +139,8 @@ 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. +in case you just want to keep a "live" copy of B in A (--delete2 +may help) =head1 OPTIONS @@ -272,23 +286,24 @@ know you run windows(tm) and you haven't read the 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 - --folder 'BUG' --debug --debugimap - + + 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. @@ -296,7 +311,7 @@ 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 forget it. +and then forget it. =head1 IMAP SERVERS @@ -452,9 +467,9 @@ Entries for imapsync: pop2imap : http://www.linux-france.org/prj/pop2imap/ -Feedback (good or bad) will always be welcome. +Feedback (good or bad) will often be welcome. -$Id: imapsync,v 1.337 2010/07/16 23:23:40 gilles Exp gilles $ +$Id: imapsync,v 1.340 2010/08/09 00:03:21 gilles Exp gilles $ =cut @@ -542,7 +557,7 @@ my( # global variables initialisation -$rcs = '$Id: imapsync,v 1.337 2010/07/16 23:23:40 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.340 2010/08/09 00:03:21 gilles Exp gilles $ '; $total_bytes_transferred = 0; $total_bytes_skipped = 0; @@ -561,8 +576,9 @@ unless(defined(&_SYSEXITS_H)) { eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE); } -# @ARGV will be eat by get_options +# @ARGV will be eat by get_options() my @argv_copy = @ARGV; + get_options(); # default values @@ -634,17 +650,7 @@ sub localhost_info { } if ($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(); + justconnect(); exit_clean(0); } @@ -668,8 +674,8 @@ if ($syncinternaldates) { if ($syncinternaldates || $idatefromheader) { - # Date::Manip is an ugly module it exits (confess) for reading an unset value - # I should write a bug report but too lazy. + # Date::Manip is an ugly module: it exits (confess) for reading an unset value + # I should write a bug report but I'm too lazy. no warnings 'redefine'; local *Carp::confess = sub { return undef; }; @@ -1895,7 +1901,7 @@ Bye.' print "flags & date from: [$h1_flags][$d]\n"; last FOLDER if $imap1->IsUnconnected(); last FOLDER if $imap2->IsUnconnected(); - $d = undef; + $d = undef if ($d eq ""); unless ($dry) { if ($OSNAME eq "MSWin32") { @@ -2095,7 +2101,7 @@ exit_clean(0); # subroutines sub imapsync_version { - my $rcs = '$Id: imapsync,v 1.337 2010/07/16 23:23:40 gilles Exp gilles $ '; + my $rcs = '$Id: imapsync,v 1.340 2010/08/09 00:03:21 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; my $VERSION = ($1) ? $1: "UNKNOWN"; return($VERSION); @@ -2179,8 +2185,8 @@ sub banner_imapsync { my @argv_copy = @_; my $banner_imapsync = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.337 $ ', - '$Date: 2010/07/16 23:23:40 $ ', + '$Revision: 1.340 $ ', + '$Date: 2010/08/09 00:03:21 $ ', "\n",localhost_info(), "\n", "Command line used:\n", "$0 ", command_line_nopassword(@argv_copy), "\n", @@ -2216,6 +2222,22 @@ sub write_pidfile { return($PROCESS_ID); } +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 exit_clean { my $status = shift; diff --git a/index.shtml b/index.shtml index 77ce91f..e53520a 100644 --- a/index.shtml +++ b/index.shtml @@ -5,7 +5,7 @@ imapsync <!--#exec cmd="cat VERSION" --> - + @@ -16,26 +16,15 @@ - - -

imapsync web site

What is imapsync?

imapsync software is a command line tool allowing incremental and -recursive imap transfers from one mailbox to another. +recursive imap transfers from one mailbox to another, both anywhere on the internet.

+

AUTHOR

Gilles LAMIRAL
@@ -55,6 +44,7 @@ recursive imap transfers from one mailbox to another. for feedback.

+

imapsync donation

Happy with this free, open and gratis software?

Help the author to maintain imapsync and support users:

@@ -75,6 +65,7 @@ Or offer him a book on his Thanks in advance!

+

Latest release () @@ -94,6 +85,7 @@ thanks to Strawberry Perl 5.12 and Par::Packed module.

Frequently Asked Questions

+

MAILING-LIST

@@ -133,6 +125,7 @@ thanks to Strawberry Perl 5.12 and Par::Packed module.
Thank you for your participation!

+

TODO

I code new features for free when I have time and when I find it useful.
@@ -166,7 +159,7 @@ If you really want a feature you can donate money and I'll code it.
This document last modified
-$Id: index.shtml,v 1.14 2010/07/17 00:07:16 gilles Exp gilles $ +$Id: index.shtml,v 1.17 2010/07/26 23:40:00 gilles Exp gilles $

diff --git a/patches/imapsync-1.337_tobit_V6.patch b/patches/imapsync-1.337_tobit_V6.patch new file mode 100644 index 0000000..60ecc84 --- /dev/null +++ b/patches/imapsync-1.337_tobit_V6.patch @@ -0,0 +1,45 @@ +--- imapsync-1.337 2010-08-02 13:56:06.000000000 +0200 ++++ imapsync-1.337_tobit-workaround 2010-08-02 13:53:58.000000000 +0200 +@@ -3821,6 +3821,7 @@ + $banner; + } + ++ + # IMAPClient 2.2.9 3.xx ads + + package Mail::IMAPClient; +@@ -3869,3 +3870,33 @@ + #$self->Fast_io( $self->Fast_io ); + $sock; + } ++ ++sub search { ++ my ( $self, @args ) = @_; ++ ++ @args = $self->_quote_search(@args); ++ ++ $self->_imap_uid_command( SEARCH => @args ) ++ or return undef; ++ ++ my @hits; ++ foreach ( $self->History ) { ++ chomp; ++ s/$CR?$LF$//o; ++ s/^(\s*\d+)/* SEARCH $1/; ++ s/^\*\s+SEARCH\s+(?=.*?\d)// or next; ++ push @hits, grep /^\d+$/, split; ++ } ++ ++ @hits ++ or $self->_debug("Search successful but found no matching messages"); ++ ++ # return empty list ++ return ++ wantarray ? @hits ++ : !@hits ? \@hits ++ : $self->Ranges ? $self->Range( \@hits ) ++ : \@hits; ++} ++ ++ + diff --git a/patches/imapsync-yahoo b/patches/imapsync-yahoo new file mode 100644 index 0000000..bd06df8 --- /dev/null +++ b/patches/imapsync-yahoo @@ -0,0 +1,2430 @@ +#!/usr/bin/perl -w + +use lib '/usr/share/imapsync/'; + +=pod + +=head1 NAME + +imapsync - IMAP synchronisation, sync, copy or migration +tool. Synchronise mailboxes between two imap servers. Good +at IMAP migration. More than 32 different IMAP server softwares +supported with success. + +$Revision: 1.241 $ + +=head1 INSTALL + + imapsync works fine under any Unix OS with perl. + imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl + + imapsync is already available directly on the following distributions (at least): + FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva. + + Get imapsync at + http://www.linux-france.org/prj/imapsync/dist/ + + You'll find 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 (for windows users) + + The freshmeat record is at http://freshmeat.net/projects/imapsync/ + +=head1 SYNOPSIS + + 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] + [--authmech1 ] [--authmech2 ] + [--noauthmd5] + [--folder --folder ...] + [--folderrec --folderrec ...] + [--include ] [--exclude ] + [--prefix2 ] [--prefix1 ] + [--regextrans2 --regextrans2 ...] + [--sep1 ] + [--sep2 ] + [--justfolders] [--justfoldersizes] [--justconnect] + [--syncinternaldates] + [--buffersize ] + [--syncacls] + [--regexmess ] [--regexmess ] + [--maxsize ] + [--maxage ] + [--minage ] + [--skipheader ] + [--useheader ] [--useheader ] + [--skipsize] + [--delete] [--delete2] + [--expunge] [--expunge1] [--expunge2] + [--subscribed] [--subscribe] + [--nofoldersizes] + [--dry] + [--debug] [--debugimap] + [--timeout ] [--fast] + [--split1] [--split2] + [--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 transfered, recursively. + +We sometimes need to transfer mailboxes from one imap server to +another. This is called migration. + +imapsync is the adequate tool because it reduces the amount +of data transferred by not transferring a given message if it +is already on both sides. Same headers, same message size +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 is adapted to a bad +connection. 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. + +=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 loosing huge old mailboxes located on a far +away remote imap server accessible by a low bandwith link. The tool +imapcp (written in python) could not help me because I had to verify +every mailbox was well transferred and delete it after a good +transfer. imapsync started its life being 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" on host +"imap.src.fr" to the imap account "max" on host +"imap.dest.fr" (the passwords are located in two files +"/etc/secret1" for "buddy", "/etc/secret2" for "max") : + + imapsync --host1 imap.src.fr --user1 buddy --passfile1 /etc/secret1 \ + --host2 imap.dest.fr --user2 max --passfile2 /etc/secret2 + +Then, you will have max's mailbox updated from buddy's +mailbox. + +=head1 SECURITY + +You can use --password1 instead of --passfile1 to give the +password but it is dangerous because 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 in +case CRAM-MD5 is not supported by your imap servers. Use +--ssl1 and --ssl2 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. + + +=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 a buggy internet connection, you can use this loop +in a Bourne shell: + + while ! imapsync ...; do + echo imapsync not complete + done + +=head1 AUTHOR + +Gilles LAMIRAL + +Feedback good or bad is always welcome. + +The newsgroup comp.mail.imap is a good place to talk about +imapsync. I read it when imapsync is concerned. + +Gilles LAMIRAL earn his living writing, installing, +configuring and teaching free open and gratis +softwares. Do not hesitate to pay him for that services. + + +=head1 LICENSE + +imapsync is free, gratis and open source software cover by +the GNU General Public License. See the GPL file included in +the distribution or the web site +http://www.gnu.org/licenses/licenses.html + +=head1 BUGS + +No known serious bug. Report any bug to the author. +Before reporting bugs, read the FAQ, this README and the +TODO files. + +Don't write imapsync in uppercase in the email title, I'll +know you run windows. + +Make a good title, not just "imapsync" or "problem", +a good title is made of keywords summary, not too long (one visible line). + +In your report, please include: + + - imapsync version. + - IMAPClient.pm version. + - perl version. + - operating system running imapsync. + - imap servers softwares on both side and their version. + + Those values can be found with the command line + + imapsync --host1 imap.host1.net --host2 imap.host2.org --justconnect + + And also, if it can help : + + - operating systems on both sides and the third side in case + you run imapsync on a foreign host from the both. + - imapsync with all the options you use, the full command line + you use (except the passwords of course). This can be found + at the beginning of the output. + - output given with --debug --debugimap near the failure point. + +=head1 IMAP SERVERS + +Failure stories reported with the following 4 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 35 imap servers +(softwares names are in alphabetic order) : + + - Archiveopteryx 2.03, 2.04 (OSL 3.0) http://www.archiveopteryx.org/ + - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) + - CommuniGatePro server (Redhat 8.0) + - 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, + (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 [from] + - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, + 1.0.0 [dest] (LGPL) (http://www.dovecot.org/) + - Domino (Notes) 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1 [from] + - Eudora WorldMail v2 + - GMX IMAP4 StreamProxy. + - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the 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) + - Mercury 4.1 (Windows server 2000 platform) + - Microsoft Exchange Server 5.5, 6.5.7638.1 [dest] + - Netscape Mail Server 3.6 (Wintel !) + - Netscape Messaging Server 4.15 Patch 7 + - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) + - OpenWave + - 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 + - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) + - Sun Java System Messaging Server 6.2-2.05 + - 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. + +Please report to the author any success or bad story with +imapsync and don't 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: + + From software :* OK louloutte Cyrus IMAP4 v1.5.19 server ready + To 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 + +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 + + +Have a special attention on options +--subscribed +--subscribe +--delete +--delete2 +--expunge +--expunge1 +--expunge2 +--maxage +--minage +--maxsize +--useheader + +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 content is : + +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 GPL 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 be always welcome. + +$Id: imapsync,v 1.241 2007/12/31 13:39:02 gilles Exp gilles $ + + + +=cut + + +++$|; +use strict; +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 POSIX qw(uname); +use Fcntl; + +#use Test::Simple tests => 1; +use Test::More 'no_plan'; + +eval { require 'usr/include/sysexits.ph' }; + + +my( + $rcs, $debug, $debugimap, $error,$is_yahoo, + $host1, $host2, $port1, $port2, + $user1, $user2, $password1, $password2, $passfile1, $passfile2, + @folder, @include, @exclude, @folderrec, + $prefix1, $prefix2, + @regextrans2, @regexmess, @regexflag, + $sep1, $sep2, + $syncinternaldates, $syncacls, + $fastio1, $fastio2, + $maxsize, $maxage, $minage, + $skipheader, @useheader, + $skipsize, $foldersizes, $buffersize, + $delete, $delete2, + $expunge, $expunge1, $expunge2, $dry, + $justfoldersizes, + $authmd5, + $subscribed, $subscribe, + $version, $VERSION, $help, + $justconnect, $justfolders, + $fast, + $mess_size_total_trans, + $mess_size_total_skipped, + $mess_size_total_error, + $mess_trans, $mess_skipped, $mess_skipped_dry, + $timeout, # whr (ESS/PRW) + $timestart, $timeend, $timediff, + $timesize, $timebefore, + $ssl1, $ssl2, + $authuser1, $authuser2, + $authmech1, $authmech2, + $split1, $split2, + $tests, $test_builder, +); + +use vars qw ($opt_G); # missing code for this will be option. + + +$rcs = ' $Id: imapsync,v 1.241 2007/12/31 13:39:02 gilles Exp gilles $ '; +$rcs =~ m/,v (\d+\.\d+)/; +$VERSION = ($1) ? $1 : "UNKNOWN"; + +my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION; + +check_lib_version() or + die "imapsync needs perl lib Mail::IMAPClient release 2.2.9 exactly, future imapsync release may suppoort 3.0.x, but sorry not now\n"; + + +$mess_size_total_trans = 0; +$mess_size_total_skipped = 0; +$mess_size_total_error = 0; +$mess_trans = $mess_skipped = $mess_skipped_dry = 0; + + +sub check_lib_version { + if ($VERSION_IMAPClient =~ m/(\d+)\.(\d+)\.(\d+)/) { + $debug and print "VERSION_IMAPClient $1 $2 $3\n"; + #my($major,$minor,$sub) = ($1, $2, $3); + + return(1) if($VERSION_IMAPClient eq '2.2.9'); + + } + else{ + return 0; # don't match regex => bad + } +} + +$error=0; + +my $banner = join("", + '$RCSfile: imapsync,v $ ', + '$Revision: 1.241 $ ', + '$Date: 2007/12/31 13:39:02 $ ', + "\n",localhost_info(), + " and the module Mail::IMAPClient version used here is ", + $VERSION_IMAPClient,"\n", + "Command line used :\n", + "$0 @ARGV\n", + ); + +unless(defined(&_SYSEXITS_H)) { + # 64 on my linux box. + eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE); +} + +get_options(); +print $banner; + +sub missing_option { + my ($option) = @_; + die "$option option must be used, run $0 --help for help\n"; +} + +# By default, 1000 at a time, not more. +$split1 ||= 1000; +$split2 ||= 1000; + +$host1 || missing_option("--host1") ; +# $port1 = (defined($port1)) ? $port1 : 143; +$port1 ||= defined $ssl1 ? 993 : 143; + +$host2 || missing_option("--host2") ; +# $port2 = (defined($port2)) ? $port2 : 143; +$port2 ||= defined $ssl2 ? 993 : 143; + +sub connect_imap { + my($host, $port, $debugimap) = @_; + my $imap = Mail::IMAPClient->new(); + $imap->Server($host); + $imap->Port($port); + $imap->Debug($debugimap); + $imap->connect2() + or die "Can not open imap connection on [$host] : $@\n"; +} + +sub localhost_info { + + my($infos) = join("", + "Here is a [$OSNAME] system (", + join(" ", + uname(), + ), + ")\n", + "with perl ", + sprintf("%vd", $PERL_VERSION)); + return($infos); + +} + +if ($justconnect) { + my $from = (); + my $to = (); + + $from = connect_imap($host1, $port1); + print "From software : ", server_banner($from); + print "From capability : ", join(" ", $from->capability()), "\n"; + $to = connect_imap($host2, $port2); + print "To software : ", server_banner($to); + print "To capability : ", join(" ", $to->capability()), "\n"; + $from->logout(); + $to->logout(); + exit(0); +} + +$user1 || missing_option("--user1"); +$user2 || missing_option("--user2"); + +if(defined($authmd5) and not($authmd5)) { + $authmech1 ||= 'LOGIN'; + $authmech2 ||= 'LOGIN'; +} +else{ + $authmech1 ||= $authuser1 ? 'PLAIN' : 'CRAM-MD5'; + $authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5'; +} + +$authmech1 = uc($authmech1); +$authmech2 = uc($authmech2); + +$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; + + +@useheader = ("ALL") unless (@useheader); + +print "From imap server [$host1] port [$port1] user [$user1]\n"; +print "To imap server [$host2] port [$port2] user [$user2]\n"; + + +sub ask_for_password { + require Term::ReadKey; + 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; +} + + +$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 $from = (); +my $to = (); + +$timestart = time(); +$timebefore = $timestart; + +$debugimap and print "From connection\n"; +$from = login_imap($host1, $port1, $user1, $password1, + $debugimap, $timeout, $fastio1, $ssl1, + $authmech1, $authuser1); + +$debugimap and print "To connection\n"; +$to = login_imap($host2, $port2, $user2, $password2, + $debugimap, $timeout, $fastio2, $ssl2, + $authmech2, $authuser2); + +# history + +$debug and print "From Buffer I/O : ", $from->Buffer(), "\n"; +$debug and print "To Buffer I/O : ", $to->Buffer(), "\n"; + + +sub login_imap { + my($host, $port, $user, $password, + $debugimap, $timeout, $fastio, + $ssl, $authmech, $authuser) = @_; + my ($imap); + if ($ssl) { + require IO::Socket::SSL; + my $socssl = new IO::Socket::SSL("$host:$port"); + die "Error connecting to $host:$port: $@\n" unless $socssl; + $socssl->autoflush(1); + + $imap = Mail::IMAPClient->new( + Socket => $socssl, + Server => $host, + ); + } + else { + $imap = Mail::IMAPClient->new(); + } + $imap->Clear(20); + $imap->Server($host); + $imap->Port($port); + $imap->Fast_io($fastio); + $imap->Buffer($buffersize || 4096); + $imap->Uid(1); + $imap->Peek(1); + $imap->Debug($debugimap); + $timeout and $imap->Timeout($timeout); + + if ($ssl) { + $imap->State(Mail::IMAPClient::Connected); + } + else { + $imap->connect2() + or die "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"; + } + } + + $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); + $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; + + $imap->User($user); + $imap->Authuser($authuser); + $imap->Password($password); + $is_yahoo = 0; + $is_yahoo = index($host,"yahoo"); + # Allow Login to Yahoo www.bwebcentral.com + + + unless ($imap->login2()) { + print "Error login : [$host] with user [$user] auth [$authmech]: $@\n"; + die if ($authmech eq 'LOGIN'); + die if $imap->IsUnconnected(); + print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n"; + $imap->Authmechanism(""); + $imap->login2() or + die "Error login : [$host] with user [$user] auth [LOGIN] : $@"; + } + 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; + for my $line ($imap->Results()) { + #print "LR: $line"; + return $line if $line =~ /^\* (OK|NO|BAD)/; + } + return "No banner\n"; + } + + + +print "From capability : ", join(" ", $from->capability()), "\n"; +print "To capability : ", join(" ", $to->capability()), "\n"; + +die unless $from->IsAuthenticated(); +print "From state Authenticated\n"; +die unless $to->IsAuthenticated(); +print "To state Authenticated\n"; + +$split1 and $from->Split($split1); +$split2 and $to->Split($split2); + +# +# Folder stuff +# + +my (@f_folders, %requested_folder, @t_folders, %subscribed_folder, %t_folders); + +sub tests_folder_routines { + ok( !give_requested_folders() ,"no requested folders" ); + 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') ); + ok( init_requested_folders() , 'empty requested folders'); + ok( !give_requested_folders() , 'no requested folders' ); +} + +sub give_requested_folders { + return(keys(%requested_folder)); +} + +sub init_requested_folders { + + %requested_folder = (); + return(1); + +} + +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) ); +} + + +# Make a hash of subscribed folders in source server. +map { $subscribed_folder{$_} = 1 } $from->subscribed(); + + +my @all_source_folders = sort $from->folders(); + +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($from->folders($folderrec)); + } + } +} +else { + + # no include, no folder/subscribed/folderrec options => all folders + if (not scalar(@include)) { + add_to_requested_folders(@all_source_folders); + } +} + + +# consider (optional) includes and excludes +if (scalar(@include)) { + foreach my $include (@include) { + my @included_folders = grep /$include/, @all_source_folders; + 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"; + } +} + + +my @requested_folder = sort(keys(%requested_folder)); + +@f_folders = @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 (! $list_1_ref); # end if no list + return(1) if (! $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 = 0; + 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([]) , 'compare_lists, [] > nothing'); + ok(+1 == compare_lists([], undef) , 'compare_lists, [] > undef'); + ok( 0 == compare_lists([] , []) , 'compare_lists, [] = []'); + + 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( 1 , 2 ) , "compare_lists, 1 = 1 ") ; + ok(+1 == compare_lists( 2 , 1 ) , "compare_lists, 1 = 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([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"]') ; +} + + +@t_folders = sort @{$to->folders()}; + +my($f_sep,$t_sep); +# what are the private folders separators for each server ? + + +$debug and print "Getting separators\n"; +$f_sep = get_separator($from, $sep1, "--sep1"); +$t_sep = get_separator($to, $sep2, "--sep2"); + +#my $f_namespace = $from->namespace(); +#my $t_namespace = $to->namespace(); +#$debug and print "From namespace:\n", Data::Dumper->Dump([$f_namespace]); +#$debug and print "To namespace:\n", Data::Dumper->Dump([$t_namespace]); + +my($f_prefix,$t_prefix); +$f_prefix = get_prefix($from, $prefix1, "--prefix1"); +$t_prefix = get_prefix($to, $prefix2, "--prefix2"); + +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(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); + } + else{ + print + "No NAMESPACE capability in imap server ", + $imap->Server(),"\n", + "Give the separator caracter with the $sep_opt option\n"; + exit(1); + } +} + + +print "From separator and prefix : [$f_sep][$f_prefix]\n"; +print "To separator and prefix : [$t_sep][$t_prefix]\n"; + + +sub foldersizes { + + my ($side, $imap, $folders_r) = @_; + my $tot = 0; + my $tmess = 0; + my @folders = @{$folders_r}; + 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->select($folder)) { + warn + "$side Folder $folder : Could not select ", + $imap->LastError, "\n"; + $error++; + next; + } + if (defined($maxage) or defined($minage)) { + # The pb is fetch_hash() can only be applied on ALL messages + my @msgs = select_msgs($imap); + $smess = scalar(@msgs); + foreach my $m (@msgs) { + my $s = $imap->size($m) + or warn "Could not find size of message $m: $@\n"; + $stot += $s; + } + } + else{ + my $hashref = {}; + $smess = $imap->message_count(); + unless ($smess == 0) { + #$imap->Ranges(1); + $imap->fetch_hash2("RFC822.SIZE",$hashref) or die "$@"; + #$imap->Ranges(0); + #print map {$hashref->{$_}->{"RFC822.SIZE"}, " "} keys %$hashref; + map {$stot += $hashref->{$_}->{"RFC822.SIZE"}} keys %$hashref; + } + } + 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"; +} + + +foreach my $f_fold (@f_folders) { + my $t_fold; + $t_fold = to_folder_name($f_fold); + $t_folders{$t_fold}++; +} + +@t_folders = sort keys(%t_folders); + + +if ($foldersizes) { + foldersizes("From", $from, \@f_folders); + foldersizes("To ", $to, \@t_folders); +} + + + + +sub timenext { + my ($timenow, $timerel); + # $timebefore is global, beurk ! + $timenow = time; + $timerel = $timenow - $timebefore; + $timebefore = $timenow; + return($timerel); +} + +exit if ($justfoldersizes); + +# needed for setting flags +my $tohasuidplus = $to->has_capability("UIDPLUS"); + + + +print + "++++ Listing folders ++++\n", + "From folders list : ", map("[$_] ",@f_folders),"\n", + "To folders list : ", map("[$_] ",@t_folders),"\n"; + +print + "From subscribed folders list : ", + map("[$_] ", sort keys(%subscribed_folder)), "\n" + if ($subscribed); + +sub separator_invert { + # The separator we hope we'll never encounter + my $o_sep="\000"; + + my($f_fold, $f_sep, $t_sep) = @_; + + my $t_fold = $f_fold; + $t_fold =~ s@\Q$t_sep@$o_sep@g; + $t_fold =~ s@\Q$f_sep@$t_sep@g; + $t_fold =~ s@\Q$o_sep@$f_sep@g; + return($t_fold); +} + +sub to_folder_name { + my ($t_fold); + my ($x_fold) = @_; + # first we remove the prefix + $x_fold =~ s/^$f_prefix//; + $debug and print "removed source prefix : [$x_fold]\n"; + $t_fold = separator_invert($x_fold,$f_sep, $t_sep); + $debug and print "inverted separators : [$t_fold]\n"; + # Adding the prefix supplied by namespace or the --prefix2 option + $t_fold = $t_prefix . $t_fold + unless(($t_prefix eq "INBOX.") and ($t_fold =~ m/^INBOX$/i)); + $debug and print "added target prefix : [$t_fold]\n"; + + # Transforming the folder name by the --regextrans2 option(s) + foreach my $regextrans2 (@regextrans2) { + $debug and print "eval \$t_fold =~ $regextrans2\n"; + eval("\$t_fold =~ $regextrans2"); + } + return($t_fold); +} + +sub flags_regex { + my ($flags_f) = @_; + foreach my $regexflag (@regexflag) { + $debug and print "eval \$flags_f =~ $regexflag\n"; + eval("\$flags_f =~ $regexflag"); + } + return($flags_f); +} + +sub acls_sync { + my($f_fold, $t_fold) = @_; + if ($syncacls) { + my $f_hash = $from->getacl($f_fold) + or warn "Could not getacl for $f_fold: $@\n"; + my $t_hash = $to->getacl($t_fold) + or warn "Could not getacl for $t_fold: $@\n"; + my %users = map({ ($_, 1) } (keys(%$f_hash), keys(%$t_hash))); + foreach my $user (sort(keys(%users))) { + my $acl = $f_hash->{$user} || "none"; + print "acl $user : [$acl]\n"; + next if ($f_hash->{$user} && $t_hash->{$user} && + $f_hash->{$user} eq $t_hash->{$user}); + unless ($dry) { + print "setting acl $t_fold $user $acl\n"; + $to->setacl($t_fold, $user, $acl) + or warn "Could not set acl: $@\n"; + } + } + } +} + + +print "++++ Looping on each folder ++++\n"; + +FOLDER: foreach my $f_fold (@f_folders) { + my $t_fold; + print "From Folder [$f_fold]\n"; + $t_fold = to_folder_name($f_fold); + print "To Folder [$t_fold]\n"; + + last FOLDER if $from->IsUnconnected(); + last FOLDER if $to->IsUnconnected(); + + unless ($from->select($f_fold)) { + warn + "From Folder $f_fold : Could not select ", + $from->LastError, "\n"; + $error++; + next FOLDER; + } + + unless ($to->exists($t_fold) or $to->select($t_fold)) { + print "To Folder $t_fold does not exist\n"; + print "Creating folder [$t_fold]\n"; + unless ($dry){ + unless ($to->create($t_fold)){ + warn "Couldn't create [$t_fold]", + $to->LastError,"\n"; + $error++; + next FOLDER; + } + } + else{ + next FOLDER; + } + } + + acls_sync($f_fold, $t_fold); + + unless ($to->select($t_fold)) { + warn + "To Folder $t_fold : Could not select ", + $to->LastError, "\n"; + $error++; + next FOLDER; + } + + if ($expunge){ + print "Expunging $f_fold and $t_fold\n"; + unless($dry) { $from->expunge() }; + #unless($dry) { $to->expunge() }; + } + + if ($subscribe and exists $subscribed_folder{$f_fold}) { + print "Subscribing to folder $t_fold on destination server\n"; + unless($dry) { $to->subscribe($t_fold) }; + } + + next FOLDER if ($justfolders); + + last FOLDER if $from->IsUnconnected(); + last FOLDER if $to->IsUnconnected(); + + my @f_msgs = select_msgs($from); + + + + $debug and print "LIST FROM : ", scalar(@f_msgs), " messages [@f_msgs]\n"; + # internal dates on "TO" are after the ones on "FROM" + # normally... + my @t_msgs = select_msgs($to); + + $debug and print "LIST TO : ", scalar(@t_msgs), " messages [@t_msgs]\n"; + + my %f_hash = (); + my %t_hash = (); + + print "++++ From [$f_fold] Parse 1 ++++\n"; + last FOLDER if $from->IsUnconnected(); + last FOLDER if $to->IsUnconnected(); + + my $f_heads = $from->parse_headers2([@f_msgs], + @useheader)if (@f_msgs) ; + $debug and print "Time headers: ", timenext(), " s\n"; + my $f_fir = $from->fetch_hash2("FLAGS", + "INTERNALDATE", + "RFC822.SIZE") if (@f_msgs); + $debug and print "Time fir : ", timenext(), " s\n"; + + foreach my $m (@f_msgs) { + parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash); + } + $debug and print "Time headers: ", timenext(), " s\n"; + + print "++++ To [$t_fold] Parse 1 ++++\n"; + last FOLDER if $from->IsUnconnected(); + last FOLDER if $to->IsUnconnected(); + + my $t_heads = $to->parse_headers2([@t_msgs], + @useheader) if (@t_msgs); + $debug and print "Time headers: ", timenext(), " s\n"; + my $t_fir = $to->fetch_hash2("FLAGS", + "INTERNALDATE", + "RFC822.SIZE") if (@t_msgs); + $debug and print "Time fir : ", timenext(), " s\n"; + foreach my $m (@t_msgs) { + parse_header_msg1($to, $m, $t_heads, $t_fir, "T", \%t_hash); + } + $debug and print "Time headers: ", timenext(), " s\n"; + + print "++++ Verifying [$f_fold] -> [$t_fold] ++++\n"; + # messages in "from" that are not good in "to" + + my @f_hash_keys_sorted_by_uid + = sort {$f_hash{$a}{'m'} <=> $f_hash{$b}{'m'}} keys(%f_hash); + + #print map { $f_hash{$_}{'m'} . " "} @f_hash_keys_sorted_by_uid; + + my @t_hash_keys_sorted_by_uid + = sort {$t_hash{$a}{'m'} <=> $t_hash{$b}{'m'}} keys(%t_hash); + + + if($delete2) { + foreach my $m_id (@t_hash_keys_sorted_by_uid) { + #print "$m_id "; + unless (exists($f_hash{$m_id})) { + my $t_msg = $t_hash{$m_id}{'m'}; + print "deleting message $m_id $t_msg\n"; + $to->delete_message($t_msg) unless ($dry); + } + } + } + + MESS: foreach my $m_id (@f_hash_keys_sorted_by_uid) { + my $f_size = $f_hash{$m_id}{'s'}; + my $f_msg = $f_hash{$m_id}{'m'}; + my $f_idate = $f_hash{$m_id}{'D'}; + + if (defined $maxsize and $f_size > $maxsize) { + print "+ Skipping msg #$f_msg:$f_size in folder $f_fold (exceeds maxsize limit $maxsize bytes)\n"; + $mess_size_total_skipped += $f_size; + $mess_skipped += 1; + next MESS; + } + $debug and print "+ key $m_id #$f_msg\n"; + unless (exists($t_hash{$m_id})) { + print "+ NO msg #$f_msg [$m_id] in $t_fold\n"; + # copy + print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n"; + last FOLDER if $from->IsUnconnected(); + #my $string = $from->message_string($f_msg); + my $message_file = "tmp_imapsync_$$"; + unlink($message_file); + $from->message_to_file($message_file, $f_msg); + my $string = file_to_string($message_file); + #unlink($message_file); + if (@regexmess) { + foreach my $regexmess (@regexmess) { + $debug and print "eval \$string =~ $regexmess\n"; + eval("\$string =~ $regexmess"); + } + string_to_file($string, $message_file); + } + $debug and print "F message content begin next line\n", + $string, + "F message content ended on previous line\n"; + my $d = ""; + if ($syncinternaldates) { + $d = $f_idate; + $debug and print "internal date from 1: [$d]\n"; + require Date::Manip; + Date::Manip->import(qw(ParseDate Date_Cmp UnixDate)); + $d = UnixDate(ParseDate($d), "%d-%b-%Y %H:%M:%S %z"); + $d = "\"$d\""; + $debug and print "internal date from 1: [$d] (fixed)\n"; + } + + my $flags_f = $f_hash{$m_id}{'F'} || ""; + # RFC 2060 : This flag can not be altered by any client + $flags_f =~ s@\\Recent@@gi; + $flags_f = flags_regex($flags_f) if @regexflag; + + my $new_id; + print "flags from : [$flags_f][$d]\n"; + last FOLDER if $to->IsUnconnected(); + unless ($dry) { + + if ($OSNAME eq "MSWin32") { + $new_id = $to->append_string($t_fold,$string, $flags_f, $d); + } + else { + $new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d); + } + unless($new_id){ + warn "Couldn't append msg #$f_msg (Subject:[". + $from->subject($f_msg)."]) to folder $t_fold: ", + $to->LastError, "\n"; + $error++; + $mess_size_total_error += $f_size; + next MESS; + } + else{ + # good + # $new_id is an id if the IMAP server has the + # UIDPLUS capability else just a ref + print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n"; + $mess_size_total_trans += $f_size; + $mess_trans += 1; + if($delete) { + print "Deleting msg #$f_msg in folder $f_fold\n"; + $from->delete_message($f_msg) unless ($dry); + $from->expunge() if ($expunge and not $dry); + } + } + } + else{ + $mess_skipped_dry += 1; + } + unlink($message_file); + next MESS; + } + else{ + $debug and print "Message id [$m_id] found in t:$t_fold\n"; + $mess_size_total_skipped += $f_size; + $mess_skipped += 1; + } + + $fast and next MESS; + #$debug and print "MESSAGE $m_id\n"; + my $t_size = $t_hash{$m_id}{'s'}; + my $t_msg = $t_hash{$m_id}{'m'}; + + + $debug and print "Setting flags\n"; + last FOLDER if $from->IsUnconnected(); + last FOLDER if $to->IsUnconnected(); + + my (@flags_f,@flags_t); + my $flags_f_rv = $from->flags($f_msg); + @flags_f = @{$flags_f_rv} if ref($flags_f_rv); + + # No flag \Recent here, no ? + my $flags_f = join(" ", @flags_f); + + $flags_f = flags_regex($flags_f) if @regexflag; + + # This add or change flags but no flag are removed with this + $to->store($t_msg, + "+FLAGS (" . $flags_f . ")" + ) unless ($dry) ; + + my $flags_t_rv = $to->flags($t_msg); + @flags_t = @{$flags_t_rv} if ref($flags_t_rv); + my $flags_t = join(" ", @flags_t); + $debug and print + "flags from : $flags_f\n", + "flags to : $flags_t\n"; + + + $debug and do { + print "Looking dates\n"; + #my $d_f = $from->internaldate($f_msg); + #my $d_t = $to->internaldate($t_msg); + my $d_f = $f_hash{$m_id}{'D'}; + my $d_t = $t_hash{$m_id}{'D'}; + print + "idate from : $d_f\n", + "idate to : $d_t\n"; + + #unless ($d_f eq $d_t) { + # print "!!! Dates differ !!!\n"; + #} + }; + unless (($f_size == $t_size) or $skipsize) { + # Bad size + print + "Message $m_id SZ_BAD f:$f_msg:$f_size t:$t_msg:$t_size\n"; + # delete in to and recopy ? + # NO recopy CODE HERE. to be written if needed. + $error++; + if ($opt_G){ + print "Deleting msg f:#$t_msg in folder $t_fold\n"; + $to->delete_message($t_msg) unless ($dry); + } + } + else { + # Good + $debug and print + "Message $m_id SZ_GOOD f:$f_msg:$f_size t:$t_msg:$t_size\n"; + if($delete) { + print "Deleting msg #$f_msg in folder $f_fold\n"; + $from->delete_message($f_msg) unless ($dry); + $from->expunge() if ($expunge and not $dry); + } + } + } + if ($expunge1){ + print "Expunging source folder $f_fold\n"; + unless($dry) { $from->expunge() }; + } + if ($expunge2){ + print "Expunging target folder $t_fold\n"; + unless($dry) { $to->expunge() }; + } + +print "Time : ", timenext(), " s\n"; +} +$from->logout(); +$to->logout(); + +$timeend = time(); + +$timediff = $timeend - $timestart; + +stats(); + + + + +exit(1) if($error); + +sub select_msgs { + my ($imap) = @_; + my (@msgs,@max,@min,@union,@inter); + + unless (defined($maxage) or defined($minage)) { + @msgs = $imap->search("ALL"); + 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 stats { + print "++++ Statistics ++++\n"; + print "Time : $timediff sec\n"; + print "Messages transferred : $mess_trans "; + print "(could be $mess_skipped_dry without dry mode)" if ($dry); + print "\n"; + print "Messages skipped : $mess_skipped\n"; + print "Total bytes transferred: $mess_size_total_trans\n"; + print "Total bytes skipped : $mess_size_total_skipped\n"; + print "Total bytes error : $mess_size_total_error\n"; + print "Detected $error errors\n"; + print "Please, rate imapsync at http://freshmeat.net/projects/imapsync/\n"; + print "?Happy with this free, open source and gratis GPL software?\n", + "Feel free to thank the author by giving him a book:\n", + "http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/\n", + "(or its paypal account gilles.lamiral\@laposte.net)\n"; + + +} + + +sub get_options +{ + my $numopt = scalar(@ARGV); + my $opt_ret = GetOptions( + "debug!" => \$debug, + "debugimap!" => \$debugimap, + "host1=s" => \$host1, + "host2=s" => \$host2, + "port1=i" => \$port1, + "port2=i" => \$port2, + "user1=s" => \$user1, + "user2=s" => \$user2, + "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, + "syncinternaldates!" => \$syncinternaldates, + "syncacls!" => \$syncacls, + "maxsize=i" => \$maxsize, + "maxage=i" => \$maxage, + "minage=i" => \$minage, + "buffersize=i" => \$buffersize, + "foldersizes!" => \$foldersizes, + "dry!" => \$dry, + "expunge!" => \$expunge, + "expunge1!" => \$expunge1, + "expunge2!" => \$expunge2, + "subscribed!" => \$subscribed, + "subscribe!" => \$subscribe, + "justconnect!"=> \$justconnect, + "justfolders!"=> \$justfolders, + "justfoldersizes!" => \$justfoldersizes, + "fast!" => \$fast, + "version" => \$version, + "help" => \$help, + "timeout=i" => \$timeout, + "skipheader=s" => \$skipheader, + "useheader=s" => \@useheader, + "skipsize!" => \$skipsize, + "fastio1!" => \$fastio1, + "fastio2!" => \$fastio2, + "ssl1!" => \$ssl1, + "ssl2!" => \$ssl2, + "authmech1=s" => \$authmech1, + "authmech2=s" => \$authmech2, + "authuser1=s" => \$authuser1, + "authuser2=s" => \$authuser2, + "split1=i" => \$split1, + "split2=i" => \$split2, + "tests" => \$tests, + ); + + $debug and print "get options: [$opt_ret]\n"; + + $test_builder = Test::More->builder; + $test_builder->no_ending(1); + + # just the version + print "$VERSION\n" and exit if ($version) ; + + if ($tests) { + $test_builder->no_ending(0); + tests(); + exit; + } + + + # 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 parse_header_msg1 { + 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 \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 ?) + # and uppercase header keywords + # (dbmail and dovecot) + $val =~ s/^\s*(.+)$/$1/; + my $H = uc($h); + # show stuff in debug mode + $debug and print "${s}H $H:", $val, "\n"; + if ($skipheader and $H =~ m/$skipheader/i) { + $debug and print "Skipping header $h\n"; + next; + } + $headstr .= "$H:". $val; + } + } + #return unless ($headstr); + unless ($headstr){ + print "no header so taking everything\n"; + $headstr = $imap->message_string($m_uid); + } + 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"; + } + $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("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("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("$! $file"); + print FILE $string; + close FILE; +} + + + +sub usage { + my $localhost_info = localhost_info(); + print < : "from" imap server. Mandatory. +--port1 : port to connect on host1. Default is 143. +--user1 : user to login on host1. Mandatory. +--authuser1 : user to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. +--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). +--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. +--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. +--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 source imap 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 on the destination imap server that + are not on the source server. +--expunge : expunge messages on source account. + expunge really deletes messages marked deleted. + expunge is made at the beginning on the + source server only. newly transferred messages + are expunged if option --expunge is given. + no expunge is done on destination account but + it will change in future releases. +--expunge1 : expunge messages on source account. +--expunge2 : expunge messages on target account. +--syncinternaldates : sets the internal dates on host2 same as host1 +--buffersize : sets the size of a block of I/O. +--maxsize : skip messages larger 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. +--dry : do nothing, just print what would be done. +--subscribed : transfers subscribed folders. +--subscribe : subscribe to the folders transferred on the + "destination" server that are subscribed + on the "source" server. +--(no)foldersizes : Calculate the size of each "From" folder in bytes + and message counts. Meant to be used with + --justfoldersizes. Turned on by default. +--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. +--debugimap : imap debug mode. +--version : print software version. +--justconnect : just connect to both servers and print useful + information. Need only --host1 and --host2 options. +--justfolders : just do things about folders (ignore messages). +--fast : be faster (just does not sync flags). +--split1 : split the requests in several parts on source server. + is the number of messages handled per request. + default is like --split1 1000 +--split2 : same thing on the "destination" server. +--fastio1 : use fastio with the "from" server. +--fastio2 : use fastio with the "destination" server. +--timeout : imap connect timeout. +--help : print this. + +Example: to synchronise imap account "foo" on "imap.truc.org" + to imap account "bar" on "imap.trac.org" + +$0 \\ + --host1 imap.truc.org --user1 foo --passfile1 /etc/secret1 \\ + --host2 imap.trac.org --user2 bar --passfile2 /etc/secret2 + +$localhost_info + Mail::IMAPClient version is $Mail::IMAPClient::VERSION +$rcs + imapsync copyleft is the GNU General Public License. + See http://www.gnu.org/copyleft/gpl.html +http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ +EOF +} + + +sub tests { + + SKIP: { + skip "No test in normal run" if (not $tests); + tests_folder_routines(); + tests_compare_lists(); + } +} + + +package Mail::IMAPClient; + + +sub Authuser { + my $self = shift; + + if (@_) { $self->{AUTHUSER} = shift } + return $self->{AUTHUSER}; +} + + +sub Split { + my $self = shift; + + if (@_) { $self->{SPLIT} = shift } + return $self->{SPLIT}; +} + +# From IMAPClient.pm +sub append_file2 { + + 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: $!" if $^W; + 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] if $^W; + $self->State(Unconnected); + $fh->close; + return undef ; + } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { + carp $o->[DATA] if $^W; + $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] if $^W; + $self->State(Unconnected); + $fh->close; + return undef ; + } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { + carp $o->[DATA] if $^W; + $fh->close; + return undef; + } + } + } + $fh->close; + + if ($code !~ /^OK/i) { + return undef; + } + + + return defined($uid) ? $uid : $self; +} + +# From IMAPClient.pm +sub fetch_hash2 { + # 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 $msgref_all = scalar($self->messages); + my $split = $self->Split() || scalar(@$msgref_all); + while(my @msgs = splice(@$msgref_all, 0, $split)) { + #print "SPLIT: @msgs\n"; + my $msgref = \@msgs; + my $output = scalar($self->fetch($msgref,"(" . 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; +} + + +# From IMAPClient.pm + +sub login2 { + my $self = shift; + return $self->authenticate2($self->Authmechanism,$self->Authcallback) + if $self->{Authmechanism}; + + my $id = $self->User; + my $has_quotes = $id =~ /^".*"$/ ? 1 : 0; + print "Yahoo: $is_yahoo"; + if ($is_yahoo > 0) + { + print "Yahoo found, sending magic Yahoo command\n"; + $self->_imap_command("ID (\"GUID\" \"1\")"); + } + 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; +} + +# From IMAPClient.pm + +sub parse_headers2 { + my($self,$msgspec_all,@fields) = @_; + my(%fieldmap) = map { ( lc($_),$_ ) } @fields; + my $msg; my $string; my $field; + + unless(ref($msgspec_all) eq 'ARRAY') { + print "parse_headers2 want an ARRAY ref\n"; + exit 1; + } + + 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) { + local($^W) = undef; + 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$//; + if ($hdr =~ s/^(\S+):\s*//) { + $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; + push @{$h->{$field}} , $hdr ; + } elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) { + $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; + push @{$h->{$field}} , $hdr ; + } elsif ( ref($h->{$field}) eq 'ARRAY') { + + $hdr =~ s/^\s+/ /; + $h->{$field}[-1] .= $hdr ; + } + } + } + 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; + +} + + +# From IMAPClient.pm + +sub authenticate2 { + + 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 ; + } + } + } + + return undef if $code =~ /^BAD|^NO/ ; + + 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 if $^W; + } + else { + $response = \&_cram_md5_2; + } + } + + + $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 ; + +} + +sub _cram_md5_2 { + my ($code, $client) = @_; + my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($code), + $client->Password()); + return MIME::Base64::encode($client->User() . " $hmac", ""); +} + + +sub connect2 { + my $self = shift; + + $self->Port(143) + if defined ($IO::Socket::INET::VERSION) + and $IO::Socket::INET::VERSION eq '1.25' + and !$self->Port; + %$self = (%$self, @_); + my $sock = IO::Socket::INET->new; + my $dp = 'imap(143)'; + #print "i01\n"; + my $ret = $sock->configure({ + PeerAddr => $self->Server , + PeerPort => $self->Port||$dp , + Proto => 'tcp' , + Timeout => $self->Timeout||0 , + Debug => $self->Debug , + }); + #print "i02\n"; + unless ( defined($ret) ) { + $self->LastError( "$@\n"); + $@ = "$@"; + carp "$@" + unless defined wantarray; + return undef; + } + #print "i03\n"; + $self->Socket($sock); + $self->State(Connected); + + $sock->autoflush(1) ; + + my ($code, $output); + $output = ""; + + until ( $code ) { + + $output = $self->_read_line or return undef; + for my $o (@$output) { + $self->_debug("Connect: Received this from readline: " . + join("/",@$o) . "\n"); + $self->_record($self->Count,$o); # $o is a ref + next unless $o->[TYPE] eq "OUTPUT"; + ($code) = $o->[DATA] =~ /^\*\s+(OK|BAD|NO)/i ; + } + + } + + if ($code =~ /BYE|NO /) { + $self->State(Unconnected); + return undef ; + } + + if ($self->User and $self->Password) { + return $self->login ; + } + else { + return $self; + } +} +