diff --git a/CREDITS b/CREDITS index aff02cc..5c14edf 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.135 2010/04/27 23:10:53 gilles Exp gilles $ +# $Id: CREDITS,v 1.139 2010/06/21 00:16:01 gilles Exp gilles $ If you want to make a donation to the author, Gilles LAMIRAL: @@ -20,6 +20,42 @@ to remove one. I thank very much all of these people. +Bertrand STERN +Contributed by giving money 100 USD + +Miguel Jacq +Contributed by giving money 100 AUD + +Jörg Friedrichs +Found a FAQ bug about "From ". + +Telematic Freedom Foundation +Contributed by giving the book +11.20 "The Tao Is Silent" + +Jurgen Hoffmann +Contributed by giving the book +24.95 "Salsa and Afro Cuban Montunos for Guitar" + +Thomas In der Rieden +Contributed by giving the book +13.57 "Nature's Building Blocks: An A-Z Guide to the Elements" + +Sarah Van Vliet +Contributed by giving money 25 USD + +Gregory Hedo +Contributed by giving money 100 Euros + +Jesse Feddema +Contributed by giving money 5 USD + +Justin Morgan +Contributed by giving money 25 USD + +Eelco Maljaars +Contributed by giving money 10 USD + Pertti Karppinen Found and fixed a bug in compare_lists(). No flag on host1 was not removing flags on host2. @@ -823,6 +859,10 @@ Eric Yung Total amount of book prices : c \ +11.20+\ +24.95+\ +13.57+\ +\ 16.66+\ 16.47+\ \ @@ -929,4 +969,4 @@ c \ 31.20+\ 40.00 = -2568.38 +2618.10 diff --git a/ChangeLog b/ChangeLog index 7302fd9..8c78492 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,33 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.311 +head: 1.315 branch: locks: strict - gilles: 1.311 + gilles: 1.315 access list: symbolic names: keyword substitution: kv -total revisions: 311; selected revisions: 311 +total revisions: 315; selected revisions: 315 description: ---------------------------- -revision 1.311 locked by: gilles; +revision 1.315 locked by: gilles; +date: 2010/06/11 02:51:54; author: gilles; state: Exp; lines: +8 -6 +*** empty log message *** +---------------------------- +revision 1.314 +date: 2010/06/11 01:42:44; author: gilles; state: Exp; lines: +455 -16 +Added reconnect behavior with Mail::IMAPClient 2.2.9 +---------------------------- +revision 1.313 +date: 2010/06/10 00:37:09; author: gilles; state: Exp; lines: +6 -6 +36 success stories +---------------------------- +revision 1.312 +date: 2010/06/10 00:35:46; author: gilles; state: Exp; lines: +6 -5 +1und1 success story +---------------------------- +revision 1.311 date: 2010/04/27 23:03:39; author: gilles; state: Exp; lines: +35 -12 Fixed bug in compare_lists(). Thanks to Pertti Karppinen. ---------------------------- diff --git a/FAQ b/FAQ index 2d05791..8a298ee 100644 --- a/FAQ +++ b/FAQ @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ,v 1.66 2010/03/04 19:22:17 gilles Exp gilles $ +# $Id: FAQ,v 1.68 2010/06/22 00:11:56 gilles Exp gilles $ +------------------+ | FAQ for imapsync | @@ -154,10 +154,13 @@ imapsync does not touch any header since the header is used to identify the messages in both parts. Solutions: -a) Don't use buggy Eudora. -b) Use the --syncinternaldates option and keep using Eudora :-) -c) Use the script learn/adjust_time.pl to change the internal dates - from the "Date:" header. +a) use --idatefromheader to set the internal dates on host2 same as the + "Date:" headers. +b) In Maildir boxes, after the sync (too late...), use the script +learn/adjust_time.pl to change the internal dates from the "Date:" header. +c) Don't use buggy Eudora. +d) Use the --syncinternaldates option and keep using Eudora. + --syncinternaldates is now turn on by default. ======================================================================= Q. Couldn't create [INBOX.Ops/foo/bar]: NO Invalid mailbox name: @@ -643,7 +646,12 @@ a) Remove these first "From " line manually for each message before will end with two "From:" lines (just look at the other lines) b) Run imapsync with the following options : - --regexmess 's/\AFrom \w .*\n//' --skipsize + --regexmess 's/\AFrom /From:/' + +or may be better (no other "From:" collision): + + --regexmess 's/\AFrom /X-om:/' + ======================================================================= Q. The contact folder isn't well copied. diff --git a/Mail-IMAPClient-3.23/META.yml b/Mail-IMAPClient-3.23/META.yml deleted file mode 100644 index fe7e758..0000000 --- a/Mail-IMAPClient-3.23/META.yml +++ /dev/null @@ -1,22 +0,0 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: Mail-IMAPClient -version: 3.23 -version_from: lib/Mail/IMAPClient.pm -installdirs: site -requires: - Carp: 0 - Errno: 0 - Fcntl: 0 - File::Temp: 0 - IO::File: 0 - IO::Select: 0 - IO::Socket: 0 - IO::Socket::INET: 1.26 - List::Util: 0 - MIME::Base64: 0 - Parse::RecDescent: 1.94 - Test::More: 0 - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/Mail-IMAPClient-3.23/t/bodystructure.t b/Mail-IMAPClient-3.23/t/bodystructure.t deleted file mode 100644 index 1f3bc08..0000000 --- a/Mail-IMAPClient-3.23/t/bodystructure.t +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Test::More tests => 11; - -BEGIN { use_ok('Mail::IMAPClient::BodyStructure') or exit; } - -my $bs = <<'END_OF_BS'; -(BODYSTRUCTURE ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 511 20 NIL NIL NIL))^M -END_OF_BS - -my $bsobj = Mail::IMAPClient::BodyStructure->new($bs); -ok( defined $bsobj, 'parsed first' ); -is( $bsobj->bodytype, 'TEXT', 'bodytype' ); -is( $bsobj->bodysubtype, 'PLAIN', 'bodysubtype' ); - -my $bs2 = <<'END_OF_BS2'; -(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL)) -END_OF_BS2 - -$bsobj = Mail::IMAPClient::BodyStructure->new($bs2); -ok( defined $bsobj, 'parsed second' ); -is( $bsobj->bodytype, 'MULTIPART', 'bodytype' ); -is( $bsobj->bodysubtype, 'MIXED', 'bodysubtype' ); - -is( - join( "#", $bsobj->parts ), - - # Better parsing in version 3.03, changed this outcome - # "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2" -"1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2", - 'parts' -); - -my $bs3 = <<'END_OF_BS3'; -FETCH (UID 1 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "ISO-8859-1") -NIL NIL "quoted-printable" 1744 0)("TEXT" "HTML" ("charset" -"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE")) -END_OF_BS3 - -$bsobj = Mail::IMAPClient::BodyStructure->new($bs3); -ok( defined $bsobj, 'parsed third' ); - -my $bs4 = <<'END_OF_BS4'; -* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail@cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT")) -END_OF_BS4 - -$bsobj = Mail::IMAPClient::BodyStructure->new($bs4); -ok( defined $bsobj, 'parsed fourth' ); - -# test bodyMD5, contributed by Micheal Stok -my $bs5 = <<'END_OF_BS5'; -* 6 FETCH (UID 17280 BODYSTRUCTURE ((("text" "plain" ("charset" "utf-8") NIL NIL "quoted-printable" 1143 37 NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 4618 106 NIL NIL NIL) "alternative" ("boundary" "Boundary-00=_Z7P340MWKGMMYJ0CCJD0") NIL NIL)("image" "tiff" ("name" "8dd0e430.tif") NIL NIL "base64" 204134 "pmZp5QOBa9BIqFNmvxUiyQ==" ("attachment" ("filename" "8dd0e430.tif")) NIL) "mixed" ("boundary" "Boundary-00=_T7P340MWKGMMYJ0CCJD0") NIL NIL)) -END_OF_BS5 - -$bsobj = Mail::IMAPClient::BodyStructure->new($bs5); -ok( defined $bsobj, 'parsed fifth' ); diff --git a/Mail-IMAPClient-3.23/COPYRIGHT b/Mail-IMAPClient-3.25/COPYRIGHT similarity index 100% rename from Mail-IMAPClient-3.23/COPYRIGHT rename to Mail-IMAPClient-3.25/COPYRIGHT diff --git a/Mail-IMAPClient-3.23/Changes b/Mail-IMAPClient-3.25/Changes similarity index 97% rename from Mail-IMAPClient-3.23/Changes rename to Mail-IMAPClient-3.25/Changes index 45cffae..3f57350 100644 --- a/Mail-IMAPClient-3.23/Changes +++ b/Mail-IMAPClient-3.25/Changes @@ -5,6 +5,49 @@ Changes from 2.99_01 to 3.16 made by Mark Overmeer Changes from 0.09 to 2.99_01 made by David Kernen - Potential compatibility issues from 3.17+ highlighted with '*' +version 3.25: Fri May 28 00:07:40 EDT 2010 + - fix body_string parsing bug and added tests in t/body_string.t + [Heiko Schlittermann] + - rt.cpan.org#57661: uninitialized value warning in IMAPClient::thread + [Max Bowsher] + - rt.cpan.org#57337: Correctly handle multiparts in BodyStructure.pm + [Robert Norris] + fixes in Mail::IMAPClient::BodyStructure::bodystructure for + bugs still in release 3.24 + - rt.cpan.org#57659: install fails when using cPanel GUI + [Ken Parisi] + hack Makefile.PL to use alarm() and timeout prompt() gracefully + - relax t/basic.t logout() error check (allow 'BYE' instead of 'OK') + - left examples/idle.pl out of MANIFEST for 3.24 + +version 3.24: Fri May 7 17:02:35 EDT 2010 + - rt.cpan.org#48912: wrong part numbers in multipart messages + [Dmitry Bigunyak, Gabor Leszlauer] + - fix Mail::IMAPClient::BodyStructure::bodystructure to + properly assign parts for messages using multipart and also + include .TEXT parts as well (still not including top level + HEADER and TEXT though - bug?) + - allow _load_module() to set $@ and LastError if module load fails + - rt.cpan.org#55527: [no] disconnect during DESTROY + [Stefan Seifert] + - updated logout documentation to correctly state that DESTROY + is not used to force an automatic logout on DESTROY despite + documentation that indicated otherwise + - update append* documentation to match current implementation + - rt.cpan.org#55898: append_file can send too many bytes + [Jeremy Robst] + - avoid append_file corner cases operating on lines instead of buffers + - use binmode on filehandle in append_file + - add tests to t/basic.t for append_file + - rt.cpan.org#57048: _quote_search() using $_ in loop instead of $v + [Matthaus Kiem] + - added examples/idle.pl program showing use of idle and idle_data + - idle_data() should not read/block after server returns data + [Marc Thielemann] + - idle_data() _get_response regexp updated to not match errors + - idle_data() now uses a timeout of 0 by default as documented + - _get_response() now checks for defined($code) to allow $code==0 + version 3.23: Fri Jan 29 00:39:27 EST 2010 - new beta idle_data() method to retrieve untagged messages during idle similar to method suggested by Daniel Richard G diff --git a/Mail-IMAPClient-3.23/INSTALL b/Mail-IMAPClient-3.25/INSTALL similarity index 100% rename from Mail-IMAPClient-3.23/INSTALL rename to Mail-IMAPClient-3.25/INSTALL diff --git a/Mail-IMAPClient-3.23/MANIFEST b/Mail-IMAPClient-3.25/MANIFEST similarity index 96% rename from Mail-IMAPClient-3.23/MANIFEST rename to Mail-IMAPClient-3.25/MANIFEST index f71af2b..073372d 100644 --- a/Mail-IMAPClient-3.23/MANIFEST +++ b/Mail-IMAPClient-3.25/MANIFEST @@ -12,6 +12,7 @@ examples/copy_folder.pl examples/cyrus_expire.pl examples/cyrus_expunge.pl examples/find_dup_msgs.pl +examples/idle.pl examples/imap_to_mbox.pl examples/imtestExample.pl examples/migrate_mail2.pl @@ -31,6 +32,7 @@ lib/Mail/IMAPClient/Thread.pod prepare_dist sample.perldb t/basic.t +t/body_string.t t/bodystructure.t t/fetch_hash.t t/messageset.t diff --git a/Mail-IMAPClient-3.25/META.yml b/Mail-IMAPClient-3.25/META.yml new file mode 100644 index 0000000..05bd247 --- /dev/null +++ b/Mail-IMAPClient-3.25/META.yml @@ -0,0 +1,33 @@ +--- #YAML:1.0 +name: Mail-IMAPClient +version: 3.25 +abstract: IMAP4 client library +author: + - Phil Pearl (Lobbes) +license: unknown +distribution_type: module +configure_requires: + ExtUtils::MakeMaker: 0 +build_requires: + ExtUtils::MakeMaker: 0 +requires: + Carp: 0 + Errno: 0 + Fcntl: 0 + File::Temp: 0 + IO::File: 0 + IO::Select: 0 + IO::Socket: 0 + IO::Socket::INET: 1.26 + List::Util: 0 + MIME::Base64: 0 + Parse::RecDescent: 1.94 + Test::More: 0 +no_index: + directory: + - t + - inc +generated_by: ExtUtils::MakeMaker version 6.55_02 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff --git a/Mail-IMAPClient-3.23/Makefile.PL b/Mail-IMAPClient-3.25/Makefile.PL similarity index 87% rename from Mail-IMAPClient-3.23/Makefile.PL rename to Mail-IMAPClient-3.25/Makefile.PL index 4cea875..51ae415 100644 --- a/Mail-IMAPClient-3.23/Makefile.PL +++ b/Mail-IMAPClient-3.25/Makefile.PL @@ -56,7 +56,7 @@ WriteMakefile( clean => { FILES => 'test.txt' }, $] >= 5.005 ? ## keywords supported since 5.005 - ( AUTHOR => 'Phil Lobbes ' ) + ( AUTHOR => 'Phil Pearl (Lobbes) ' ) : () ); @@ -74,17 +74,28 @@ sub set_test_data { return; } - return if -f "./test.txt"; + return if -s "./test.txt"; print <<'__INTRO'; You have the option of running an extended suite of tests during 'make test'. This requires an IMAP server name, user account, and password to test with. +Note: this prompt will automatically timeout after 60 seconds. + __INTRO - my $yes = prompt "Do you want to run the extended tests? (n/y)"; - return if $yes !~ /^y(?:es)?$/i; + # HACK: alarm() allows broken interfaces to timeout gracefully... + # - rt.cpan.org#57659: install fails when using cPanel GUI + my $yes; + eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm(60); + $yes = prompt "Do you want to run the extended tests? (n/y)"; + alarm(0); + }; + print "\n" if $@; + return unless ( $yes and $yes =~ /^y(?:es)?$/i ); unless ( open TST, '>', "./test.txt" ) { warn "ERROR: couldn't open ./test.txt: $!\n"; diff --git a/Mail-IMAPClient-3.23/README b/Mail-IMAPClient-3.25/README similarity index 100% rename from Mail-IMAPClient-3.23/README rename to Mail-IMAPClient-3.25/README diff --git a/Mail-IMAPClient-3.23/TODO b/Mail-IMAPClient-3.25/TODO similarity index 100% rename from Mail-IMAPClient-3.23/TODO rename to Mail-IMAPClient-3.25/TODO diff --git a/Mail-IMAPClient-3.23/examples/build_dist.pl b/Mail-IMAPClient-3.25/examples/build_dist.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/build_dist.pl rename to Mail-IMAPClient-3.25/examples/build_dist.pl diff --git a/Mail-IMAPClient-3.23/examples/build_ldif.pl b/Mail-IMAPClient-3.25/examples/build_ldif.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/build_ldif.pl rename to Mail-IMAPClient-3.25/examples/build_ldif.pl diff --git a/Mail-IMAPClient-3.23/examples/cleanTest.pl b/Mail-IMAPClient-3.25/examples/cleanTest.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/cleanTest.pl rename to Mail-IMAPClient-3.25/examples/cleanTest.pl diff --git a/Mail-IMAPClient-3.23/examples/copy_folder.pl b/Mail-IMAPClient-3.25/examples/copy_folder.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/copy_folder.pl rename to Mail-IMAPClient-3.25/examples/copy_folder.pl diff --git a/Mail-IMAPClient-3.23/examples/cyrus_expire.pl b/Mail-IMAPClient-3.25/examples/cyrus_expire.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/cyrus_expire.pl rename to Mail-IMAPClient-3.25/examples/cyrus_expire.pl diff --git a/Mail-IMAPClient-3.23/examples/cyrus_expunge.pl b/Mail-IMAPClient-3.25/examples/cyrus_expunge.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/cyrus_expunge.pl rename to Mail-IMAPClient-3.25/examples/cyrus_expunge.pl diff --git a/Mail-IMAPClient-3.23/examples/find_dup_msgs.pl b/Mail-IMAPClient-3.25/examples/find_dup_msgs.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/find_dup_msgs.pl rename to Mail-IMAPClient-3.25/examples/find_dup_msgs.pl diff --git a/Mail-IMAPClient-3.25/examples/idle.pl b/Mail-IMAPClient-3.25/examples/idle.pl new file mode 100755 index 0000000..1761307 --- /dev/null +++ b/Mail-IMAPClient-3.25/examples/idle.pl @@ -0,0 +1,231 @@ +#!/usr/bin/perl + +=head1 NAME + +idle.pl - example using IMAP idle + +=head1 SYNOPSIS + +idle.pl [options] + + Options: [*] == Required, [+] == Multiple vals OK, (val) == Default + --o Server= *IMAP server name/IP + --o User= *User account to login to + --o Password= *Password to use for the User account + (see security note below) + --o Port= port on Server to connect to + --o Ssl= use SSL on this connection + --o Starttls= call STARTTLS on this connection + --o Debug= enable debugging in Mail::IMAPClient + --o ImapclientKey=Val any other Mail::IMAPClient attribute/value pair + --folder folder (mailbox) to IMAP SELECT (INBOX) + --maxidle maximum time to idle without receiving data (300) + --help display a brief help message + --man display the entire man page + --debug enable script debugging + +=head1 NOTES + +=head2 --o Password= + +A password specified as a command-line option may be visible +to other users via the system process table. It may alternately be +given in the PASSWORD environment variable. + +=head2 --maxidle + +RFC 2177 states, "The server MAY consider a client inactive if it has +an IDLE command running, and if such a server has an inactivity +timeout it MAY log the client off implicitly at the end of its timeout +period. Because of that, clients using IDLE are advised to terminate +the IDLE and re-issue it at least every 29 minutes to avoid being +logged off." + +The default of --maxidle 300 is used to allow the client to notice +when a connection has silently been closed upstream due to network or +firewall issue or configuration without missing too many idle events. + +=cut + +use strict; +use warnings; +use File::Basename qw(basename); +use Getopt::Long qw(GetOptions); +use Mail::IMAPClient qw(); +use Pod::Usage qw(pod2usage); +use POSIX qw(); + +use constant { + FOLDER => "INBOX", + MAXIDLE => 300, +}; + +$| = 1; # set autoflush + +my $DEBUG = 0; # GLOBAL set by process_options() +my $QUIT = 0; +my $VERSION = "1.00"; +my $Prog = basename($0); + +### +# main program +main(); + +sub main { + my %Opt = process_options(); + + pout("started $Prog\n"); + + my $imap = Mail::IMAPClient->new( %{ $Opt{opt} } ) + or die("$Prog: error: Mail::IMAPClient->new: $@\n"); + + my ( $folder, $chkseen, $tag ) = ( $Opt{folder}, 1, undef ); + + $imap->select($folder) + or die("$Prog: error: select '$folder': $@\n"); + + $SIG{'INT'} = \&sigint_handler; + + until ($QUIT) { + unless ( $imap->IsConnected ) { + warn("$Prog: reconnecting due to error: $@\n") if $imap->LastError; + $imap->connect or last; + $imap->select($folder) or last; + $tag = undef; + } + + my $ret; + if ($chkseen) { + $chkseen = 0; + + # end idle if necessary + if ($tag) { + $tag = undef; + $ret = $imap->done or last; + } + + my $unseen = $imap->unseen_count; + last if $@; + pout("$unseen unseen/new message(s) in '$folder'\n") if $unseen; + } + + # idle for X seconds unless data was returned by done + unless ($ret) { + $tag ||= $imap->idle + or die("$Prog: error: idle: $@\n"); + + warn( "$Prog: DEBUG: ", _ts(), " do idle_data($Opt{maxidle})\n" ) + if $DEBUG; + $ret = $imap->idle_data( $Opt{maxidle} ) or last; + + # connection can go stale so we exit/re-enter of idle state + # - RFC 2177 mentions 29m but firewalls may be more strict + unless (@$ret) { + warn( "$Prog: DEBUG: ", _ts(), " force exit of idle\n" ) + if $DEBUG; + $tag = undef; + + # restarted lost connections on next iteration + $ret = $imap->done or next; + } + } + + local ( $1, $2, $3 ); + foreach my $resp (@$ret) { + $resp =~ s/\015?\012$//; + + warn("$Prog: DEBUG: server response: $resp\n") if $DEBUG; + + # ignore: + # - DONE command + # - OK IDLE... + next if ( $resp eq "DONE" ); + next if ( $resp =~ /^\w+\s+OK\s+IDLE\b/ ); + + if ( $resp =~ /^\*\s+(\d+)\s+(EXISTS)\b/ ) { + my ( $num, $what ) = ( $1, $2 ); + pout("$what: $num message(s) in '$folder'\n"); + $chkseen++; + } + elsif ( $resp =~ /^\*\s+(\d+)\s+(EXPUNGE)\b/ ) { + my ( $num, $what ) = ( $1, $2 ); + pout("$what: message $num from '$folder'\n"); + } + + # * 83 FETCH (FLAGS (\Seen)) + elsif ( $resp =~ /^\*\s+(\d+)\s+(FETCH)\s+(.*)/ ) { + my ( $num, $what, $info ) = ( $1, $2, $3 ); + $chkseen++ if ( $info =~ /[\(|\s]\\Seen[\)|\s]/ ); + pout("$what: message $num from '$folder': $info\n"); + } + else { + pout("server response: $resp\n"); + } + } + } + + my $rc = 0; + if ($@) { + if ($QUIT) { + warn("$Prog: caught signal\n"); + } + else { + $rc = 1; + } + warn("$Prog: imap error: $@\n") if ( !$QUIT || $DEBUG ); + } + exit($rc); +} + +### +# supporting routines + +sub pout { + print( _ts(), " ", @_ ); +} + +sub process_options { + my ( %Opt, @err ); + + GetOptions( \%Opt, "opt=s%", "debug:1", "help", "man", "folder=s", + "maxidle:i" ) + or pod2usage( -verbose => 0 ); + + pod2usage( -message => "$Prog: version $VERSION\n", -verbose => 1 ) + if ( $Opt{help} ); + pod2usage( -verbose => 2 ) if ( $Opt{man} ); + + # set global DEBUG + $DEBUG = $Opt{debug} || 0; + + # folder (mailbox) to watch + $Opt{folder} = FOLDER unless ( exists $Opt{folder} ); + + # restart idle when no idle_data seen for this long + $Opt{maxidle} = MAXIDLE unless ( exists $Opt{maxidle} ); + + $Opt{opt}->{Password} = $ENV{PASSWORD} + if ( !exists $Opt{opt}->{Password} && defined $ENV{PASSWORD} ); + + foreach my $arg (qw(Server User Password)) { + push( @err, "-o $arg= is required" ) if !exists $Opt{opt}->{$arg}; + } + + pod2usage( + -verbose => 1, + -message => join( "", map( "$Prog: $_\n", @err ) ) + ) if (@err); + + return %Opt; +} + +# example: 2005-10-02 07:50:32 +sub _ts { + my %opt = @_; + my $fmt = $opt{fmt} || "%Y-%m-%d %T"; + return POSIX::strftime( $fmt, localtime(time) ); +} + +sub sigint_handler { + $QUIT = 1; +} diff --git a/Mail-IMAPClient-3.23/examples/imap_to_mbox.pl b/Mail-IMAPClient-3.25/examples/imap_to_mbox.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/imap_to_mbox.pl rename to Mail-IMAPClient-3.25/examples/imap_to_mbox.pl diff --git a/Mail-IMAPClient-3.23/examples/imtestExample.pl b/Mail-IMAPClient-3.25/examples/imtestExample.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/imtestExample.pl rename to Mail-IMAPClient-3.25/examples/imtestExample.pl diff --git a/Mail-IMAPClient-3.23/examples/migrate_mail2.pl b/Mail-IMAPClient-3.25/examples/migrate_mail2.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/migrate_mail2.pl rename to Mail-IMAPClient-3.25/examples/migrate_mail2.pl diff --git a/Mail-IMAPClient-3.23/examples/migrate_mbox.pl b/Mail-IMAPClient-3.25/examples/migrate_mbox.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/migrate_mbox.pl rename to Mail-IMAPClient-3.25/examples/migrate_mbox.pl diff --git a/Mail-IMAPClient-3.23/examples/populate_mailbox.pl b/Mail-IMAPClient-3.25/examples/populate_mailbox.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/populate_mailbox.pl rename to Mail-IMAPClient-3.25/examples/populate_mailbox.pl diff --git a/Mail-IMAPClient-3.23/examples/sharedFolder.pl b/Mail-IMAPClient-3.25/examples/sharedFolder.pl old mode 100644 new mode 100755 similarity index 100% rename from Mail-IMAPClient-3.23/examples/sharedFolder.pl rename to Mail-IMAPClient-3.25/examples/sharedFolder.pl diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pm similarity index 98% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pm index 68366c9..122fa82 100644 --- a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm +++ b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pm @@ -5,7 +5,7 @@ use strict; use warnings; package Mail::IMAPClient; -our $VERSION = '3.23'; +our $VERSION = '3.25'; use Mail::IMAPClient::MessageSet; @@ -57,7 +57,6 @@ sub _load_module { my $modkey = shift; my $module = $Load_Module{$modkey} || $modkey; - local ($@); # avoid stomping on global $@ eval "require $module"; if ($@) { $self->LastError("Unable to load '$module': $@"); @@ -1192,9 +1191,9 @@ sub body_string { } my $popped; - $popped = pop @$ref # (-: vi - until ( $popped && $popped =~ /\)$CRLF$/o ) # (-: vi - || !grep /\)$CRLF$/o, @$ref; + $popped = pop @$ref + until ( $popped && $popped =~ /^\)$CRLF$/o ) + || !grep /^\)$CRLF$/o, @$ref; if ( $head =~ /BODY\[TEXT\]\s*$/i ) { # Next line is a literal $string .= shift @$ref while @$ref; @@ -1227,23 +1226,30 @@ sub idle { sub idle_data { my $self = shift; - my $timeout = defined( $_[0] ) ? shift : 0.025; + my $timeout = scalar(@_) ? shift : 0; my $socket = $self->Socket; # current index in Results array my $trans_c1 = $self->_next_index; # look for all untagged responses - my $rc; - while ( - ( - $rc = - $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout ) - ) > 0 - ) - { - $self->_get_response( '*', qr/\S+/ ) or return undef; - } + my ( $rc, $ret ); + + do { + $ret = + $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout ); + + # set rc on first pass or on errors + $rc = $ret if ( !defined($rc) or $ret < 0 ); + + # not using /\S+/ because that can match 0 in "* 0 RECENT" + # leading the library to act as if things failed + if ( $ret > 0 ) { + $self->_get_response( '*', qr/(?!BAD|BYE|NO)(?:\d+\s+\w+|\S+)/ ) + or return undef; + $timeout = 0; # check for more data without blocking! + } + } while $ret > 0; # select returns -1 on errors return undef if $rc < 0; @@ -1425,7 +1431,7 @@ sub _get_response { my @readopt = defined( $opt->{outref} ) ? ( $opt->{outref} ) : (); my ( $count, $out, $code, $byemsg ) = ( $self->Count, [], undef, undef ); - until ($code) { + until ( defined($code) ) { my $output = $self->_read_line(@readopt) or return undef; $out = $output; # keep last response just in case @@ -1457,7 +1463,7 @@ sub _get_response { } } - if ($code) { + if ( defined($code) ) { $code =~ s/$CR?$LF?$//o; $code = uc($code) unless ( $good and $code eq $good ); @@ -2627,7 +2633,7 @@ sub _quote_search { if ( ref($v) eq "SCALAR" ) { push( @ret, $$v ); } - elsif ( exists $SEARCH_KEYS{ uc($_) } ) { + elsif ( exists $SEARCH_KEYS{ uc($v) } ) { push( @ret, $v ); } elsif ( @args == 1 ) { @@ -2691,7 +2697,7 @@ sub thread { or return undef; unless ($thread_parser) { - return if $thread_parser == 0; + return if ( defined($thread_parser) and $thread_parser == 0 ); my $class = $self->_load_module("Thread"); unless ($class) { @@ -2959,6 +2965,8 @@ sub append_file { return undef; } + binmode($fh); + my $date; if ( $fh and $use_filetime ) { my $f = $self->Rfc2060_datetime( ( stat($fh) )[9] ); @@ -2990,9 +2998,30 @@ sub append_file { my $count = $self->Count; # Now send the message itself - my $buffer; - while ( $fh->sysread( $buffer, APPEND_BUFFER_SIZE ) ) { - $buffer =~ s/\r?\n/$CRLF/og; + my ( $buffer, $buflen ) = ( "", 0 ); + until ( !$buflen and eof($fh) ) { + + if ( $buflen < APPEND_BUFFER_SIZE ) { + FILLBUFF: + while ( my $line = <$fh> ) { + $line =~ s/\r?\n$/$CRLF/; + $buffer .= $line; + $buflen = length($buffer); + last FILLBUFF if ( $buflen >= APPEND_BUFFER_SIZE ); + } + } + + # exit loop entirely if we are out of data + last unless $buflen; + + # save anything over desired buffer size for next iteration + my $savebuff = + ( $buflen > APPEND_BUFFER_SIZE ) + ? substr( $buffer, APPEND_BUFFER_SIZE ) + : undef; + + # reduce buffer to desired size + $buffer = substr( $buffer, 0, APPEND_BUFFER_SIZE ); $self->_record( $count, @@ -3007,6 +3036,10 @@ sub append_file { $self->LastError( "Error appending message: " . $self->LastError ); return undef; } + + # retain any saved data and continue loop + $buffer = defined($savebuff) ? $savebuff : ""; + $buflen = length($buffer); } # finish off append diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pod similarity index 97% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pod index 763556d..1e6feef 100644 --- a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod +++ b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pod @@ -549,7 +549,7 @@ error-prone and stalled the progress of this module. Example: - my $uid = $imap->append($folder,$msg_text) + my $uid = $imap->append( $folder, $msg_text ) or die "Could not append: ", $imap->LastError; The B method adds a message to the specified folder. It takes @@ -557,17 +557,12 @@ two arguments, the name of the folder to append the message to, and the text of the message (including headers). Additional arguments are added to the message text, separated with . -The B method returns the UID of the new message (a true value) -if successful, or C if not, if the IMAP server has the UIDPLUS -capability. If it doesn't then you just get true on success and undef -on failure. +On success, the B method returns the UID of the new message +(if the server has the UIDPLUS capability) or a true value otherwise. +On error, C is returned and L will be set. -Note that many servers will get really ticked off if you try to append -a message that contains "bare newlines", which is the titillating term -given to newlines that are not preceded by a carriage return. To -protect against this, B will insert a carriage return before -any newline that is "bare". If you don't like this behavior then you -can avoid it by not passing naked newlines to B. +To protect against "bare newlines", B will insert a carriage +return before any newline that is "bare". Note that B does not allow you to specify the internal date or initial flags of an appended message. If you need this capability @@ -580,41 +575,37 @@ Example: my $new_msg_uid = $imap->append_file( $folder, $filename, - [ $input_record_separator, flags, date ] # optional + [ undef, flags, date ] # optional ) or die "Could not append_file: ", $imap->LastError; The B method adds a message to the specified folder. It takes two arguments, the name of the folder to append the message to, and the file name of an RFC822-formatted message. -An optional third argument is the value to use for -C. The default is to use "" for the first -read (to get the headers) and "\n" for the rest. Any valid value for -C<$/> is acceptable, even the funky stuff, like C<\1024>. (See -L for more information on C<$/>). (The brackets in -the example indicate that this argument is optional; they do not mean -that the argument should be an array reference.) +Note: The brackets in the example indicate optional arguments; they do +not mean that the argument should be an array reference. -The B method returns the UID of the new message (a true -value) if successful, or C if not, if the IMAP server has the -UIDPLUS capability. If it doesn't then you just get true on success -and undef on failure. If you supply a filename that doesn't exist -then you get an automatic C. The L method will -remind you of this if you forget that your file doesn't exist but -somehow manage to remember to check L. +On success, the B method returns the UID of the new +message (if the server has the UIDPLUS capability) or a true value +otherwise. On error, C is returned and L will be +set. -In case you're wondering, B is provided mostly as a way -to allow large messages to be appended without having to have the -whole file in memory. It uses the C<-s> operator to obtain the size -of the file and then reads and sends the contents line by line (or -not, depending on whether you supplied that optional third argument). +To protect against "bare newlines", B will insert a +carriage return before any newline that is "bare". + +The B method provides a mechanism for allowing large +messages to be appended without holding the whole file in memory. + +Version note: In 2.x an optional third argument to use for +C was allowed, however this argument is +ignored/not supported as of 3.x. =head2 append_string Example: # brackets indicate optional arguments (not array refs): - my $uid = $imap->append_string( $folder, $text [,$flags [,$date ] ]) + my $uid = $imap->append_string( $folder, $text [ ,$flags [ ,$date ] ] ) or die "Could not append_string: $@\n"; The B method adds a message to the specified folder. @@ -636,18 +627,13 @@ hh:mm:ss +0000". If you want to specify a date/time but you don't want any flags then specify I as the third argument. -The B method returns the UID of the new message (a true -value) if successful, or C if not, if the IMAP server has the -UIDPLUS capability. If it doesn't then you just get true on success -and undef on failure. +On success, the B method returns the UID of the new +message (if the server has the UIDPLUS capability) or a true value +otherwise. On error, C is returned and L will be +set. -Note that many servers will get really ticked off if you try to append -a message that contains "bare newlines", which is the titillating term -given to newlines that are not preceded by a carriage return. To -protect against this, B will insert a carriage return -before any newline that is "bare". If you don't like this behavior -then you can avoid it by not passing naked newlines to -B. +To protect against "bare newlines", B will insert a +carriage return before any newline that is "bare". =head2 authenticate @@ -1583,8 +1569,16 @@ client enters the I state. This method does not, destroy the IMAPClient object, thus the L and L methods can be used to establish a new IMAP session. -Per RFC2683, Mail::IMAPClient will attempt to log out of the server -during B if the object is in the L state. +Note that RFC2683 section 3.1.2 (Severed connections) makes some +recommendations on how IMAP clients should behave. It is up to the +user of this module to decide on the preferred behavior and code +accordingly. + +Version note: documentation (from 2.x through 3.23) claimed that +Mail::IMAPClient would attempt to log out of the server during +B if the object is in the L state. This +documentation was apparently incorrect from at least 2.2.2 and +possibly earlier versions on up. =head2 lsub diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure.pm similarity index 93% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure.pm index 31dc16e..0a91d2b 100644 --- a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm +++ b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure.pm @@ -4,6 +4,9 @@ use strict; package Mail::IMAPClient::BodyStructure; use Mail::IMAPClient::BodyStructure::Parse; +# BUG?: old code used name "HEAD" instead of "HEADER", change? +my $HEAD = "HEAD"; + # my has file scope, not limited to package! my $parser = Mail::IMAPClient::BodyStructure::Parse->new or die "Cannot parse rules: $@\n" @@ -17,7 +20,7 @@ sub new or return undef; $self->{_prefix} = ""; - $self->{_id} = exists $self->{bodystructure} ? 'HEAD' : 1; + $self->{_id} = exists $self->{bodystructure} ? $HEAD : 1; $self->{_top} = 1; bless $self, ref($class)||$class; @@ -63,9 +66,10 @@ sub parts my @parts; $self->{PartsList} = \@parts; + # BUG?: should this default to ($HEAD, TEXT) unless(exists $self->{bodystructure}) { $self->{PartsIndex}{1} = $self; - @parts = ("HEAD", 1); + @parts = ($HEAD, 1); return wantarray ? @parts : \@parts; } @@ -75,7 +79,7 @@ sub parts $self->{PartsIndex}{$id} = $p ; my $type = uc $p->bodytype || ''; - push @parts, "$id.HEAD" + push @parts, "$id.$HEAD" if $type eq 'MESSAGE'; } @@ -88,8 +92,8 @@ sub bodystructure my @parts; if($self->{_top}) - { $self->{_id} ||= "HEAD"; - $self->{_prefix} ||= "HEAD"; + { $self->{_id} ||= $HEAD; + $self->{_prefix} ||= $HEAD; $partno = 0; foreach my $b ( @{$self->{bodystructure}} ) { $b->{_id} = ++$partno; @@ -104,8 +108,26 @@ sub bodystructure foreach my $p ( @{$self->{bodystructure}} ) { $partno++; - $p->{_prefix} = "$prefix$partno"; - $p->{_id} ||= "$prefix$partno"; + + # BUG?: old code didn't add .TEXT sections, should we skip these? + # - This code needs to be generalised (maybe it belongs in parts()?) + # - Should every message should have HEAD (actually MIME) and TEXT? + # at least dovecot and iplanet appear to allow this even for + # non-multipart sections + my $pno = $partno; + my $stype = $self->{bodytype} || ""; + my $ptype = $p->{bodytype} || ""; + + # a message and the multipart inside of it "collapse together" + if ($partno == 1 and $stype eq 'MESSAGE' and $ptype eq 'MULTIPART') { + $pno = "TEXT"; + $p->{_prefix} = "$prefix"; + } + else { + $p->{_prefix} = "$prefix$partno"; + } + $p->{_id} ||= "$prefix$pno"; + push @parts, $p, $p->{bodystructure} ? $p->bodystructure : (); } @@ -117,9 +139,10 @@ sub id return $self->{_id} if exists $self->{_id}; - return "HEAD" + return $HEAD if $self->{_top}; + # BUG?: can this be removed? ... seems wrong if ($self->{bodytype} eq 'MULTIPART') { my $p = $self->{_id} || $self->{_prefix}; $p =~ s/\.$//; diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.grammar b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.grammar similarity index 100% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.grammar rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.grammar diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pm b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.pm similarity index 100% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pm rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.pm diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pod b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.pod similarity index 100% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pod rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.pod diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/MessageSet.pm b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/MessageSet.pm similarity index 100% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/MessageSet.pm rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/MessageSet.pm diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.grammar b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.grammar similarity index 100% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.grammar rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.grammar diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pm b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.pm similarity index 100% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pm rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.pm diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pod b/Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.pod similarity index 100% rename from Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pod rename to Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.pod diff --git a/Mail-IMAPClient-3.23/prepare_dist b/Mail-IMAPClient-3.25/prepare_dist old mode 100644 new mode 100755 similarity index 81% rename from Mail-IMAPClient-3.23/prepare_dist rename to Mail-IMAPClient-3.25/prepare_dist index fddf7da..7c48a65 --- a/Mail-IMAPClient-3.23/prepare_dist +++ b/Mail-IMAPClient-3.25/prepare_dist @@ -4,10 +4,14 @@ use warnings; use strict; use Parse::RecDescent 1.94; -use File::Slurp qw/read_file/; use File::Copy qw/move/; -sub build_parser($$); +sub read_file { + my $file = shift; + local( $/, *FH ); + open( FH, $file ) or return undef; + return ; +} build_parser 'lib/Mail/IMAPClient/BodyStructure/Parse.grammar' , 'Mail::IMAPClient::BodyStructure::Parse'; @@ -15,8 +19,8 @@ build_parser 'lib/Mail/IMAPClient/BodyStructure/Parse.grammar' build_parser 'lib/Mail/IMAPClient/Thread.grammar' , 'Mail::IMAPClient::Thread'; -sub build_parser($$) -{ my ($grammarfn, $package) = @_; +sub build_parser { + my ($grammarfn, $package) = @_; print "* building $package\n"; diff --git a/Mail-IMAPClient-3.23/sample.perldb b/Mail-IMAPClient-3.25/sample.perldb similarity index 100% rename from Mail-IMAPClient-3.23/sample.perldb rename to Mail-IMAPClient-3.25/sample.perldb diff --git a/Mail-IMAPClient-3.23/t/basic.t b/Mail-IMAPClient-3.25/t/basic.t similarity index 72% rename from Mail-IMAPClient-3.23/t/basic.t rename to Mail-IMAPClient-3.25/t/basic.t index 366e406..e4ba40c 100644 --- a/Mail-IMAPClient-3.23/t/basic.t +++ b/Mail-IMAPClient-3.25/t/basic.t @@ -32,32 +32,35 @@ BEGIN { @missing ? plan skip_all => "missing value for: @missing" - : plan tests => 67; + : plan tests => 77; } BEGIN { use_ok('Mail::IMAPClient') or exit; } -my @new_args = ( - Server => $parms{server}, - Port => $parms{port}, - User => $parms{user}, - Password => $parms{passed}, - Authmechanism => $parms{authmech}, +my %new_args = ( + Server => delete $parms{server}, + Port => delete $parms{port}, + User => delete $parms{user}, + Password => delete $parms{passed}, + Authmechanism => delete $parms{authmech}, Clear => 0, Fast_IO => $fast, Uid => $uidplus, Debug => $debug, ); +# allow other options to be placed in test.txt +%new_args = ( %new_args, %parms ); + my $imap = Mail::IMAPClient->new( - @new_args, + %new_args, Range => $range, Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef ) ); ok( defined $imap, 'created client' ); $imap - or die "Cannot log into $parms{server} as $parms{user}.\n" + or die "Cannot log into $new_args{Server} as $new_args{User}.\n" . "Are server/user/password correct?\n"; isa_ok( $imap, 'Mail::IMAPClient' ); @@ -66,19 +69,28 @@ $imap->Debug_fh->autoflush() if $imap->Debug_fh; my $testmsg = <<__TEST_MSG; Date: @{[$imap->Rfc822_date(time)]} -To: <$parms{user}\@$parms{server}> -From: Perl <$parms{user}\@$parms{server}> +To: <$new_args{User}\@$new_args{Server}> +From: Perl <$new_args{User}\@$new_args{Server}> Subject: Testing from pid $$ This is a test message generated by $0 during a 'make test' as part of the installation of the Mail::IMAPClient module from CPAN. __TEST_MSG -ok( $imap->noop, "noop" ); +ok( $imap->noop, "noop" ); +ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" ); my $sep = $imap->separator; ok( defined $sep, "separator is '$sep'" ); +{ + my $list = $imap->list(); + is( ref($list), "ARRAY", "list" ); + + my $lsub = $imap->lsub(); + is( ref($lsub), "ARRAY", "lsub" ); +} + my $ispar = $imap->is_parent('INBOX'); my ( $target, $target2 ) = $ispar @@ -88,15 +100,78 @@ my ( $target, $target2 ) = ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" ); ok( $imap->select('inbox'), "select inbox" ); -ok( $imap->create($target), "create target" ); + +# test append_file +my $append_file_size; +{ + my ( $afh, $afn ) = tempfile UNLINK => 1; + + # write message to autoflushed file handle since we keep $afh around + my $oldfh = select($afh); + $| = 1; + select($oldfh); + print( $afh $testmsg ) or die("print testmsg failed"); + cmp_ok( -s $afn, '>', 0, "tempfile has size" ); + + ok( $imap->create($target), "create target" ); + + my $uid = $imap->append_file( $target, $afn ); + ok( defined $uid, "append_file test message to $target" ); + + ok( $imap->select($target), "select $target" ); + + my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0]; + my $size = $imap->size($msg); + + cmp_ok( $size, '>', 0, "has size $size" ); + + my $string = $imap->message_string($msg); + ok( defined $string, "returned string" ); + + cmp_ok( length($string), '==', $size, "string matches server size" ); + ok( $imap->delete($target), "delete folder $target" ); + + $append_file_size = $size; +} + +# test append (string) +{ + ok( $imap->create($target), "create target" ); + + my $uid = $imap->append( $target, $testmsg ); + ok( defined $uid, "append test message to $target" ); + + ok( $imap->select($target), "select $target" ); + + my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0]; + my $size = $imap->size($msg); + + cmp_ok( $size, '>', 0, "has size $size" ); + + my $string = $imap->message_string($msg); + ok( defined $string, "returned string" ); + + cmp_ok( length($string), '==', $size, "string matches server size" ); + + { + my ( $fh, $fn ) = tempfile UNLINK => 1; + ok( $imap->message_to_file( $fn, $msg ), "to file $fn" ); + + cmp_ok( -s $fn, '==', $size, "correct size" ); + } + + cmp_ok( $size, '==', $append_file_size, "size matches string/file" ); + + # save message/folder for use below... + #OFF ok( $imap->delete($target), "delete folder $target" ); +} + +#OFF ok( $imap->create($target), "create target" ); +ok( $imap->exists($target), "exists $target" ); +ok( $imap->create($target2), "create $target2" ); +ok( $imap->exists($target2), "exists $target2" ); { - my $list = $imap->list(); - is( ref($list), "ARRAY", "list" ); - - my $lsub = $imap->lsub(); - is( ref($lsub), "ARRAY", "lsub" ); - ok( $imap->subscribe($target), "subscribe target" ); my $sub1 = $imap->subscribed(); @@ -106,10 +181,10 @@ ok( $imap->create($target), "create target" ); my $sub2 = $imap->subscribed(); is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" ); - - ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" ); } +ok( $imap->select($target), "select $target" ); + my $fwquotes = qq($target${sep}has "quotes"); if ( !$imap->is_parent($target) ) { ok( 1, "not parent, skipping quote test 1/3" ); @@ -125,39 +200,13 @@ elsif ( $imap->create($fwquotes) ) { } else { if ( $imap->LastError =~ /NO Invalid.*name/ ) { - ok( 1, "$parms{server} doesn't support quotes in folder names" ); + ok( 1, "$new_args{Server} doesn't support quotes in folder names" ); } else { ok( 0, "failed creation with quotes" ) } ok( 1, "skipping 1/2 tests" ); ok( 1, "skipping 2/2 tests" ); } -ok( $imap->exists($target), "exists $target" ); -ok( $imap->create($target2), "create $target2" ); -ok( $imap->exists($target2), "exists $target2" ); - -my $uid = $imap->append( $target, $testmsg ); -ok( defined $uid, "append test message to $target" ); - -ok( $imap->select($target), "select $target" ); - -my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0]; -my $size = $imap->size($msg); - -cmp_ok( $size, '>', 0, "has size $size" ); - -my $string = $imap->message_string($msg); -ok( defined $string, "returned string" ); - -cmp_ok( length($string), '==', $size, "string has size" ); - -{ - my ( $fh, $fn ) = tempfile UNLINK => 1; - ok( $imap->message_to_file( $fn, $msg ), "to file $fn" ); - - cmp_ok( -s $fn, '==', $size, "correct size" ); -} - my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" ); is( scalar @$fields, 0, 'bogus message id does not exist' ); @@ -246,7 +295,7 @@ ok( !$@, "search undeleted" ) or diag( '$@:' . $@ ); # my $im2 = Mail::IMAPClient->new( - @new_args, + %new_args, Timeout => 30, Debug_fh => ( $debug ? IO::File->new(">./imap2.debug") : undef ), ); @@ -303,7 +352,7 @@ $im2->delete_message( @{ $im2->messages } ) ok( $im2->close, "close" ); $im2->delete($migtarget); -ok( $im2->logout, "logout" ) or diag("logout error: $@"); +ok_relaxed_logout($im2); # Test IDLE SKIP: { @@ -335,9 +384,21 @@ else { $imap->_disconnect; ok( $imap->reconnect, "reconnect" ); +ok_relaxed_logout($imap); + # Test STARTTLS - an optional feature so tests always succeed { - ok( $imap->logout, "logout" ) or diag("logout error: $@"); $imap->connect( Starttls => 1 ); ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) ); } + +# LOGOUT +# - on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5 +# however some servers return BYE instead so we let that pass here... +sub ok_relaxed_logout { + my $imap = shift; + local ($@); + my $rc = $imap->logout; + my $err = $imap->LastError || "OK"; + ok( ( $rc or $err =~ /^\* BYE/ ), "logout: $err" ); +} diff --git a/Mail-IMAPClient-3.25/t/body_string.t b/Mail-IMAPClient-3.25/t/body_string.t new file mode 100644 index 0000000..06f254b --- /dev/null +++ b/Mail-IMAPClient-3.25/t/body_string.t @@ -0,0 +1,76 @@ +#!/usr/bin/perl +# +# tests for body_string() +# +# body_string() calls fetch() internally. rather than refactor +# body_string() just for testing, we subclass M::IC and use the +# overidden fetch() to feed it test data. + +use strict; +use warnings; +use IO::Socket qw(:crlf); +use Test::More tests => 3; + +BEGIN { use_ok('Mail::IMAPClient') or exit; } + +my @tests = ( + [ + "simple fetch", + [ + '12 FETCH 1 BODY[TEXT]', + '* 1 FETCH (FLAGS (\\Seen \\Recent) BODY[TEXT]', + "This is a test message$CRLF" . "Line Z (last line)$CRLF", + ")$CRLF", + "12 OK Fetch completed.$CRLF", + ], + [ 1 ], + "This is a test message$CRLF" . "Line Z (last line)$CRLF", + ], + + # 2010-05-27: test for bug reported by Heiko Schlittermann + [ + "uwimap IMAP4rev1 2007b.404 fetch unseen", + [ + '4 FETCH 1 BODY[TEXT]', + '* 1 FETCH (BODY[TEXT]', + "This is a test message$CRLF" . "Line Z (last line)$CRLF", + ")$CRLF", + "* 1 FETCH (FLAGS (\\Recent \\Seen)$CRLF", + "4 OK Fetch completed$CRLF", + ], + [ 1 ], + "This is a test message$CRLF" . "Line Z (last line)$CRLF", + ], +); + +package Test::Mail::IMAPClient; + +use base qw(Mail::IMAPClient); + +sub new { + my ( $class, %args ) = @_; + my %me = %args; + return bless \%me, $class; +} + +sub fetch { + my ( $self, @args ) = @_; + return $self->{_next_fetch_response} || []; +} + +package main; + +sub run_tests { + my ( $imap, $tests ) = @_; + + for my $test (@$tests) { + my ( $comment, $fetch, $request, $response ) = @$test; + $imap->{_next_fetch_response} = $fetch; + my $r = $imap->body_string(@$request); + is_deeply( $r, $response, $comment ); + } +} + +my $imap = Test::Mail::IMAPClient->new( Uid => 0, Debug => 0 ); + +run_tests( $imap, \@tests ); diff --git a/Mail-IMAPClient-3.25/t/bodystructure.t b/Mail-IMAPClient-3.25/t/bodystructure.t new file mode 100644 index 0000000..1995da4 --- /dev/null +++ b/Mail-IMAPClient-3.25/t/bodystructure.t @@ -0,0 +1,100 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 20; + +BEGIN { use_ok('Mail::IMAPClient::BodyStructure') or exit; } + +my $bs = <<'END_OF_BS'; +(BODYSTRUCTURE ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 511 20 NIL NIL NIL)) +END_OF_BS + +my $bsobj = Mail::IMAPClient::BodyStructure->new($bs); +ok( defined $bsobj, 'parsed first' ); +is( $bsobj->bodytype, 'TEXT', 'bodytype' ); +is( $bsobj->bodysubtype, 'PLAIN', 'bodysubtype' ); + +my $bs2 = <<'END_OF_BS2'; +(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL)) +END_OF_BS2 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs2); +ok( defined $bsobj, 'parsed second' ); +is( $bsobj->bodytype, 'MULTIPART', 'bodytype' ); +is( $bsobj->bodysubtype, 'MIXED', 'bodysubtype' ); + +is( + join( "#", $bsobj->parts ), + + # Parsing in version 3.03-3.23, changed (broke) outcome from + # this: "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2" + # to: "1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2" + # Patches to BodyStructure.pm in 3.25 changed it to this: + "1#2#2.HEAD#2.TEXT#2.1#2.2#2.2.HEAD#2.2.TEXT#2.2.1#2.2.1.1#2.2.1.2", + 'parts' +); + +my $bs3 = <<'END_OF_BS3'; +FETCH (UID 1 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "ISO-8859-1") +NIL NIL "quoted-printable" 1744 0)("TEXT" "HTML" ("charset" +"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE")) +END_OF_BS3 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs3); +ok( defined $bsobj, 'parsed third' ); + +my $bs4 = <<'END_OF_BS4'; +* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail@cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT")) +END_OF_BS4 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs4); +ok( defined $bsobj, 'parsed fourth' ); + +# test bodyMD5, contributed by Micheal Stok +my $bs5 = <<'END_OF_BS5'; +* 6 FETCH (UID 17280 BODYSTRUCTURE ((("text" "plain" ("charset" "utf-8") NIL NIL "quoted-printable" 1143 37 NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 4618 106 NIL NIL NIL) "alternative" ("boundary" "Boundary-00=_Z7P340MWKGMMYJ0CCJD0") NIL NIL)("image" "tiff" ("name" "8dd0e430.tif") NIL NIL "base64" 204134 "pmZp5QOBa9BIqFNmvxUiyQ==" ("attachment" ("filename" "8dd0e430.tif")) NIL) "mixed" ("boundary" "Boundary-00=_T7P340MWKGMMYJ0CCJD0") NIL NIL)) +END_OF_BS5 + +my @exp; +$bsobj = Mail::IMAPClient::BodyStructure->new($bs5); +@exp = qw(1 1.1 1.2 2); +ok( defined $bsobj, 'parsed fifth' ); +is_deeply( [ $bsobj->parts ], \@exp, 'bs5 parts' ) + or diag( join(" ", $bsobj->parts ) ); + +# +my $bs6 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "UTF-8" "format" "flowed") NIL NIL "8bit" 82 6 NIL NIL NIL NIL)("message" "rfc822" ("name" "this is internal letter.eml") NIL NIL "7bit" 243436 ("Mon, 24 Aug 2009 10:51:22 +0400" "this is internal letter" ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "dima" "adriver.ru")) NIL NIL NIL "<4A92386A.9080307@inbox.ru>") (("text" "plain" ("charset" "UTF-8" "format" "flowed") NIL NIL "7bit" 116 7 NIL NIL NIL NIL)("text" "xml" ("name" "mediaplan.xml" "charset" "us-ascii") NIL NIL "base64" 31412 424 NIL ("inline" ("filename" "mediaplan.xml")) NIL NIL)("application" "zip" ("name" "banners2.zip") NIL NIL "base64" 209942 NIL ("inline" ("filename" "banners2.zip")) NIL NIL) "mixed" ("boundary" "------------070804080502030807020509") NIL NIL NIL) 3326 NIL ("inline" ("filename" "this is internal letter.eml")) NIL NIL) "mixed" ("boundary" "------------070704030806000803040203") NIL NIL NIL))}; + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs6); +@exp = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.3); +ok( defined $bsobj, 'parsed sixth' ); +is_deeply( [ $bsobj->parts ], \@exp, 'bs6 parts' ) + or diag( join(" ", $bsobj->parts ) ); + +# +my $bs7 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 20 1 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 1810 ("Fri,07 May 2010 01:55:07 -0400" "wrap inner a" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25015.1273211707@local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 27 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 783 ("Fri, 07 May 2010 01:54:14 -0400" "inner msg #1" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<24986.1273211654@local>") ("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 25 3 NIL NIL NIL NIL) 23 NIL ("inline" ("filename" "52")) NIL NIL) "mixed" ("boundary" "=-=-=") NIL NIL NIL) 58 NIL ("inline" ("filename" "53")) NIL NIL) "mixed" ("boundary""==-=-=") NIL NIL NIL))}; + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs7); +@exp = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.2.HEAD 2.2.1); +ok( defined $bsobj, 'parsed seventh' ); +is_deeply( [ $bsobj->parts ], \@exp, 'bs7 parts' ) + or diag( join(" ", $bsobj->parts ) ); + +# +my $bs8 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 31 2 NIL NIL NIL NIL)("message" "rfc822" NIL NIL "My forwarded message" "7bit" 2833 ("Fri, 07 May 2010 01:55:40 -0400" "outer msg" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25030.1273211740@local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 20 1 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 1810 ("Fri, 07 May 2010 01:55:07 -0400" "wrap inner a" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25015.1273211707@local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 27 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 783 ("Fri, 07 May 2010 01:54:14 -0400" "inner msg #1" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<24986.1273211654@local>") ("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 25 3 NIL NIL NIL NIL) 23 NIL ("inline" ("filename" "52")) NIL NIL) "mixed" ("boundary" "=-=-=") NIL NIL NIL) 58 NIL ("inline" ("filename" "53")) NIL NIL) "mixed" ("boundary" "==-=-=") NIL NIL NIL) 91 NIL ("inline" ("filename" "52")) NIL NIL)("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 30 2 NIL NIL NIL NIL)("application" "octet-stream" NIL NIL "My attachment" "7bit" 76 NIL ("attachment" ("filename" ".signature.cell")) NIL NIL)("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 31 2 NIL NIL NIL NIL) "mixed" ("boundary" "===-=-=") NIL NIL NIL))}; + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs8); +@exp = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.2.HEAD 2.2.TEXT 2.2.1 2.2.2 2.2.2.HEAD 2.2.2.1 3 4 5); +ok( defined $bsobj, 'parsed eighth' ); +is_deeply( [ $bsobj->parts ], \@exp, 'bs8 parts' ) + or diag( join(" ", $bsobj->parts ) ); + +# Ryan Finnie MIME torture test +my $bs9 = q{(BODYSTRUCTURE (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 617 16 NIL NIL NIL NIL)("message" "rfc822" NIL NIL "I'll be whatever I wanna do. --Fry" "7bit" 582 ("23 Oct 2003 22:25:56 -0700" "plain jane message" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066973156.4264.42.camel@localhost>") ("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 311 9 NIL NIL NIL NIL) 18 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Would you kindly shut your noise-hole? --Bender" "7bit" 1460 ("23 Oct 2003 23:15:11 -0700" "messages inside messages inside..." (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066976111.4263.74.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 193 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL "At the risk of sounding negative, no. --Leela" "7bit" 697 ("23 Oct 2003 23:09:05 -0700" "the original message" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066975745.4263.70.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 78 3 NIL NIL NIL NIL)("application" "x-gzip" ("NAME" "foo.gz") NIL NIL "base64" 58 NIL ("attachment" ("filename" "foo.gz")) NIL NIL) "mixed" ("boundary" "=-XFYecI7w+0shpolXq8bb") NIL NIL NIL) 25 NIL ("inline" NIL) NIL NIL) "mixed" ("boundary" "=-9Brg7LoMERBrIDtMRose") NIL NIL NIL) 49 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Dirt doesn't need luck! --Professor" "7bit" 817 ("23 Oct 2003 22:40:49 -0700" "this message JUST contains an attachment" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066974048.4264.62.camel@localhost>") ("application" "x-gzip" ("NAME" "blah.gz") NIL "Attachment has identical content to above foo.gz" "base64" 396 NIL ("attachment" ("filename" "blah.gz")) NIL NIL) 17 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Hold still, I don't have good depth perception! --Leela" "7bit" 1045 ("23 Oct 2003 23:09:16 -0700" "Attachment filename vs. name" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066975756.4263.70.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 377 6 NIL NIL NIL NIL)("application" "x-gzip" ("NAME" "blah2.gz") NIL "filename is blah1.gz, name is blah2.gz" "base64" 58 NIL ("attachment" ("filename" "blah1.gz")) NIL NIL) "mixed" ("boundary" "=-1066975756jd02") NIL NIL NIL) 29 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Hello little man. I WILL DESTROY YOU! --Moro" "7bit" 1149 ("23 Oct 2003 23:09:21 -0700" "No filename? No problem!" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066975761.4263.70.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 517 10 NIL NIL NIL NIL)("application" "x-gzip" NIL NIL "I'm getting sick of witty things to say" "base64" 58 NIL ("attachment" NIL) NIL NIL) "mixed" ("boundary" "=-1066975756jd03") NIL NIL NIL) 33 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Friends! Help! A guinea pig tricked me! --Zoidberg" "7bit" 896 ("23 Oct 2003 22:40:45 -0700" "html and text, both inline" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066974044.4264.62.camel@localhost>") (("text" "html" ("CHARSET" "utf-8") NIL NIL "8bit" 327 11 NIL NIL NIL NIL)("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 61 2 NIL NIL NIL NIL) "mixed" ("boundary" "=-ZCKMfHzvHMyK1iBu4kff") NIL NIL NIL) 33 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Smeesh! --Amy" "7bit" 642 ("23 Oct 2003 22:41:29 -0700" "text and text, both inline" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066974089.4265.64.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 62 2 NIL NIL NIL NIL)("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 68 2 NIL NIL NIL NIL) "mixed" ("boundary" "=-pNc4wtlOIxs8RcX7H/AK") NIL NIL NIL) 24 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "That's not a cigar. Uh... and it's not mine. --Hermes" "7bit" 1515 ("23 Oct 2003 22:39:17 -0700" "HTML and... HTML?" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066973957.4263.59.camel@localhost>") (("text" "html" ("CHARSET" "utf-8") NIL NIL "8bit" 824 22 NIL NIL NIL NIL)("text" "html" ("NAME" "htmlfile.html" "CHARSET" "UTF-8") NIL NIL "8bit" 118 6 NIL ("attachment" ("filename" "htmlfile.html")) NIL NIL) "mixed" ("boundary" "=-zxh/IezwzZITiphpcbJZ") NIL NIL NIL) 49 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "The spirit is willing, but the flesh is spongy, and bruised. --Zapp" "7bit" 6683 ("23 Oct 2003 22:23:16 -0700" "smiley!" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066972996.4264.39.camel@localhost>") ((((("text" "plain" ("charset" "us-ascii") NIL NIL "quoted-printable" 1606 42 NIL NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 2173 54 NIL NIL NIL NIL) "alternative" ("boundary" "=-dHujWM/Xizz57x/JOmDF") NIL NIL NIL)("image" "png" ("name" "smiley-3.png") "<1066971953.4232.15.camel@localhost>" NIL "base64" 1122 NIL ("attachment" ("filename" "smiley-3.png")) NIL NIL) "related" ("type" "multipart/alternative" "boundary" "=-GpwozF9CQ7NdF+fd+vMG") NIL NIL NIL)("image" "gif" ("name" "dot.gif") NIL NIL "base64" 96 NIL ("attachment" ("filename" "dot.gif")) NIL NIL) "mixed" ("boundary" "=-CgV5jm9HAY9VbUlAuneA") NIL NIL NIL)("application" "pgp-signature" ("name" "signature.asc") NIL "This is a digitally signed message part" "7bit" 196 NIL NIL NIL NIL) "signed" ("micalg" "pgp-sha1" "protocol" "application/pgp-signature" "boundary" "=-vH3FQO9a8icUn1ROCoAi") NIL NIL NIL) 176 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Kittens give Morbo gas. --Morbo" "7bit" 3113 ("23 Oct 2003 22:32:37 -0700" "the PROPER way to do alternative/related" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066973557.4265.51.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 863 22 NIL NIL NIL NIL)(("text" "html" ("CHARSET" "utf-8") NIL NIL "8bit" 1283 22 NIL NIL NIL NIL)("image" "gif" NIL "<1066973340.4232.46.camel@localhost>" NIL "base64" 116 NIL NIL NIL NIL) "related" ("boundary" "=-bFkxH1S3HVGcxi+o/5jG") NIL NIL NIL) "alternative" ("type" "multipart/alternative" "boundary" "=-tyGlQ9JvB5uvPWzozI+y") NIL NIL NIL) 79 NIL ("inline" NIL) NIL NIL) "mixed" ("boundary" "=-qYxqvD9rbH0PNeExagh1") NIL NIL NIL))}; + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs9); +@exp = qw(1 2 2.HEAD 2.1 3 3.HEAD 3.TEXT 3.1 3.2 3.2.HEAD 3.2.TEXT 3.2.1 3.2.2 4 4.HEAD 4.1 5 5.HEAD 5.TEXT 5.1 5.2 6 6.HEAD 6.TEXT 6.1 6.2 7 7.HEAD 7.TEXT 7.1 7.2 8 8.HEAD 8.TEXT 8.1 8.2 9 9.HEAD 9.TEXT 9.1 9.2 10 10.HEAD 10.TEXT 10.1 10.1.1 10.1.1.1 10.1.1.1.1 10.1.1.1.2 10.1.1.2 10.1.2 10.2 11 11.HEAD 11.TEXT 11.1 11.2 11.2.1 11.2.2); +ok( defined $bsobj, 'parsed ninth' ); +is_deeply( [ $bsobj->parts ], \@exp, 'bs9 parts' ) + or diag( join(" ", $bsobj->parts ) ); diff --git a/Mail-IMAPClient-3.23/t/fetch_hash.t b/Mail-IMAPClient-3.25/t/fetch_hash.t similarity index 100% rename from Mail-IMAPClient-3.23/t/fetch_hash.t rename to Mail-IMAPClient-3.25/t/fetch_hash.t diff --git a/Mail-IMAPClient-3.23/t/messageset.t b/Mail-IMAPClient-3.25/t/messageset.t similarity index 100% rename from Mail-IMAPClient-3.23/t/messageset.t rename to Mail-IMAPClient-3.25/t/messageset.t diff --git a/Mail-IMAPClient-3.23/t/pod.t b/Mail-IMAPClient-3.25/t/pod.t similarity index 100% rename from Mail-IMAPClient-3.23/t/pod.t rename to Mail-IMAPClient-3.25/t/pod.t diff --git a/Mail-IMAPClient-3.23/t/simple.t b/Mail-IMAPClient-3.25/t/simple.t similarity index 100% rename from Mail-IMAPClient-3.23/t/simple.t rename to Mail-IMAPClient-3.25/t/simple.t diff --git a/Mail-IMAPClient-3.23/t/thread.t b/Mail-IMAPClient-3.25/t/thread.t similarity index 100% rename from Mail-IMAPClient-3.23/t/thread.t rename to Mail-IMAPClient-3.25/t/thread.t diff --git a/Mail-IMAPClient-3.23/test_template.txt b/Mail-IMAPClient-3.25/test_template.txt similarity index 100% rename from Mail-IMAPClient-3.23/test_template.txt rename to Mail-IMAPClient-3.25/test_template.txt diff --git a/Makefile b/Makefile index ba82f04..daba1ab 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.28 2010/02/25 23:17:25 gilles Exp gilles $ +# $Id: Makefile,v 1.29 2010/06/11 02:51:20 gilles Exp gilles $ TARGET=imapsync @@ -25,7 +25,7 @@ all: ChangeLog README VERSION touch .test .test_3xx: $(TARGET) tests.sh - CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' /usr/bin/time sh tests.sh 1>/dev/null + 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 @@ -34,7 +34,7 @@ test_quick_229: $(TARGET) 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 - CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' /usr/bin/time sh tests.sh locallocal 1>/dev/null + 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 diff --git a/README b/README index 3946bee..faef420 100644 --- a/README +++ b/README @@ -3,7 +3,7 @@ NAME Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. - $Revision: 1.311 $ + $Revision: 1.315 $ INSTALL imapsync works fine under any Unix OS with perl. @@ -246,9 +246,10 @@ IMAP SERVERS - dkimap4 2.39 - Imail 7.04 (maybe). - Success stories reported with the following 35 imap servers (software + Success stories reported with the following 36 imap servers (software names are in alphabetic order): + - 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/) @@ -369,5 +370,5 @@ SIMILAR SOFTWARES Feedback (good or bad) will always be welcome. - $Id: imapsync,v 1.311 2010/04/27 23:03:39 gilles Exp gilles $ + $Id: imapsync,v 1.315 2010/06/11 02:51:54 gilles Exp gilles $ diff --git a/TIME b/TIME index 75a3646..ce6228a 100644 --- a/TIME +++ b/TIME @@ -1 +1,4 @@ -45 minutes +130 +180 +190 Added reconnect to 2.2.9 + diff --git a/TODO b/TODO index 9d21724..2a2a0ef 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: TODO,v 1.73 2010/02/07 22:03:06 gilles Exp gilles $ +# $Id: TODO,v 1.74 2010/06/11 02:49:49 gilles Exp gilles $ TODO file for imapsync ---------------------- @@ -17,6 +17,14 @@ Fix the mailing-list archive bug with From at the beginning of a line http://www.linux-france.org/prj/imapsync_list/msg00307.html +Evaluate +http://www.rackspace.com/apps/email_hosting/migrations +http://www.yippiemove.com/ + +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" diff --git a/VERSION b/VERSION index 27b7bea..eaadd00 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.311 +1.315 diff --git a/i3 b/i3 index f5d0dc5..48179da 100755 --- a/i3 +++ b/i3 @@ -1,4 +1,4 @@ #!/bin/sh -perl -IMail-IMAPClient-3.23/lib ./imapsync "$@" +perl -IMail-IMAPClient-3.25/lib ./imapsync "$@" diff --git a/imapsync b/imapsync index a1068e4..ecbdcfe 100755 --- a/imapsync +++ b/imapsync @@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. -$Revision: 1.311 $ +$Revision: 1.315 $ =head1 INSTALL @@ -281,9 +281,10 @@ Failure stories reported with the following 4 imap servers: - dkimap4 2.39 - Imail 7.04 (maybe). -Success stories reported with the following 35 imap servers +Success stories reported with the following 36 imap servers (software names are in alphabetic order): + - 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/) @@ -426,7 +427,7 @@ Entries for imapsync: Feedback (good or bad) will always be welcome. -$Id: imapsync,v 1.311 2010/04/27 23:03:39 gilles Exp gilles $ +$Id: imapsync,v 1.315 2010/06/11 02:51:54 gilles Exp gilles $ =cut @@ -445,6 +446,9 @@ use POSIX qw(uname); 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::Simple tests => 1; use Test::More 'no_plan'; @@ -497,7 +501,7 @@ my( use vars qw ($opt_G); # missing code for this will be option. -$rcs = '$Id: imapsync,v 1.311 2010/04/27 23:03:39 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.315 2010/06/11 02:51:54 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; $VERSION = ($1) ? $1: "UNKNOWN"; @@ -562,8 +566,8 @@ while (@argv_copy) { my $banner = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.311 $ ', - '$Date: 2010/04/27 23:03:39 $ ', + '$Revision: 1.315 $ ', + '$Date: 2010/06/11 02:51:54 $ ', "\n",localhost_info(), " and the module Mail::IMAPClient version used here is ", $VERSION_IMAPClient,"\n", @@ -725,7 +729,8 @@ $foldersizes = (defined($foldersizes)) ? $foldersizes : 1; $fastio1 = (defined($fastio1)) ? $fastio1 : 0; $fastio2 = (defined($fastio2)) ? $fastio2 : 0; - +$reconnectretry1 = (defined($reconnectretry1)) ? $reconnectretry1 : 10; +$reconnectretry2 = (defined($reconnectretry2)) ? $reconnectretry2 : 10; @useheader = ("ALL") unless (@useheader); @@ -799,10 +804,7 @@ sub login_imap { $imap->Debug($debugimap); $timeout and $imap->Timeout($timeout); - ( Mail::IMAPClient->VERSION =~ /^2/ or !$imap->can("Reconnectretry")) - ? warn("--reconnectretry* requires IMAPClient >= 3.17\n") - : $imap->Reconnectretry($reconnectretry) - if ($reconnectretry); + $imap->Reconnectretry($reconnectretry) if ($reconnectretry); #$imap->connect() myconnect($imap) @@ -827,6 +829,7 @@ sub login_imap { $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; + $imap->User($user); $imap->Authuser($authuser); @@ -1764,15 +1767,32 @@ FOLDER: foreach my $h1_fold (@h1_folders) { sub tests_regexmess { - ok("blabla" eq regexmess("blabla"), "regexmess, nothing to do"); + 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'; - #print "RRR¤\n", regexmess("H1: abc\nH2: cde\n\nBody abc"), "\n"; 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 blank'); + ok( 'From:' + eq regexmess('From '), + 'From mbox 2'); + + ok( "\n" . 'From ' + eq regexmess("\n" . 'From '), + 'From mbox 3'); + + ok( "From: zzz\n" . 'From ' + eq regexmess("From zzz\n" . 'From '), + 'From mbox 4'); } sub regexmess { @@ -2469,7 +2489,7 @@ sub tests_debug { SKIP: { skip "No test in normal run" if (not $tests_debug); - tests_compare_lists(); + tests_regexmess(); } } @@ -3060,7 +3080,6 @@ no warnings 'once'; }; - *Mail::IMAPClient::Ignoresizeerrors = sub { my $self = shift; @@ -3068,6 +3087,431 @@ no warnings 'once'; 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 ); + + # 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] [$retry][" . $self->IsUnconnected . "]\n"; + } + + if ( !defined($rc) and $retry and $self->IsUnconnected) { + #print "maybe not good: $!\n"; + last + unless ( + $! == EPIPE + or $! == ECONNRESET + or $self->LastError =~ /(?:error\(.*?\)|timeout) waiting\b/i + or $self->LastError =~ /(?:socket closed|\* BYE)\b/i + + # BUG? reconnect if caller ignored/missed earlier errors? + # or $self->LastError =~ /NO not connected/ + ); + if ( $self->reconnect ) { + print "reconnect successful on try #$tries"; + } + else { + print "reconnect failed on try #$tries"; + 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 ) ); + } + + 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" ; + + $self->_record($count,[ 0, "INPUT", "$string\x0d\x0a"] ); + + 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 ; + } + } + } + + # $self->_debug("Command $string: returned $code\n"); + return $code =~ /^OK|$qgood/im ? $self : undef ; + +}; + +*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 "" + + ) { + 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"); + 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; + + # $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 ; +}; + } @@ -3125,8 +3569,6 @@ sub myconnect { } } - - sub starttls { my $self = shift; diff --git a/index.shtml b/index.shtml new file mode 100644 index 0000000..218f65c --- /dev/null +++ b/index.shtml @@ -0,0 +1,104 @@ + + + + +imapsync + + + + + + + + + + + + + + + + +

imapsync web site

+ +

What is imapsync?

+ +imapsync software is a command line tool allowing incremental and +recursive imap transfers from one mailbox to another. + +

imapsync donation

+ +Help the author to maintain imapsync and support users: +
+ + + + +
+Or offer him a book on his +wishlist
+ +Thanks in advance! + +

Latest release + +() +

+ +

imapsync download

+ +

imapsync installation

+ +

README

+ +

Frequently Asked Questions

+ +

MAILING-LIST

+ + The public mailing-list may be the best way to get support.
+ + To write on the mailing-list, the address is: + imapsync@linux-france.org
+ + To subscribe, send a message to: + imapsync-subscribe@listes.linux-france.org
+ + To unsubscribe, send a message to: + imapsync-unsubscribe@listes.linux-france.org
+ + To contact the person in charge for the list: + imapsync-request@listes.linux-france.org
+ + The list archives may be available at + + http://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! + +

TODO

+ +

COPYING

+ +

ChangeLog

+ +

CREDITS

+ + + +This document last modified + + + \ No newline at end of file diff --git a/tests.sh b/tests.sh index e363690..28c6b89 100644 --- a/tests.sh +++ b/tests.sh @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: tests.sh,v 1.101 2010/02/25 23:16:45 gilles Exp gilles $ +# $Id: tests.sh,v 1.102 2010/06/11 02:50:28 gilles Exp gilles $ # Example: # CMD_PERL='perl -I./Mail-IMAPClient-3.14/lib' sh -x tests.sh @@ -755,9 +755,9 @@ ll_tls_justlogin() { ll_tls_devel() { CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' ll_justlogin ll_ssl_justlogin \ -&& CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' ll_justlogin ll_ssl_justlogin \ +&& CMD_PERL='perl -I./Mail-IMAPClient-3.25/lib' ll_justlogin ll_ssl_justlogin \ && CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' ll_tls_justconnect ll_tls_justlogin \ -&& CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' ll_tls_justconnect ll_tls_justlogin +&& CMD_PERL='perl -I./Mail-IMAPClient-3.25/lib' ll_tls_justconnect ll_tls_justlogin } ll_tls() { @@ -979,7 +979,7 @@ allow3xx() { } noallow3xx() { - ! perl -I./Mail-IMAPClient-3.23/lib ./imapsync \ + ! perl -I./Mail-IMAPClient-3.25/lib ./imapsync \ --host1 $HOST1 --user1 tata \ --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ diff --git a/zzz b/zzz deleted file mode 100644 index 8b13789..0000000 --- a/zzz +++ /dev/null @@ -1 +0,0 @@ -