1.315

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

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.
 ----------------------------

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.
+a) use --idatefromheader to set the internal dates on host2 same as the 
-b) Use the --syncinternaldates option and keep using Eudora :-)
+   "Date:" headers.
-c) Use the script learn/adjust_time.pl to change the internal dates
+b) In Maildir boxes, after the sync (too late...), use the script
-   from the "Date:" header.
+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. 

Mail-IMAPClient-3.23/META.yml

@@ -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

Mail-IMAPClient-3.23/t/bodystructure.t

@@ -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' );

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

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

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) <phil@zimbra.com>
+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

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 <phil@zimbra.com>' )
+      ( AUTHOR => 'Phil Pearl (Lobbes) <phil@zimbra.com>' )
     : ()
 );
 
@@ -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)";
+    # HACK: alarm() allows broken interfaces to timeout gracefully...
-    return if $yes !~ /^y(?:es)?$/i;
+    # - 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";

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=<server>    *IMAP server name/IP
+    --o User=<user>        *User account to login to
+    --o Password=<passwd>  *Password to use for the User account
+                           (see security note below)
+    --o Port=<port>        port on Server to connect to
+    --o Ssl=<bool>         use SSL on this connection
+    --o Starttls=<bool>    call STARTTLS on this connection
+    --o Debug=<int>        enable debugging in Mail::IMAPClient
+    --o ImapclientKey=Val  any other Mail::IMAPClient attribute/value pair
+    --folder <folder>      folder (mailbox) to IMAP SELECT (INBOX)
+    --maxidle <sec>        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=<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 <sec>
+
+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
+            # - <tag> 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=<val> 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;
+}

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
+    $popped = pop @$ref
-      until ( $popped && $popped =~ /\)$CRLF$/o )    # (-: vi
+      until ( $popped && $popped =~ /^\)$CRLF$/o )
-      || !grep /\)$CRLF$/o, @$ref;
+      || !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;
+    my ( $rc, $ret );
-    while (
+
-        (
+    do {
-            $rc =
+        $ret =
-            $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout )
+          $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout );
-        ) > 0
+
-      )
+        # set rc on first pass or on errors
-    {
+        $rc = $ret if ( !defined($rc) or $ret < 0 );
-        $self->_get_response( '*', qr/\S+/ ) or return undef;
+
-    }
+        # 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;
+    my ( $buffer, $buflen ) = ( "", 0 );
-    while ( $fh->sysread( $buffer, APPEND_BUFFER_SIZE ) ) {
+    until ( !$buflen and eof($fh) ) {
-        $buffer =~ s/\r?\n/$CRLF/og;
+
+        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

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<append> 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 <CR><LF>.
 
-The B<append> method returns the UID of the new message (a true value)
+On success, the B<append> method returns the UID of the new message
-if successful, or C<undef> if not, if the IMAP server has the UIDPLUS
+(if the server has the UIDPLUS capability) or a true value otherwise.
-capability.  If it doesn't then you just get true on success and undef
+On error, C<undef> is returned and L</LastError> will be set.
-on failure.
 
-Note that many servers will get really ticked off if you try to append
+To protect against "bare newlines", B<append> will insert a carriage
-a message that contains "bare newlines", which is the titillating term
+return before any newline that is "bare".
-given to newlines that are not preceded by a carriage return.  To
-protect against this, B<append> 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<append>.
 
 Note that B<append> 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<append_file> 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
+Note: The brackets in the example indicate optional arguments; they do
-C<input_record_separator>.  The default is to use "" for the first
+not mean that the argument should be an array reference.
-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<perlvar|perlvar> 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.)
 
-The B<append_file> method returns the UID of the new message (a true
+On success, the B<append_file> method returns the UID of the new
-value) if successful, or C<undef> if not, if the IMAP server has the
+message (if the server has the UIDPLUS capability) or a true value
-UIDPLUS capability.  If it doesn't then you just get true on success
+otherwise.  On error, C<undef> is returned and L</LastError> will be
-and undef on failure.  If you supply a filename that doesn't exist
+set.
-then you get an automatic C<undef>.  The L</LastError> method will
-remind you of this if you forget that your file doesn't exist but
-somehow manage to remember to check L</LastError>.
 
-In case you're wondering, B<append_file> is provided mostly as a way
+To protect against "bare newlines", B<append_file> will insert a
-to allow large messages to be appended without having to have the
+carriage return before any newline that is "bare".
-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
+The B<append_file> method provides a mechanism for allowing large
-not, depending on whether you supplied that optional third argument).
+messages to be appended without holding the whole file in memory.
+
+Version note: In 2.x an optional third argument to use for
+C<input_record_separator> 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<append_string> 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<undef> as the third argument.
 
-The B<append_string> method returns the UID of the new message (a true
+On success, the B<append_string> method returns the UID of the new
-value) if successful, or C<undef> if not, if the IMAP server has the
+message (if the server has the UIDPLUS capability) or a true value
-UIDPLUS capability.  If it doesn't then you just get true on success
+otherwise.  On error, C<undef> is returned and L</LastError> will be
-and undef on failure.
+set.
 
-Note that many servers will get really ticked off if you try to append
+To protect against "bare newlines", B<append_string> will insert a
-a message that contains "bare newlines", which is the titillating term
+carriage return before any newline that is "bare".
-given to newlines that are not preceded by a carriage return.  To
-protect against this, B<append_string> 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<append_string>.
 
 =head2 authenticate
 
@@ -1583,8 +1569,16 @@ client enters the I<Unconnected> state.  This method does not, destroy
 the IMAPClient object, thus the L</connect> and L</login> methods can
 be used to establish a new IMAP session.
 
-Per RFC2683, Mail::IMAPClient will attempt to log out of the server
+Note that RFC2683 section 3.1.2 (Severed connections) makes some
-during B<DESTROY> if the object is in the L</Connected> state.
+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<DESTROY> if the object is in the L</Connected> state.  This
+documentation was apparently incorrect from at least 2.2.2 and
+possibly earlier versions on up.
 
 =head2 lsub
 

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->{_id}     ||= $HEAD;
-        $self->{_prefix} ||= "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/\.$//;

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 <FH>;
+}
 
 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($$)
+sub build_parser {
-{   my ($grammarfn, $package) = @_;
+    my ($grammarfn, $package) = @_;
 
     print "* building $package\n";
 

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 = (
+my %new_args = (
-    Server        => $parms{server},
+    Server        => delete $parms{server},
-    Port          => $parms{port},
+    Port          => delete $parms{port},
-    User          => $parms{user},
+    User          => delete $parms{user},
-    Password      => $parms{passed},
+    Password      => delete $parms{passed},
-    Authmechanism => $parms{authmech},
+    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}>
+To: <$new_args{User}\@$new_args{Server}>
-From: Perl <$parms{user}\@$parms{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" );
+}

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 );

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

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 $
 

TIME

@@ -1 +1,4 @@
-45 minutes
+130
+180
+190 Added reconnect to 2.2.9
+

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"

VERSION

@@ -1 +1 @@
-1.311
+1.315

i3

@@ -1,4 +1,4 @@
 #!/bin/sh
 
-perl -IMail-IMAPClient-3.23/lib ./imapsync "$@"
+perl -IMail-IMAPClient-3.25/lib ./imapsync "$@"
 

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 $ ',
+		  '$Revision: 1.315 $ ',
-		  '$Date: 2010/04/27 23:03:39 $ ',
+		  '$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"))
+	$imap->Reconnectretry($reconnectretry) if ($reconnectretry);
-	  ? warn("--reconnectretry* requires IMAPClient >= 3.17\n")
-	  : $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:<tartanpion@machin.truc>' 
+				eq regexmess('From <tartanpion@machin.truc>'),
+				'From mbox 2');
+				
+				ok(          "\n" . 'From <tartanpion@machin.truc>' 
+				eq regexmess("\n" . 'From <tartanpion@machin.truc>'),
+				'From mbox 3');
+				
+				ok(          "From: zzz\n" . 'From <tartanpion@machin.truc>' 
+				eq regexmess("From  zzz\n" . 'From <tartanpion@machin.truc>'),
+				'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])}<<END OF RESULT>>\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<<END>>\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: <BEGIN>${current_line}<END>\n" .
+		   # 	"and left with buffer contents of: <BEGIN>${iBuffer}<END>\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<END_OF_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<END>\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<<END OF BUFFER>>\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;

index.shtml

@@ -0,0 +1,104 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>imapsync</title>
+<meta name="generator" content="Bluefish 1.0.7"/>
+<meta name="author" content="Gilles LAMIRAL"/>
+<meta name="date" content="2010-06-22T18:26:45+0200"/>
+<meta name="copyright" content="None"/>
+<meta name="keywords" content="imap, transfert, migration"/>
+<meta name="description" content="imap migration tool"/>
+<meta http-equiv="content-type" content="text/html; charset=UTF-8"/>
+<meta http-equiv="content-type" content="application/xhtml+xml; charset=UTF-8"/>
+<meta http-equiv="content-style-type" content="text/css"/>
+<meta http-equiv="expires" content="0"/>
+</head>
+<body>
+
+<script type="text/javascript"><!--
+google_ad_client = "pub-2680256394263335";
+/* imasync large 728x90 */
+google_ad_slot = "6321738813";
+google_ad_width = 728;
+google_ad_height = 90;
+//-->
+</script>
+<script type="text/javascript"
+src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
+</script>
+
+<h1><a href="http://www.linux-france.org/prj/imapsync/">imapsync web site</a></h1>
+
+<h2>What is imapsync?</h2>
+
+<b>imapsync</b> software is a command line tool allowing incremental and
+recursive <b>imap</b> transfers from one mailbox to another. 
+
+<h2>imapsync donation</h2>
+
+Help the author to maintain imapsync and support users:
+<form action="https://www.paypal.com/cgi-bin/webscr" method="post">
+<input type="hidden" name="cmd" value="_s-xclick">
+<input type="hidden" name="encrypted" value="-----BEGIN PKCS7-----MIIHNwYJKoZIhvcNAQcEoIIHKDCCByQCAQExggEwMIIBLAIBADCBlDCBjjELMAkGA1UEBhMCVVMxCzAJBgNVBAgTAkNBMRYwFAYDVQQHEw1Nb3VudGFpbiBWaWV3MRQwEgYDVQQKEwtQYXlQYWwgSW5jLjETMBEGA1UECxQKbGl2ZV9jZXJ0czERMA8GA1UEAxQIbGl2ZV9hcGkxHDAaBgkqhkiG9w0BCQEWDXJlQHBheXBhbC5jb20CAQAwDQYJKoZIhvcNAQEBBQAEgYCLqDFNLHWLnXOTR6fg5I/197IlWQ3GWa5cEph059d7/DGlRks59x3ehGkOe07+JrJBdmNmz7UnDGEFpaY4N+aum6pt+SB6tRGsGFpvqbaS7PTxH4unt4P02ekxl+sMSsCDRpTON5EqZDu/u59XpftzuzESOKxYi5QqyP0nKtXa9TELMAkGBSsOAwIaBQAwgbQGCSqGSIb3DQEHATAUBggqhkiG9w0DBwQIgQDw/j9EPAyAgZCurQXtibGHD+s+xFdIWW93rzpNFjoV+nWclf2nsMhu5g7lT4fIIEzeJc29zuAzY+ySQKZxoKYZKYAjKRteDnCytBmcrz0/+C1VmxLWjweZA5NQQhys6uqCMkYj/iNsRodsBtlCeg8jYoSZM64gdWfoQahOzzdA0oOWXF1j9kYFmqoyQDQU2cS97ZezbXlo7migggOHMIIDgzCCAuygAwIBAgIBADANBgkqhkiG9w0BAQUFADCBjjELMAkGA1UEBhMCVVMxCzAJBgNVBAgTAkNBMRYwFAYDVQQHEw1Nb3VudGFpbiBWaWV3MRQwEgYDVQQKEwtQYXlQYWwgSW5jLjETMBEGA1UECxQKbGl2ZV9jZXJ0czERMA8GA1UEAxQIbGl2ZV9hcGkxHDAaBgkqhkiG9w0BCQEWDXJlQHBheXBhbC5jb20wHhcNMDQwMjEzMTAxMzE1WhcNMzUwMjEzMTAxMzE1WjCBjjELMAkGA1UEBhMCVVMxCzAJBgNVBAgTAkNBMRYwFAYDVQQHEw1Nb3VudGFpbiBWaWV3MRQwEgYDVQQKEwtQYXlQYWwgSW5jLjETMBEGA1UECxQKbGl2ZV9jZXJ0czERMA8GA1UEAxQIbGl2ZV9hcGkxHDAaBgkqhkiG9w0BCQEWDXJlQHBheXBhbC5jb20wgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBAMFHTt38RMxLXJyO2SmS+Ndl72T7oKJ4u4uw+6awntALWh03PewmIJuzbALScsTS4sZoS1fKciBGoh11gIfHzylvkdNe/hJl66/RGqrj5rFb08sAABNTzDTiqqNpJeBsYs/c2aiGozptX2RlnBktH+SUNpAajW724Nv2Wvhif6sFAgMBAAGjge4wgeswHQYDVR0OBBYEFJaffLvGbxe9WT9S1wob7BDWZJRrMIG7BgNVHSMEgbMwgbCAFJaffLvGbxe9WT9S1wob7BDWZJRroYGUpIGRMIGOMQswCQYDVQQGEwJVUzELMAkGA1UECBMCQ0ExFjAUBgNVBAcTDU1vdW50YWluIFZpZXcxFDASBgNVBAoTC1BheVBhbCBJbmMuMRMwEQYDVQQLFApsaXZlX2NlcnRzMREwDwYDVQQDFAhsaXZlX2FwaTEcMBoGCSqGSIb3DQEJARYNcmVAcGF5cGFsLmNvbYIBADAMBgNVHRMEBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAIFfOlaagFrl71+jq6OKidbWFSE+Q4FqROvdgIONth+8kSK//Y/4ihuE4Ymvzn5ceE3S/iBSQQMjyvb+s2TWbQYDwcp129OPIbD9epdr4tJOUNiSojw7BHwYRiPh58S1xGlFgHFXwrEBb3dgNbMUa+u4qectsMAXpVHnD9wIyfmHMYIBmjCCAZYCAQEwgZQwgY4xCzAJBgNVBAYTAlVTMQswCQYDVQQIEwJDQTEWMBQGA1UEBxMNTW91bnRhaW4gVmlldzEUMBIGA1UEChMLUGF5UGFsIEluYy4xEzARBgNVBAsUCmxpdmVfY2VydHMxETAPBgNVBAMUCGxpdmVfYXBpMRwwGgYJKoZIhvcNAQkBFg1yZUBwYXlwYWwuY29tAgEAMAkGBSsOAwIaBQCgXTAYBgkqhkiG9w0BCQMxCwYJKoZIhvcNAQcBMBwGCSqGSIb3DQEJBTEPFw0xMDAxMTIwNDU1MTJaMCMGCSqGSIb3DQEJBDEWBBRqMaroJyi3sCMzp13JlujgbHO7pzANBgkqhkiG9w0BAQEFAASBgLajMBwporC1VxI+HKolT50xvSy38NG7f0TaYG964GZDF0snOlZRr5Is0k3fp/nZxgK1vIn7gmfkR9rrz09bIriyPrU4SJ1lgbFv4r/c7Bg22bMdbjJsgMVEaPin+3Kz1W2v90TkNGRx7LaMhJVKoDzTdVBXXU45sxfTlOkXCej+-----END PKCS7-----
+">
+<input type="image" src="https://www.paypal.com/en_US/i/btn/btn_donateCC_LG_global.gif" border="0" name="submit" alt="PayPal - The safer, easier way to pay online.">
+<img alt="" border="0" src="https://www.paypal.com/fr_FR/i/scr/pixel.gif" width="1" height="1">
+</form>
+Or offer him a book on his 
+<a href="http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/"><b>wishlist</b></a><br>
+
+<b><i>Thanks in advance!</i></b>
+
+<h2><a href="VERSION">Latest release 
+<!--#exec cmd="cat VERSION" --> 
+(<!--#flastmod file="imapsync" -->)
+</a></h2>
+
+<h2><a href="dist/?C=M;O=D">imapsync download</a></h2>
+
+<h2><a href="INSTALL">imapsync installation</a></h2>
+
+<h2><a href="README">README</a></h2>
+
+<h2><a href="FAQ">Frequently Asked Questions</a></h2>
+
+<h2>MAILING-LIST</h2>
+
+    The public mailing-list may be the best way to get support.<br>
+
+    To <b>write</b> on the mailing-list, the address is:
+    <b>imapsync@linux-france.org</b><br>
+
+    To <b>subscribe</b>, send a message to:
+    <b>imapsync-subscribe@listes.linux-france.org</b><br>
+
+    To <b>unsubscribe</b>, send a message to:
+    <b>imapsync-unsubscribe@listes.linux-france.org</b><br>
+
+    To <b>contact</b> the person in charge for the list:
+    <b>imapsync-request@listes.linux-france.org</b><br>
+
+    The <b>list archives</b> may be available at
+    <a href="http://www.linux-france.org/prj/imapsync_list/">
+    http://linux-france.org/prj/imapsync_list/</a><br>
+    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.<br>
+
+    <b>Thank you for your participation!</b>
+
+<h2><a href="TODO">TODO</a></h2>
+
+<h2><a href="COPYING">COPYING</a></h2>
+
+<h2><a href="ChangeLog">ChangeLog</a></h2>
+
+<h2><a href="CREDITS">CREDITS</a></h2>
+
+<!--#config timefmt="%D" -->
+<!--#config timefmt="%A %B %d, %Y" -->
+This document last modified <!--#echo var="LAST_MODIFIED" -->
+
+</body>
+</html>

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 \

zzz

@@ -1 +0,0 @@
-