zydronium/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2025-06-05 12:17:16 +02:00
Code Issues Projects Releases Packages Wiki Activity

1.315

Browse source
This commit is contained in:
Nick Bebout 2011-03-12 02:44:53 +00:00
parent 2c9669c6af
commit 2ed353bb71
58 changed files with 1411 additions and 259 deletions
Download patch file Download diff file Expand all files Collapse all files

44
CREDITS
View file

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

24
ChangeLog
View file

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

20
FAQ
View file

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

22
Mail-IMAPClient-3.23/META.yml
View file

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

58
Mail-IMAPClient-3.23/t/bodystructure.t
View file

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

0
Mail-IMAPClient-3.23/COPYRIGHT → Mail-IMAPClient-3.25/COPYRIGHT
View file

43
Mail-IMAPClient-3.23/Changes → Mail-IMAPClient-3.25/Changes
View file

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

0
Mail-IMAPClient-3.23/INSTALL → Mail-IMAPClient-3.25/INSTALL
View file

2
Mail-IMAPClient-3.23/MANIFEST → Mail-IMAPClient-3.25/MANIFEST
View file

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

33
Mail-IMAPClient-3.25/META.yml Normal file
View file

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

19
Mail-IMAPClient-3.23/Makefile.PL → Mail-IMAPClient-3.25/Makefile.PL
View file

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

0
Mail-IMAPClient-3.23/README → Mail-IMAPClient-3.25/README
View file

0
Mail-IMAPClient-3.23/TODO → Mail-IMAPClient-3.25/TODO
View file

0
Mail-IMAPClient-3.23/examples/build_dist.pl → Mail-IMAPClient-3.25/examples/build_dist.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/build_ldif.pl → Mail-IMAPClient-3.25/examples/build_ldif.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/cleanTest.pl → Mail-IMAPClient-3.25/examples/cleanTest.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/copy_folder.pl → Mail-IMAPClient-3.25/examples/copy_folder.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/cyrus_expire.pl → Mail-IMAPClient-3.25/examples/cyrus_expire.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/cyrus_expunge.pl → Mail-IMAPClient-3.25/examples/cyrus_expunge.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/find_dup_msgs.pl → Mail-IMAPClient-3.25/examples/find_dup_msgs.pl Normal file → Executable file
View file

231
Mail-IMAPClient-3.25/examples/idle.pl Executable file
View file

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

0
Mail-IMAPClient-3.23/examples/imap_to_mbox.pl → Mail-IMAPClient-3.25/examples/imap_to_mbox.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/imtestExample.pl → Mail-IMAPClient-3.25/examples/imtestExample.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/migrate_mail2.pl → Mail-IMAPClient-3.25/examples/migrate_mail2.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/migrate_mbox.pl → Mail-IMAPClient-3.25/examples/migrate_mbox.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/populate_mailbox.pl → Mail-IMAPClient-3.25/examples/populate_mailbox.pl Normal file → Executable file
View file

0
Mail-IMAPClient-3.23/examples/sharedFolder.pl → Mail-IMAPClient-3.25/examples/sharedFolder.pl Normal file → Executable file
View file

79
Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm → Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pm
View file

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

84
Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod → Mail-IMAPClient-3.25/lib/Mail/IMAPClient.pod
View file

@ -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)
if successful, or C<undef> 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<append> method returns the UID of the new message
(if the server has the UIDPLUS capability) or a true value otherwise.
On error, C<undef> is returned and L</LastError> 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<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>.
To protect against "bare newlines", B<append> will insert a carriage
return before any newline that is "bare".
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
C<input_record_separator>. 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<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.)
Note: The brackets in the example indicate optional arguments; 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
value) if successful, or C<undef> 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<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>.
On success, the B<append_file> method returns the UID of the new
message (if the server has the UIDPLUS capability) or a true value
otherwise. On error, C<undef> is returned and L</LastError> will be
set.
In case you're wondering, B<append_file> 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<append_file> will insert a
carriage return before any newline that is "bare".
The B<append_file> 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<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
value) if successful, or C<undef> 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<append_string> method returns the UID of the new
message (if the server has the UIDPLUS capability) or a true value
otherwise. On error, C<undef> is returned and L</LastError> 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<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>.
To protect against "bare newlines", B<append_string> will insert a
carriage return before any newline that is "bare".
=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
during B<DESTROY> if the object is in the L</Connected> 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<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

39
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure.pm
View file

@ -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/\.$//;

0
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.grammar → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.grammar
View file

0
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pm → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.pm
View file

0
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pod → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/BodyStructure/Parse.pod
View file

0
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/MessageSet.pm → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/MessageSet.pm
View file

0
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.grammar → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.grammar
View file

0
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pm → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.pm
View file

0
Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pod → Mail-IMAPClient-3.25/lib/Mail/IMAPClient/Thread.pod
View file

12
Mail-IMAPClient-3.23/prepare_dist → Mail-IMAPClient-3.25/prepare_dist Normal file → Executable file
View file

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

0
Mail-IMAPClient-3.23/sample.perldb → Mail-IMAPClient-3.25/sample.perldb
View file

163
Mail-IMAPClient-3.23/t/basic.t → Mail-IMAPClient-3.25/t/basic.t
View file

@ -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" );
}

76
Mail-IMAPClient-3.25/t/body_string.t Normal file
View file

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

100
Mail-IMAPClient-3.25/t/bodystructure.t Normal file
View file

File diff suppressed because one or more lines are too long

0
Mail-IMAPClient-3.23/t/fetch_hash.t → Mail-IMAPClient-3.25/t/fetch_hash.t
View file

0
Mail-IMAPClient-3.23/t/messageset.t → Mail-IMAPClient-3.25/t/messageset.t
View file

0
Mail-IMAPClient-3.23/t/pod.t → Mail-IMAPClient-3.25/t/pod.t
View file

0
Mail-IMAPClient-3.23/t/simple.t → Mail-IMAPClient-3.25/t/simple.t
View file

0
Mail-IMAPClient-3.23/t/thread.t → Mail-IMAPClient-3.25/t/thread.t
View file

0
Mail-IMAPClient-3.23/test_template.txt → Mail-IMAPClient-3.25/test_template.txt
View file

6
Makefile
View file

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

7
README
View file

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

5
TIME
View file

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

10
TODO
View file

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

2
VERSION
View file

@ -1 +1 @@
1.311
1.315

2
i3
View file

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

476
imapsync
View file

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

104
index.shtml Normal file
View file

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

8
tests.sh
View file

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

1
zzz
View file

@ -1 +0,0 @@