r51516 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod t/basic.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Mon Jan 25 01:53:06 UTC 2010
Author: jawnsy-guest
Date: Mon Jan 25 01:53:01 2010
New Revision: 51516
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=51516
Log:
[svn-upgrade] Integrating new upstream version, libmail-imapclient-perl (3.22)
Modified:
branches/upstream/libmail-imapclient-perl/current/Changes
branches/upstream/libmail-imapclient-perl/current/META.yml
branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod
branches/upstream/libmail-imapclient-perl/current/t/basic.t
Modified: branches/upstream/libmail-imapclient-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/Changes?rev=51516&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Mon Jan 25 01:53:01 2010
@@ -1,9 +1,16 @@
== Revision History for Mail::IMAPClient
-Changes from 3.17_01 to ? made by Phil Lobbes
+Changes from 3.17_01 to ? made by Phil Pearl (Lobbes)
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.22: Thu Jan 21 15:25:54 EST 2010
+ - rt.cpan.org#52313: Getting read errors if Fast_io is set to 1
+ [Jukka Huhta]
+ - updated Maxttemperrors docs related to EAGAIN handling
+ - new starttls() method and Starttls attribute to support STARTTLS
+ - update parse_headers to try harder to find UID in fetch response
version 3.21: Tue Sep 22 19:45:13 EDT 2009
- rt.cpan.org#49691: rewrite of fetch_hash to resolve several issues
Modified: branches/upstream/libmail-imapclient-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/META.yml?rev=51516&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Mon Jan 25 01:53:01 2010
@@ -1,7 +1,7 @@
# 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.21
+version: 3.22
version_from: lib/Mail/IMAPClient.pm
installdirs: site
requires:
Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm?rev=51516&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Mon Jan 25 01:53:01 2010
@@ -5,7 +5,7 @@
use warnings;
package Mail::IMAPClient;
-our $VERSION = '3.21';
+our $VERSION = '3.22';
use Mail::IMAPClient::MessageSet;
@@ -66,7 +66,7 @@
Maxcommandlength Maxtemperrors Password Peek Port
Prewritemethod Proxy Ranges Readmethod Reconnectretry
Server Showcredentials State Supportedflags Timeout Uid
- User Ssl)
+ User Ssl Starttls)
)
{
no strict 'refs';
@@ -101,7 +101,7 @@
sub Fast_io(;$) {
my ( $self, $use ) = @_;
defined $use
- or return $self->{File_io};
+ or return $self->{Fast_io};
my $socket = $self->{Socket}
or return undef;
@@ -239,7 +239,7 @@
Clear => 5,
Keepalive => 0,
Maxcommandlength => 1000,
- Maxtemperrors => 'unlimited',
+ Maxtemperrors => undef,
State => Unconnected,
Authmechanism => 'LOGIN',
Port => 143,
@@ -366,7 +366,59 @@
return $self;
}
+ if ( $self->Starttls ) {
+ $self->starttls or return undef;
+ }
+
$self->User && $self->Password ? $self->login : $self;
+}
+
+# RFC2595 section 3.1
+sub starttls {
+ my ($self) = @_;
+
+ # BUG? RFC requirement checks commented out for now...
+ #if ( $self->IsUnconnected or $self->IsAuthenticated ) {
+ # $self->LastError("NO must be connected but not authenticated");
+ # return undef;
+ #}
+
+ # BUG? strict check on capability commented out for now...
+ #return undef unless $self->has_capability("STARTTLS");
+
+ $self->_imap_command("STARTTLS") or return undef;
+
+ # MUST discard cached capability info; should re-issue capability command
+ delete $self->{CAPABILITY};
+
+ my $ioclass = "IO::Socket::SSL";
+ eval "require $ioclass";
+ if ($@) {
+ $self->LastError("Unable to load '$ioclass' for starttls: $@");
+ return undef;
+ }
+
+ my $sock = $self->RawSocket;
+ my $blocking = $sock->blocking;
+
+ # BUG: force blocking for now
+ $sock->blocking(1);
+
+ # give caller control of args to start_SSL if desired
+ my @sslargs =
+ ( $self->Starttls and ref( $self->Starttls ) eq "ARRAY" )
+ ? ( @${ $self->Starttls } )
+ : ( Timeout => 30 );
+
+ unless ( $ioclass->start_SSL( $sock, @sslargs ) ) {
+ $self->LastError( "Unable to start TLS: " . $ioclass->errstr );
+ return undef;
+ }
+
+ # return blocking to previous setting
+ $sock->blocking($blocking);
+
+ return $self;
}
sub login {
@@ -978,8 +1030,8 @@
my $temperrs = 0;
my $waittime = .02;
my $maxwrite = 0;
- my $maxagain = $self->Maxtemperrors || 10;
- undef $maxagain if $maxagain eq 'unlimited';
+ my $maxagain = $self->Maxtemperrors;
+ undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited';
my @previous_writes;
while ( $wroteSoFar < $chunk ) {
@@ -1452,8 +1504,8 @@
my $waittime = .02;
my @previous_writes;
- my $maxagain = $self->Maxtemperrors || 10;
- undef $maxagain if $maxagain eq 'unlimited';
+ my $maxagain = $self->Maxtemperrors;
+ undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited';
local $SIG{PIPE} = 'IGNORE'; # handle SIGPIPE as normal error
@@ -1520,6 +1572,10 @@
my $index = $self->_next_index;
my $timeout = $self->Timeout;
my $readlen = $self->{Buffer} || 4096;
+
+ my $temperrs = 0;
+ my $maxagain = $self->Maxtemperrors;
+ undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited';
until (
@$oBuffer # there's stuff in output buffer:
@@ -1554,9 +1610,25 @@
my $emsg;
my $ret =
$self->_sysread( $socket, \$iBuffer, $readlen, length $iBuffer );
- if ( $timeout && !defined $ret ) {
- $emsg = "error while reading data from server: $!";
- $self->State(Unconnected) if ( $! == ECONNRESET );
+
+ if ($timeout) {
+ if ( defined $ret ) {
+ $temperrs = 0;
+ }
+ else {
+ $emsg = "error while reading data from server: $!";
+ if ( $! == ECONNRESET ) {
+ $self->State(Unconnected);
+ }
+ elsif ( $! == EAGAIN ) {
+ if ( defined $maxagain && $temperrs++ >= $maxagain ) {
+ $emsg .= " ($temperrs)";
+ }
+ else {
+ next; # try again
+ }
+ }
+ }
}
if ( defined $ret && $ret == 0 ) { # Caught EOF...
@@ -1608,6 +1680,10 @@
else { # literal data still to arrive
$litstring = $iBuffer;
$iBuffer = '';
+
+ my $temperrs = 0;
+ my $maxagain = $self->Maxtemperrors;
+ undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited';
while ( $expected_size > length $litstring ) {
if ($timeout) {
@@ -1639,9 +1715,27 @@
length $litstring
);
- if ( $timeout && !defined $ret ) {
- $emsg = "error while reading data from server: $!";
- $self->State(Unconnected) if ( $! == ECONNRESET );
+ if ($timeout) {
+ if ( defined $ret ) {
+ $temperrs = 0;
+ }
+ else {
+ $emsg = "error while reading data from server: $!";
+ if ( $! == ECONNRESET ) {
+ $self->State(Unconnected);
+ }
+ elsif ( $! == EAGAIN ) {
+ if ( defined $maxagain
+ && $temperrs++ >= $maxagain )
+ {
+ $emsg .= " ($temperrs)";
+ }
+ else {
+ undef $emsg;
+ next; # try again
+ }
+ }
+ }
}
# EOF: note IO::Socket::SSL does not support eof()
@@ -1789,6 +1883,7 @@
sub _disconnect {
my $self = shift;
+ delete $self->{CAPABILITY};
delete $self->{Folders};
delete $self->{_IMAP4REV1};
$self->State(Unconnected);
@@ -2305,6 +2400,7 @@
. ( $fields eq 'ALL' ? '[HEADER]' : "[HEADER.FIELDS ($fields)]" );
my $raw = $self->fetch($string) or return undef;
+ my $cmd = shift @$raw;
my %headers; # message ids to headers
my $h; # fields for current msgid
@@ -2312,6 +2408,7 @@
my %fieldmap = map { ( lc($_) => $_ ) } @fields;
my $msgid;
+ # BUG: parsing this way is prone to be buggy but works most of the time
# some example responses:
# * OK Message 1 no longer exists
# * 1 FETCH (UID 26535 BODY[HEADER] "")
@@ -2319,7 +2416,7 @@
# header: value...
foreach my $header ( map { split /$CR?$LF/o } @$raw ) {
- # little problem: Windows2003 has UID as body, not in header
+ # Windows2003/Maillennium/others? have UID after headers
if (
$header =~ s/^\* \s+ (\d+) \s+ FETCH \s+
\( (.*?) BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix
@@ -2331,7 +2428,6 @@
{
$msgid = $msgattrs =~ m/\b UID \s+ (\d+)/x ? $1 : undef;
}
-
$headers{$msgid} = $h if $msgid;
}
$header =~ /\S/ or next; # skip empty lines.
@@ -2341,8 +2437,9 @@
undef $h; # inbetween headers
next;
}
- elsif ( !$msgid && $header =~ /^\s*UID\s+(\d+)\s*\)/ ) {
- $headers{$1} = $h; # finally found msgid, win2003
+ elsif ( !$msgid && $header =~ /^\s*UID\s+(\d+).*\)$/ ) {
+ $headers{$1} = $h; # found UID win2003/Maillennium
+
undef $h;
next;
}
Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod?rev=51516&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod Mon Jan 25 01:53:01 2010
@@ -171,7 +171,8 @@
authentication technique you may choose to set up your own socket
connection and then set this parameter manually, bypassing the
B<connect> method completely. This is also useful if you want to use
-L<IO::Socket::INET> alternatives, like L<IO::Socket::SSL>.
+L<IO::Socket::INET> alternatives like L<IO::Socket::SSL> and need full
+control.
L</RawSocket> simply gets/sets the socket without attempting any
interaction on it. In this case, you have to be sure to handle all
@@ -182,10 +183,9 @@
Unlike L</RawSocket>, L</Socket> attempts to carry on preliminary
connection phases if the conditions apply. If both parameters are
-present, this takes the precedence over L</RawSocket>. It is primarily
-used to provide an alternative socket for communications, e.g. to use
-L<IO::Socket::SSL> instead of L<IO::Socket::INET> used by L</connect>
-by default.
+present, this takes the precedence over L</RawSocket>. If
+L</Starttls> is set, then the L</starttls> method will be called by
+L</Socket>.
B<PLEASE NOTE> As of version 2.99_04 of this module, semantics for
L</Socket> have changed to make it more "DWIM". L</RawSocket> was
@@ -1316,6 +1316,8 @@
If the server does not support the XLIST extension, this method
returns undef.
+
+Version note: method added in Mail::IMAPClient 3.21
=head2 has_capability
@@ -2025,6 +2027,8 @@
the (same) $imap object. On failure <undef> is returned and
L</LastError> is set.
+Version note: method added in Mail::IMAPClient 3.17
+
=head2 rename
Example:
@@ -2463,6 +2467,24 @@
The sort method will clear C<$@> before attempting the I<SORT>
operation just as the L</search> method does.
+
+=head2 starttls
+
+Example:
+
+ $imap->starttls() or die "starttls failed: $@\n";
+
+The B<starttls> method accepts no arguments. This method is used to
+upgrade an exiting connection which is not authenticated to a TLS/SSL
+connection by using the IMAP STARTTLS command followed by using the
+B<start_SSL> class method from L<IO::Socket::SSL> to do the necessary
+TLS negotiation. The negotiation is done in a blocking fashion with a
+default B<Timeout> of 30 seconds. The arguments used in the call to
+B<start_SSL> can be controlled by setting the Mail::IMAPClient
+L</Starttls> attribute to an ARRAY reference containing the desired
+arguments.
+
+Version note: method added in Mail::IMAPClient 3.22
=head2 status
@@ -3053,22 +3075,21 @@
$Maxtemperrors = $imap->Maxtemperrors();
# or:
- $imap->Maxtemperrors($new_value);
-
-The I<Maxtemperrors> parameter specifies the number of times a write
-operation is allowed to fail on a "Resource Temporarily Available"
-error. These errors can occur from time to time if the server is too
-busy to empty out its read buffer (which is logically the "other end"
-of the client's write buffer). By default, Mail::IMAPClient will
-retry an unlimited number of times, but you can adjust this behavior
-by setting I<Maxtemperrors>. Note that after each temporary error,
-the server will wait for a number of seconds equal to the number of
-consecutive temporary errors times .25, so very high values for
-I<Maxtemperrors> can slow you down in a big way if your "temporary
-error" is not all that temporary.
-
-You can set this parameter to "UNLIMITED" to ignore "Resource
-Temporarily Unavailable" errors. This is the default.
+ $imap->Maxtemperrors($number);
+
+The I<Maxtemperrors> parameter specifies the number of times a read or
+write operation is allowed to fail on a "Resource Temporarily
+Available" (e.g. EAGAIN) error. The default setting is I<undef> which
+means there is no limit.
+
+Setting this parameter to the string "unlimited" (instead of undef) to
+ignore "Resource Temporarily Unavailable" errors is deprecated.
+
+B<Note>: This setting should be used with caution and may be removed
+in a future release. Setting this can cause methods to return to the
+caller before data is received (and then handled) properly thereby
+possibly then leaving the module in a bad state. In the future, this
+behavior may be changed in an attempt to avoid this situation.
=head2 Password
@@ -3359,6 +3380,18 @@
If you need more control over the socket, e.g. you have to implement a
fancier authentication method, see L</RawSocket>.
+
+=head2 Starttls
+
+If an IMAP connection must start TLS/SSL after connecting to a server
+then set this attribute. If the value is set to an arrayref then they
+will be used as arguments to IO::Socket::SSL::start_SSL. By default
+this connection is set to blocking while establishing the connection
+with a timeout of 30 seconds. The socket will be reset to the
+original blocking/non-blocking value after a successful TLS
+negotiation has occured.
+
+Version note: attribute added in Mail::IMAPClient 3.22
=head2 Ssl
@@ -3636,6 +3669,8 @@
Copyright 2007, 2008, 2009 Mark Overmeer
+ Copyright 2010 Phil Pearl (Lobbes)
+
This program is free software; you can redistribute under the same
terms as Perl itself.
Modified: branches/upstream/libmail-imapclient-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/t/basic.t?rev=51516&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/t/basic.t (original)
+++ branches/upstream/libmail-imapclient-perl/current/t/basic.t Mon Jan 25 01:53:01 2010
@@ -32,12 +32,12 @@
@missing
? plan skip_all => "missing value for: @missing"
- : plan tests => 64;
+ : plan tests => 66;
}
BEGIN { use_ok('Mail::IMAPClient') or exit; }
-my $imap = Mail::IMAPClient->new(
+my @new_args = (
Server => $parms{server},
Port => $parms{port},
User => $parms{user},
@@ -46,9 +46,12 @@
Clear => 0,
Fast_IO => $fast,
Uid => $uidplus,
- Range => $range,
-
- Debug => $debug,
+ Debug => $debug,
+);
+
+my $imap = Mail::IMAPClient->new(
+ @new_args,
+ Range => $range,
Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef )
);
@@ -243,19 +246,9 @@
#
my $im2 = Mail::IMAPClient->new(
- Server => $parms{server},
- Port => $parms{port},
- User => $parms{user},
- Password => $parms{passed},
- Authmechanism => $parms{authmechanism},
- Clear => 0,
- ,
- Timeout => 30,
- ,
- Debug => $debug,
+ @new_args,
+ Timeout => 30,
Debug_fh => ( $debug ? IO::File->new(">./imap2.debug") : undef ),
- Fast_IO => $fast,
- Uid => $uidplus
);
ok( defined $im2, 'started second imap client' );
@@ -346,3 +339,10 @@
$imap->_disconnect;
ok( $imap->reconnect, "reconnect" );
+
+# Test STARTTLS - an optional feature so tests always succeed
+{
+ ok( $imap->logout, "logout" );
+ $imap->connect( Starttls => 1 );
+ ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) );
+}
More information about the Pkg-perl-cvs-commits
mailing list