zydronium/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2025-06-08 21:54:31 +02:00
Code Issues Projects Releases Packages Wiki Activity

1.249

Browse source
This commit is contained in:
Nick Bebout 2011-03-12 02:44:36 +00:00
parent 32596eb877
commit 1c5b2411f6
61 changed files with 4403 additions and 18975 deletions
Download patch file Download diff file Expand all files Collapse all files

9
BUG_IMAPClient_3.xx Normal file
View file

@ -0,0 +1,9 @@
BUGS found with Mail-IMAPClient-3.05/
1) --ssl* bugs.
30 timeout.
2) --expunge2 does not expunge anything.

17
CREDITS
View file

@ -14,6 +14,23 @@ b) If you can read french, please use the following wishlist :
c) its paypal account gilles.lamiral@laposte.net c) its paypal account gilles.lamiral@laposte.net
Blake Heinemann
Contributed by giving the book
"Perl Testing: A Developer's Notebook"
Nathan Mills
Contributed by giving the book
"Mapping Hacks"
Patrick Dayton (Medicus Insurance Compagny)
Contributed by giving the book
"Perl Hacks"
Daniel Kohn
Contributed by giving the book
"Combinatorial Optimization: Algorithms and Complexity"
Cvitkovich Andres Cvitkovich Andres
Gave a patch to implement Gave a patch to implement

41
ChangeLog
View file

@ -1,17 +1,50 @@
RCS file: RCS/imapsync,v RCS file: RCS/imapsync,v
Working file: imapsync Working file: imapsync
head: 1.241 head: 1.249
branch: branch:
locks: strict locks: strict
gilles: 1.241
access list: access list:
symbolic names: symbolic names:
keyword substitution: kv keyword substitution: kv
total revisions: 241; selected revisions: 241 total revisions: 249; selected revisions: 249
description: description:
---------------------------- ----------------------------
revision 1.241 locked by: gilles; revision 1.249
date: 2008/03/19 02:14:24; author: gilles; state: Exp; lines: +7 -7
warn about BUG_IMAPClient_3.xx
----------------------------
revision 1.248
date: 2008/03/19 02:05:46; author: gilles; state: Exp; lines: +14 -19
Cleaned check_lib_version()
----------------------------
revision 1.247
date: 2008/03/19 01:41:49; author: gilles; state: Exp; lines: +1 -1
Added id in output warn when no header found.
----------------------------
revision 1.246
date: 2008/03/19 01:07:26; author: gilles; state: Exp; lines: +19 -16
Removed $^W use.
----------------------------
revision 1.245
date: 2008/03/10 23:49:42; author: gilles; state: Exp; lines: +53 -23
Back to append_string()
Turn on --syncinternaldates by default
Date_Init("TZ=GMT") if no timezone (windows) set.
----------------------------
revision 1.244
date: 2008/02/29 22:43:22; author: gilles; state: Exp; lines: +5 -545
Removed old *_2() functions (unused)
----------------------------
revision 1.243
date: 2008/02/29 16:47:58; author: gilles; state: Exp; lines: +632 -53
Moved functins *_2() into override_imapclient()
----------------------------
revision 1.242
date: 2008/02/29 00:28:15; author: gilles; state: Exp; lines: +24 -13
Ignore message when it has no header.
----------------------------
revision 1.241
date: 2007/12/31 13:39:02; author: gilles; state: Exp; lines: +6 -6 date: 2007/12/31 13:39:02; author: gilles; state: Exp; lines: +6 -6
Bug fix. --exclude and remove_from_requested_folders() Bug fix. --exclude and remove_from_requested_folders()
---------------------------- ----------------------------

40
FAQ
View file

@ -3,6 +3,21 @@
| FAQ for imapsync | | FAQ for imapsync |
+------------------+ +------------------+
=======================================================================
Q. How to install impasync ?
R. http://www.linux-france.org/prj/imapsync/INSTALL
=======================================================================
Q. How to configure impasync ?
R. http://www.linux-france.org/prj/imapsync/README
=======================================================================
Q. Can you give some configuration examples ?
R. http://www.linux-france.org/prj/imapsync/FAQ
======================================================================= =======================================================================
Q. Where I can read IMAP RFCs ? Q. Where I can read IMAP RFCs ?
@ -26,6 +41,20 @@ Q. Where I can find old imapsync releases ?
R. ftp://www.linux-france.org/pub/prj/imapsync/ R. ftp://www.linux-france.org/pub/prj/imapsync/
=======================================================================
Q. imapsync does not work with Mail::IMAPClient 3.0.x
How can I downgrade to 2.2.9 release?
R. - Download Mail::IMAPClient 2.2.9 at
http://search.cpan.org/~djkernen/Mail-IMAPClient-2.2.9/
http://search.cpan.org/CPAN/authors/id/D/DJ/DJKERNEN/Mail-IMAPClient-2.2.9.tar.gz
- untar it anywhere:
tar xzvf Mail-IMAPClient-2.2.9.tar.gz
- run imapsync with perl and -I option tailing to use Mail-IMAPClient-2.2.9:
perl -I./Mail-IMAPClient-2.2.9 imapsync [...]
or if imapsync is in directory /path/
perl -I./Mail-IMAPClient-2.2.9 /path/imapsync [...]
======================================================================= =======================================================================
Q. We have found that the sent time and date have been changed to the Q. We have found that the sent time and date have been changed to the
time at which the file was synchronised. time at which the file was synchronised.
@ -122,6 +151,17 @@ The default hard datasize limit on FreeBSD is 512MB. To raise it, put this
kern.maxdsiz="1024M" kern.maxdsiz="1024M"
=======================================================================
Q. With huge account (many messages) when it comes to reading the
destination server it comes out this error:
"To Folder [INBOX.foobar] Not connected"
What can I do ?
R. May be spending too much time on the source server, the connection
timed out on the destination server.
Try options :
--nofoldersizes --useheader Message-ID --fast
======================================================================= =======================================================================
Q. imapsync failed with a "word too long" error from the imap server, Q. imapsync failed with a "word too long" error from the imap server,
What can I do ? What can I do ?

10
INSTALL
View file

@ -1,4 +1,4 @@
# $Id: INSTALL,v 1.12 2007/10/30 00:49:03 gilles Exp gilles $ # $Id: INSTALL,v 1.13 2008/03/19 00:28:36 gilles Exp gilles $
# #
# INSTALL file for imapsync # INSTALL file for imapsync
# imapsync : IMAP sync or copy tool. # imapsync : IMAP sync or copy tool.
@ -42,12 +42,14 @@ Here is some individual module help:
perl -mMail::IMAPClient -e 'print $Mail::IMAPClient::VERSION, "\n"' perl -mMail::IMAPClient -e 'print $Mail::IMAPClient::VERSION, "\n"'
New Mail-IMAPClient-3.xx doesn't work with imapsync for the moment.
- Perl Digest::MD5 module. - Perl Digest::MD5 module.
http://search.cpan.org/ http://search.cpan.org/
http://search.cpan.org/~gaas/Digest-MD5-2.33/ http://search.cpan.org/~gaas/Digest-MD5-2.36/
To know the version you have on your system try : To know the version you have on your system try :
perl -mDigest::MD5 -e 'print $Digest::MD5::VERSION, "\n"' perl -mDigest::MD5 -e 'print $Digest::MD5::VERSION, "\n"'
I use 2.20 (debian package) I use 2.36 (debian etch package)
- Term::ReadKey - Term::ReadKey
perl -mTerm::ReadKey -e '' perl -mTerm::ReadKey -e ''
@ -94,7 +96,7 @@ titi@est.belle with a password located in the file /var/tmp/secret2
Of course, you can change the file tests.sh and run the tests with : Of course, you can change the file tests.sh and run the tests with :
sh tests.sh sh -x tests.sh
The tests.sh script break on first failure ("set -e" directive). The tests.sh script break on first failure ("set -e" directive).

282
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/BodyStructure/Parse.grammar
View file

@ -1,282 +0,0 @@
# Directives
# ( none)
# Start-up Actions
{
my $subpartCount = 0;
my $partCount = 0;
}
#
# Atoms
TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" }
PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" }
HTML: /"HTML"|HTML/i { $return = "HTML" }
MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE" }
RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" }
NIL: /^NIL/i { $return = "NIL" }
NUMBER: /^(\d+)/ { $return = $item[1]; $return||defined($return);}
# Strings:
SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
QUOTED_STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING {
$return = $item{DOUBLE_QUOTED_STRING}||$item{SINGLE_QUOTED_STRING} ;
$return||defined($return);
}
BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/ {
$return = $item{__PATTERN1__} ; $return||defined($return);
}
STRING: QUOTED_STRING | BARESTRING {
$return = $item{QUOTED_STRING}||$item{BARESTRING} ;
$return||defined($return);
}
OLDSTRING: /^"((?:[^"\\]|\\.)*)"/ | /^([^ \(\)]+)/
{ $item{__PATTERN1__} =~ s/^"(.*)"$/$1/;
$return = $item{__PATTERN1__} || $item{__PATTERN2__} ;
$return||defined($return);
}
#BARESTRING: /^[^(]+\s+(?=\()/
# { $return = $item[1] ; $return||defined($return);}
textlines: NIL | NUMBER { $return = $item[1] || $item[2]; $return||defined($return); }
rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" }
key: STRING { $return = $item{STRING} ; $return||defined($return);}
value: NIL | '(' <commit> kvpair(s) ')'| NUMBER | STRING
{ $return = $item{NIL} ||
$item{NUMBER} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} } ;
$return||defined($return);
}
kvpair: ...!")" key value
{ $return = { $item{key} => $item{value} }; $return||defined($return);}
bodytype: STRING
{ $return = $item{STRING} ; $return||defined($return);}
bodysubtype: PLAIN | HTML | NIL | STRING
{ $return = $item{PLAIN}||$item{HTML}||$item{NIL}||$item{STRING} ;
$return||defined($return);
}
bodyparms: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodydisp: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodyid: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodydesc: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
bodyenc: NIL | STRING | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return||defined($return);
}
bodysize: ...!/[()]/ NIL | NUMBER
{ $return = $item{NIL} || $item{NUMBER}; $return||defined($return);}
bodyMD5: NIL | STRING
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
bodylang: NIL | STRING | "(" STRING(s) ")"
{ $return = $item{NIL} || $item{'STRING(s)'}; $return||defined($return);}
bodyextra: NIL | STRING | "(" STRING(s) ")"
{ 0 }
personalname: NIL | STRING
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
sourceroute: NIL | STRING
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
mailboxname: NIL | STRING
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
hostname: NIL | STRING
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
{ bless {
personalname => $item{personalname} ,
sourceroute => $item{sourceroute} ,
mailboxname => $item{mailboxname} ,
hostname => $item{hostname} ,
}, 'Mail::IMAPClient::BodyStructure::Address';
}
subject: NIL | STRING
{
$return = $item{NIL} || $item{STRING} ;
$return||defined($return);
}
inreplyto: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
messageid: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
date: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
cc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
bcc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
from: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
replyto: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
sender: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
to: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
envelopestruct: "(" date subject from sender replyto to cc bcc inreplyto messageid ")"
{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope";
$return->{$_} = $item{$_}
for qw/date subject from sender replyto to cc/
, qw/bcc inreplyto messageid/ ;
$return;
}
basicfields: bodysubtype bodyparms bodyid(?)
bodydesc(?) bodyenc(?)
bodysize(?) {
$return =
{ bodysubtype => $item{bodysubtype}
, bodyparms => $item{bodyparms}
};
$return->{$_} = ref $item{"$_(?}"} ? $item{"$_(?}"}[0] :$item{"$_(?}"}
for qw/bodyid bodydesc bodyenc bodysize/;
$return;
}
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?)
bodydisp(?) bodylang(?) bodyextra(?)
{
$return = $item{basicfields} || {};
$return->{bodytype} = 'TEXT';
foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/)
{ my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = $item{$what}[0] if ref $item{$what};
}
$return;
}
othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?)
bodylang(?) bodyextra(?)
{ $return = {};
foreach my $what ( qw/bodytype bodyparms(?) bodydisp(?)/
, qw/bodylang(?) bodyextra(?)/ )
{ my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ;
}
while( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return;
}
messagerfc822message:
rfc822message <commit> bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?)
{
$return = {};
foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?)
/
) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref $item{$what} =~ 'ARRAY'?
$item{$what}[0] : $item{$what};
}
while(my($k,$v) = each %{$item{bodystructure}[0]}) { $return->{$k} = $v}
while(my($k,$v) = each %{$item{basicfields}}) { $return->{$k} = $v}
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype} = "RFC822" ;
$return;
}
subpart: "(" part ")"
{ $return = $item{part} ;
$return||defined($return);
} <defer: ++$subpartCount;>
part: subpart(s) <commit> basicfields
bodyparms(?) bodydisp(?) bodylang(?) bodyextra(?)
<defer: $subpartCount = 0>
{ $return = bless $item{basicfields},"Mail::IMAPClient::BodyStructure";
$return->{bodytype} = "MULTIPART";
$return->{bodystructure} = $item{'subpart(s)'};
foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?) bodyextra(?)/)
{ my $k = $b; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b};
}
$return;
}
| textmessage
{ $return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| messagerfc822message
{ $return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| othertypemessage
{ $return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
bodystructure: "(" part(s) ")"
{ $return = $item{'part(s)'} ;
$return||defined($return);
}
start: /.*\(.*BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
{
#print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']);
$return = $item{'part(1)'}[0];
$return || defined $return;
}
envelope: /.*\(.*ENVELOPE/ envelopestruct /.*\)/
{ $return = $item{envelopestruct};
$return || defined $return;
}

0
Mail-IMAPClient-3.00/COPYRIGHT → Mail-IMAPClient-3.05/COPYRIGHT
View file

101
Mail-IMAPClient-3.00/Changes → Mail-IMAPClient-3.05/Changes
View file

@ -3,6 +3,107 @@
All changes from 2.99_01 upward are made by Mark Overmeer. The changes All changes from 2.99_01 upward are made by Mark Overmeer. The changes
before that are applied by David Kernen before that are applied by David Kernen
version 3.05: Wed Feb 20 08:59:37 CET 2008
Fixes:
- match ENVELOPE and BODYSTRUCTURE more strict in the
grammar, to avoid confusion. [Zach Levow]
- get_envelope and get_bodystructure failed for servers which
did not return the whole answer in one piece. [Zach Levow]
- do not produce parser errors when get_envelope does not
return an envelope. [Zach Levow]
- PLAIN login response possibly solely a '+' [Zach] and [Nick]
version 3.04: Fri Jan 25 09:25:51 CET 2008
Fixes:
- read_header fix for UID on Windows Server 2003.
rt.cpan.org#32398 [Michiel Stelman]
Improvements:
- doc update on authentication, by [Thomas Jarosch]
version 3.03: Wed Jan 9 22:11:36 CET 2008
Fixes:
- LIST (f.i. used by folders()) did not return anything when the
passed argument had a trailing separator. [Gunther Heintze]
- Rfc2060_datetime() must include a zone.
rt.cpan.org#31971 [David Golden]
- folders() uses LIST, and then calls a STATUS on each of the
names found. This is superfluous, and will cause problems when
the STATUS fails... for instance because of ACL limitations
on the sub-folder.
rt.cpan.org#31962 [Thomas Jarosch]
- fixed a zillion of problems in the BodyStructure parser. The
original author did not understand parsing, nor Perl.
- part numbering wrong when nested messages contained multiparts
Improvements:
- implementation of DIGEST-MD5 authentication [Thomas Jarosch]
- removed call for status() in Massage(), which hopefully speeds-up
things without destroying anything. It removed a possible deep
recursion, which no-one reported (so should be ok to remove it)
- simplified folders() algorithm.
- merged folder commands, like subscribe into one.
- added unsubscribe()
rt.cpan.org#31268 [G Miller]
- lazy-load Digest::HMAC_MD5
version 3.02: Wed Dec 5 21:33:17 CET 2007
Fixes:
- Another attempt to get get FETCH UID right. Patch by [David Golden]
version 3.01: Wed Dec 5 09:55:43 CET 2007
Changes:
- removed version number from ::BodyStructure
Fixes:
- quote password at login.
rt.cpan.org#31035 [Andy Harriston]
- empty return of flags command should be empty list, not undef.
rt.cpan.org#31195 [David Golden]
- UID command does not work with folder management commands
rt.cpan.org#31182 [Robbert Norris]
- _read_line simplifications avoids timeouts.
rt.cpan.org#31221 [Robbert Norris]
- FETCH did not detect the UID of a message anymore.
[David Golden]
Improvements:
- proxyauth for SUN/iPlanet/NetScape IMAP servers.
patch by rt.cpan.org#31152 [Robbert Norris]
- use grep in stead of map in one occasion in MessageSet.pm
[Yves Orton]
version 3.00: Wed Nov 28 09:56:54 CET 2007 version 3.00: Wed Nov 28 09:56:54 CET 2007
Fixes: Fixes:

0
Mail-IMAPClient-3.00/INSTALL → Mail-IMAPClient-3.05/INSTALL
View file

0
Mail-IMAPClient-3.00/MANIFEST → Mail-IMAPClient-3.05/MANIFEST
View file

9
Mail-IMAPClient-3.00/META.yml → Mail-IMAPClient-3.05/META.yml
View file

@ -1,9 +1,10 @@
--- #YAML:1.0 --- #YAML:1.0
name: Mail-IMAPClient name: Mail-IMAPClient
version: 3.00 version: 3.05
abstract: IMAP4 client library abstract: IMAP4 client library
license: ~ license: ~
generated_by: ExtUtils::MakeMaker version 6.36_01 author: ~
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module distribution_type: module
requires: requires:
Carp: 0 Carp: 0
@ -21,5 +22,5 @@ requires:
Test::More: 0 Test::More: 0
Test::Pod: 0 Test::Pod: 0
meta-spec: meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.2 version: 1.3

14
Mail-IMAPClient-3.00/Makefile.PL → Mail-IMAPClient-3.05/Makefile.PL
View file

@ -2,6 +2,8 @@ use ExtUtils::MakeMaker;
use warnings; use warnings;
use strict; use strict;
sub set_test_data();
WriteMakefile WriteMakefile
( NAME => 'Mail::IMAPClient', ( NAME => 'Mail::IMAPClient',
, ABSTRACT => 'IMAP4 client library' , ABSTRACT => 'IMAP4 client library'
@ -28,8 +30,14 @@ WriteMakefile
set_test_data(); set_test_data();
sub set_test_data { exit 0;
unless(-f "lib/Mail/IMAPClient.pm")
###
### HELPERS
###
sub set_test_data()
{ unless(-f "lib/Mail/IMAPClient.pm")
{ warn "ERROR: not in installation directory\n"; { warn "ERROR: not in installation directory\n";
return; return;
} }
@ -46,7 +54,7 @@ __INTRO
my $yes = prompt "Do you want to run the extended tests? (n/y)"; my $yes = prompt "Do you want to run the extended tests? (n/y)";
return if $yes !~ /^[Yy](?:[Ee]:[Ss]?)?$/ ; return if $yes !~ /^[Yy](?:[Ee]:[Ss]?)?$/ ;
unless(open TST,">./test.txt") unless(open TST, '>', "./test.txt")
{ warn "ERROR: couldn't open ./test.txt: $!\n"; { warn "ERROR: couldn't open ./test.txt: $!\n";
return; return;
} }

0
Mail-IMAPClient-3.00/README → Mail-IMAPClient-3.05/README
View file

0
Mail-IMAPClient-3.00/Todo → Mail-IMAPClient-3.05/Todo
View file

0
Mail-IMAPClient-3.00/examples/build_dist.pl → Mail-IMAPClient-3.05/examples/build_dist.pl
View file

0
Mail-IMAPClient-3.00/examples/build_ldif.pl → Mail-IMAPClient-3.05/examples/build_ldif.pl
View file

0
Mail-IMAPClient-3.00/examples/cleanTest.pl → Mail-IMAPClient-3.05/examples/cleanTest.pl
View file

0
Mail-IMAPClient-3.00/examples/copy_folder.pl → Mail-IMAPClient-3.05/examples/copy_folder.pl
View file

0
Mail-IMAPClient-3.00/examples/cyrus_expire.pl → Mail-IMAPClient-3.05/examples/cyrus_expire.pl
View file

0
Mail-IMAPClient-3.00/examples/cyrus_expunge.pl → Mail-IMAPClient-3.05/examples/cyrus_expunge.pl
View file

0
Mail-IMAPClient-3.00/examples/find_dup_msgs.pl → Mail-IMAPClient-3.05/examples/find_dup_msgs.pl
View file

0
Mail-IMAPClient-3.00/examples/imap_to_mbox.pl → Mail-IMAPClient-3.05/examples/imap_to_mbox.pl
View file

0
Mail-IMAPClient-3.00/examples/imtestExample.pl → Mail-IMAPClient-3.05/examples/imtestExample.pl
View file

0
Mail-IMAPClient-3.00/examples/migrate_mail2.pl → Mail-IMAPClient-3.05/examples/migrate_mail2.pl
View file

0
Mail-IMAPClient-3.00/examples/migrate_mbox.pl → Mail-IMAPClient-3.05/examples/migrate_mbox.pl
View file

0
Mail-IMAPClient-3.00/examples/populate_mailbox.pl → Mail-IMAPClient-3.05/examples/populate_mailbox.pl
View file

0
Mail-IMAPClient-3.00/examples/sharedFolder.pl → Mail-IMAPClient-3.05/examples/sharedFolder.pl
View file

483
Mail-IMAPClient-3.00/lib/Mail/IMAPClient.pm → Mail-IMAPClient-3.05/lib/Mail/IMAPClient.pm
View file

@ -2,7 +2,7 @@ use warnings;
use strict; use strict;
package Mail::IMAPClient; package Mail::IMAPClient;
our $VERSION = '3.00'; our $VERSION = '3.05';
use Mail::IMAPClient::MessageSet; use Mail::IMAPClient::MessageSet;
@ -18,7 +18,6 @@ use Carp qw(carp);
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Errno qw/EAGAIN/; use Errno qw/EAGAIN/;
use List::Util qw/first min max sum/; use List::Util qw/first min max sum/;
use Digest::HMAC_MD5 qw/hmac_md5_hex/;
use MIME::Base64; use MIME::Base64;
use constant Unconnected => 0; use constant Unconnected => 0;
@ -57,7 +56,7 @@ BEGIN {
# set-up accessors # set-up accessors
foreach my $datum ( foreach my $datum (
qw(State Port Server Folder Peek User Password Timeout Buffer qw(State Port Server Folder Peek User Password Timeout Buffer
Debug Count Uid Debug_fh Maxtemperrors Authmechanism Authcallback Debug Count Uid Debug_fh Maxtemperrors Authuser Authmechanism Authcallback
Ranges Readmethod Showcredentials Prewritemethod Ignoresizeerrors Ranges Readmethod Showcredentials Prewritemethod Ignoresizeerrors
Supportedflags Proxy)) Supportedflags Proxy))
{ no strict 'refs'; { no strict 'refs';
@ -136,12 +135,13 @@ sub Rfc2060_date
sprintf "%02d-%s-%04d", $date[3], $mnt[$date[4]], $date[5]+1900; sprintf "%02d-%s-%04d", $date[3], $mnt[$date[4]], $date[5]+1900;
} }
sub Rfc2060_datetime sub Rfc2060_datetime($;$)
{ my ($class, $stamp) = @_; # 11-Jan-2000 04:04:04 { my ($class, $stamp, $zone) = @_; # 11-Jan-2000 04:04:04 +0000
$zone ||= '+0000';
my @date = gmtime $stamp; my @date = gmtime $stamp;
sprintf "%02d-%s-%04d %02d:%02d:%02d", $date[3], $mnt[$date[4]] sprintf "%02d-%s-%04d %02d:%02d:%02d %s", $date[3], $mnt[$date[4]]
, $date[5]+1900, $date[2], $date[1], $date[0]; , $date[5]+1900, $date[2], $date[1], $date[0], $zone;
} }
# Change CRLF into \n # Change CRLF into \n
@ -177,9 +177,12 @@ sub Clear
$oldclear; $oldclear;
} }
# read-only access to the transaction number: # read-only access to the transaction number
sub Transaction { shift->Count }; sub Transaction { shift->Count };
# remove doubles from list
sub _remove_doubles(@) { my %seen; grep { ! $seen{$_}++ } @_ }
# the constructor: # the constructor:
sub new sub new
{ my $class = shift; { my $class = shift;
@ -311,6 +314,11 @@ sub login
if $auth ne 'LOGIN'; if $auth ne 'LOGIN';
my $passwd = $self->Password; my $passwd = $self->Password;
if($passwd =~ m/\W/) # need to quote
{ $passwd =~ s/(["\\])/\\$1/g;
$passwd = qq{"$passwd"};
}
my $id = $self->User; my $id = $self->User;
$id = qq{"$id"} if $id !~ /^".*"$/; $id = qq{"$id"} if $id !~ /^".*"$/;
@ -321,6 +329,11 @@ sub login
$self; $self;
} }
sub proxyauth
{ my ($self, $user) = @_;
$self->_imap_command("PROXYAUTH $user") ? $self->Results : undef;
}
sub separator sub separator
{ my ($self, $target) = @_; { my ($self, $target) = @_;
unless(defined $target) unless(defined $target)
@ -362,8 +375,8 @@ sub sort
sub list sub list
{ my ($self, $reference, $target) = @_; { my ($self, $reference, $target) = @_;
defined $reference or $reference = ""; defined $reference or $reference = "";
defined $target or $target = '*'; defined $target or $target = '*';
length $target or $target = '""'; length $target or $target = '""';
$target eq '*' || $target eq '""' $target eq '*' || $target eq '""'
or $target = $self->Massage($target); or $target = $self->Massage($target);
@ -414,10 +427,7 @@ sub subscribed
/ix; /ix;
} }
# for my $f (@folders) { $f =~ s/^\\FOLDER LITERAL:://;} my @clean = _remove_doubles @folders;
# remove doubles
my @clean; my %memory;
foreach (@folders) { push @clean, $_ unless $memory{$_}++ }
wantarray ? @clean : \@clean; wantarray ? @clean : \@clean;
} }
@ -597,8 +607,9 @@ sub message_to_file
my $string = "$trans ${uid}FETCH $msgs $cmd"; my $string = "$trans ${uid}FETCH $msgs $cmd";
$self->_record($trans, [0, "INPUT", $string] ); $self->_record($trans, [0, "INPUT", $string] );
print "string [$string]\n";
my $feedback = $self->_send_line($string); my $feedback = $self->_send_line($string);
print "feedback [$feedback]\n";
unless($feedback) unless($feedback)
{ $self->LastError("Error sending '$string' to IMAP: $!"); { $self->LastError("Error sending '$string' to IMAP: $!");
return undef; return undef;
@ -610,9 +621,11 @@ sub message_to_file
until($code) until($code)
{ my $output = $self->_read_line($handle) { my $output = $self->_read_line($handle)
or return undef; or return undef;
foreach my $o (@$output) foreach my $o (@$output)
{ $self->_record($trans,$o); {
print "oD[", $o->[DATA], "]\n";
print "oT[", $o->[TYPE], "]\n";
$self->_record($trans,$o);
next unless $self->_is_output($o); next unless $self->_is_output($o);
$code = $o->[DATA] =~ /^$trans\s+(OK|BAD|NO)/mi ? $1 : undef; $code = $o->[DATA] =~ /^$trans\s+(OK|BAD|NO)/mi ? $1 : undef;
@ -1099,8 +1112,7 @@ sub _imap_command
} }
sub _imap_uid_command sub _imap_uid_command
{ my $self = shift; { my ($self, $cmd) = (shift, shift);
my $cmd = shift;
my $args = @_ ? join(" ", '', @_) : ''; my $args = @_ ? join(" ", '', @_) : '';
my $uid = $self->Uid ? 'UID ' : ''; my $uid = $self->Uid ? 'UID ' : '';
$self->_imap_command("$uid$cmd$args"); $self->_imap_command("$uid$cmd$args");
@ -1256,7 +1268,7 @@ sub _send_line
# It is also re-implemented in: message_to_file # It is also re-implemented in: message_to_file
# #
# syntax: $output = $self->_readline($literal_callback, $output_callback) # $output = $self->_read_line($literal_callback, $output_callback)
# Both input argument are optional, but if supplied must either # Both input argument are optional, but if supplied must either
# be a filehandle, coderef, or undef. # be a filehandle, coderef, or undef.
# #
@ -1284,8 +1296,8 @@ sub _read_line
my $fast_io = $self->Fast_io; my $fast_io = $self->Fast_io;
until(@$oBuffer # there's stuff in output buffer: until(@$oBuffer # there's stuff in output buffer:
&& $oBuffer->[-1][DATA] =~ /\r\n$/ # the last thing there has cr-lf: && $oBuffer->[-1][TYPE] eq 'OUTPUT' # that thing is an output line:
&& $oBuffer->[-1][TYPE] eq "OUTPUT" # that thing is an output line: && $oBuffer->[-1][DATA] =~ /\r?\n$/ # the last thing there has cr-lf:
&& !length $iBuffer # and the input buffer has been MT'ed: && !length $iBuffer # and the input buffer has been MT'ed:
) )
{ my $transno = $self->Transaction; { my $transno = $self->Transaction;
@ -1328,19 +1340,17 @@ sub _read_line
while($iBuffer =~ s/^(.*?\r?\n)//) # consume line while($iBuffer =~ s/^(.*?\r?\n)//) # consume line
{ my $current_line = $1; { my $current_line = $1;
if($current_line !~ s/\s*\{(\d+)\}\r?\n$//)
# This part handles IMAP "Literals", { push @$oBuffer, [$index++, 'OUTPUT' , $current_line];
# 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
if($current_line !~ s/\s*\{(\d+)\}\r\n$//)
{ push @$oBuffer, [$index++, "OUTPUT" , $current_line];
next; next;
} }
push @$oBuffer, [$index++, 'OUTPUT', $current_line];
## handle LITERAL ## handle LITERAL
# BLAH BLAH {nnn}\r\n
# [nnn bytes of literally transmitted stuff]
# [part of line that follows literal data]\r\n
my $expected_size = $1; my $expected_size = $1;
@ -1349,54 +1359,57 @@ sub _read_line
"retrieve from the " . length($iBuffer) . "retrieve from the " . length($iBuffer) .
" bytes in: $iBuffer<END_OF_iBuffer>"); " bytes in: $iBuffer<END_OF_iBuffer>");
my $litstring = $iBuffer; my $litstring;
if(length $iBuffer >= $expected_size)
{ # already received all data
$litstring = substr $iBuffer, 0, $expected_size, '';
}
else
{ # literal data still to arrive
$litstring = $iBuffer;
$iBuffer = '';
while($expected_size > length $litstring) while($expected_size > length $litstring)
{ if($timeout) { if($timeout)
{ # wait for data from the the IMAP socket. { # wait for data from the the IMAP socket.
my $rvec = 0; my $rvec = 0;
vec($rvec, fileno($self->Socket), 1) = 1; vec($rvec, fileno($self->Socket), 1) = 1;
unless(CORE::select($rvec, undef, $rvec, $timeout)) unless(CORE::select($rvec, undef, $rvec, $timeout))
{ $self->LastError("Tag $transno: Timeout waiting for " { $self->LastError("Tag $transno: Timeout waiting for "
. "literal data from server"); . "literal data from server");
return undef; return undef;
} }
} }
else # 1 ms before retry else # 1 ms before retry
{ CORE::select(undef, undef, undef, 0.001); { CORE::select(undef, undef, undef, 0.001);
} }
fcntl($socket, F_SETFL, $self->{_fcntl}) fcntl($socket, F_SETFL, $self->{_fcntl}) #???why
if $fast_io && defined $self->{_fcntl}; if $fast_io && defined $self->{_fcntl};
my $ret = $self->_sysread($socket, \$litstring my $ret = $self->_sysread($socket, \$litstring
, $expected_size - length $litstring, length $litstring); , $expected_size - length $litstring, length $litstring);
$self->_debug("Received ret=$ret and buffer = " . $self->_debug("Received ret=$ret and buffer = " .
"\n$litstring<END>\nwhile processing LITERAL"); "\n$litstring<END>\nwhile processing LITERAL");
if($timeout && !defined $ret) if($timeout && !defined $ret)
{ $self->_record($transno, { $self->_record($transno,
[ $self->_next_index($transno), "ERROR", [ $self->_next_index($transno), "ERROR",
"$transno * NO Error reading data from server: $!"]); "$transno * NO Error reading data from server: $!"]);
return undef; return undef;
} }
if($ret == 0 && $socket->eof) if($ret==0 && $socket->eof)
{ $self->_record($transno, { $self->_record($transno,
[ $self->_next_index($transno), "ERROR", [ $self->_next_index($transno), "ERROR",
"$transno * BYE Server unexpectedly closed connection: $!"]); "$transno * BYE Server unexpectedly closed connection: $!"]);
$self->State(Unconnected); $self->State(Unconnected);
return undef; return undef;
}
} }
} }
if(length $litstring > $expected_size)
{ # copy the extra struff into the iBuffer:
$iBuffer = substr $litstring, $expected_size, length($litstring)-$expected_size,'';
}
else { $iBuffer = '' };
if(!$literal_callback) { ; } if(!$literal_callback) { ; }
elsif(UNIVERSAL::isa($literal_callback, 'GLOB')) elsif(UNIVERSAL::isa($literal_callback, 'GLOB'))
{ print $literal_callback $litstring; { print $literal_callback $litstring;
@ -1411,31 +1424,8 @@ sub _read_line
. "invalid callback; must be a filehandle or CODE"); . "invalid callback; must be a filehandle or CODE");
} }
$self->Fast_io($fast_io) if $fast_io; $self->Fast_io($fast_io) if $fast_io; # ???
push @$oBuffer, [$index++, 'LITERAL', $litstring];
# Now let's make sure there are no IMAP server output lines
# (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string
my $trailer;
if($iBuffer =~ s/\r?\n((?:\*|\d+)\s(?:BAD|NO|OK)[^\n]*\r?\n\z)//i)
{ $trailer = $1;
$self->_debug("Got output in literal: $trailer");
}
$self->_debug("literal includes ')' of FETCH")
if length $iBuffer
&& $current_line =~ m/\bFETCH\b/i
&& $iBuffer =~ s/\)$//;
if(length $iBuffer)
{ $self->_debug("literal: too much >>$iBuffer<<");
$litstring .= $iBuffer;
$iBuffer = '';
}
push @$oBuffer, [$index++, "OUTPUT", $current_line];
push @$oBuffer, [$index++, "LITERAL", $litstring];
push @$oBuffer, [$index++, "OUTPUT", $trailer]
if $trailer;
} }
} }
@ -1518,47 +1508,46 @@ sub logout
$self; $self;
} }
sub folders sub folders($)
{ my ($self, $what) = @_; { my ($self, $what) = @_;
return wantarray ? @{$self->{Folders}} : $self->{Folders} return wantarray ? @{$self->{Folders}} : $self->{Folders}
if ref $self->{Folders} && !$what; if !$what && $self->{Folders};
my @list;
if($what)
{ my $sep = $self->separator($what);
my $whatsub = $what =~ m/\Q${sep}\E$/ ? "$what*" : "$what$sep*";
push @list, $self->list(undef, $whatsub);
push @list, $self->list(undef, $what) if $self->exists($what);
}
else
{ push @list, $self->list(undef, undef);
}
my @folders; my @folders;
my @list = $self->list(undef,($what ? $what.$self->separator($what)."*" : undef ) ); for(my $m = 0; $m < @list; $m++ )
push @list, $self->list(undef, $what)
if $what && $self->exists($what);
for(my $m = 0; $m < scalar(@list); $m++ )
{ if($list[$m] && $list[$m] !~ /\r\n$/ ) { if($list[$m] && $list[$m] !~ /\r\n$/ )
{ $self->_debug("folders: concatenating $list[$m] and $list[$m+1]"); { $self->_debug("folders: concatenating $list[$m] and $list[$m+1]");
$list[$m] .= $list[$m+1]; $list[$m] .= $list[$m+1];
$list[$m+1] = ""; splice @list, $m+1, 1;
$list[$m] .= "\r\n" unless $list[$m] =~ /\r\n$/;
} }
$list[$m] =~ / ^\*\s+LIST # * LIST $list[$m] =~ / ^\* \s+ LIST \s+ \([^\)]*\) \s+ # * LIST (Flags)
\s+\([^\)]*\)\s+ # (Flags) (?:\" [^"]* \" | NIL ) \s+ # "delimiter" or NIL
(?:"[^"]*"|NIL)\s+ # "delimiter" or NIL (?:\"([^"]*)\" | (\S+)) \s*$ # "name" or name
(?:"([^"]*)"|(.*))\r\n$ # Name or "Folder name"
/ix /ix
or next; or next;
my $folder = $1 || $2; push @folders, $1 || $2;
$folder = qq("$folder")
if $1 && !$self->exists($folder);
push @folders, $folder
} }
my (@clean, %memory); my @clean = _remove_doubles @folders;
foreach my $f (@folders) { push @clean, $f unless $memory{$f}++ }
$self->{Folders} = \@clean unless $what; $self->{Folders} = \@clean unless $what;
wantarray ? @clean : \@clean; wantarray ? @clean : \@clean;
} }
sub exists sub exists
{ my ($self, $folder) = @_; { my ($self, $folder) = @_;
$self->status($folder) ? $self : undef; $self->status($folder) ? $self : undef;
@ -1580,11 +1569,12 @@ sub get_bodystructure
} }
else else
{ $self->_debug("get_bodystructure: reassembling original response"); { $self->_debug("get_bodystructure: reassembling original response");
my $start = 0; my $started = 0;
foreach my $o ($self->Results) my $output = '';
foreach my $o ($self->_transaction)
{ next unless $self->_is_output_or_literal($o); { next unless $self->_is_output_or_literal($o);
next unless $start or $started++ if $o->[DATA] =~ /BODYSTRUCTURE \(/i; ; # Hi, vi! ;-)
$o->[DATA] =~ /BODYSTRUCTURE \(/i and ++$start; # Hi, vi! ;-) $started or next;
if(length $output && $self->_is_literal($o) ) if(length $output && $self->_is_literal($o) )
{ my $data = $o->[DATA]; { my $data = $o->[DATA];
@ -1612,24 +1602,30 @@ sub get_envelope
return undef; return undef;
} }
my @out = $self->fetch($msg,"ENVELOPE"); my @out = $self->fetch($msg, 'ENVELOPE');
my $bs = ""; my $bs = "";
my $output = first { /ENVELOPE \(/i } @out; # Wee! ;-) my $output = first { /ENVELOPE \(/i } @out; # vi ;-)
unless($output)
{ $self->LastError("Unable to use get_envelope: $@");
return undef;
}
if($output =~ /\r\n$/ ) if($output =~ /\r\n$/ )
{ eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) }; { eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) };
} }
else else
{ $self->_debug("get_envelope: reassembling original response"); { $self->_debug("get_envelope: reassembling original response");
my $start = 0; my $started = 0;
foreach my $o ($self->Results) $output = '';
foreach my $o ($self->_transaction)
{ next unless $self->_is_output_or_literal($o); { next unless $self->_is_output_or_literal($o);
$self->_debug("o->[DATA] is $o->[DATA]"); $self->_debug("o->[DATA] is $o->[DATA]");
next unless $start or $started++ if $o->[DATA] =~ /ENVELOPE \(/i; # Hi, vi! ;-)
$o->[DATA] =~ /ENVELOPE \(/i and ++$start; $started or next;
# Hi, vi! ;-)
if ( length($output) and $self->_is_literal($o) ) { if(length($output) && $self->_is_literal($o) ) {
my $data = $o->[DATA]; my $data = $o->[DATA];
$data =~ s/"/\\"/g; $data =~ s/"/\\"/g;
$data =~ s/\(/\\\(/g; $data =~ s/\(/\\\(/g;
@ -1658,7 +1654,7 @@ sub fetch
: $what; : $what;
$self->_imap_uid_command(FETCH => $take, @_) $self->_imap_uid_command(FETCH => $take, @_)
or return (); or return;
wantarray ? $self->History : $self->Results; wantarray ? $self->History : $self->Results;
} }
@ -1735,46 +1731,29 @@ sub store
wantarray ? $self->History : $self->Results; wantarray ? $self->History : $self->Results;
} }
sub subscribe sub _imap_folder_command($$)
{ my ($self, @a) = @_; { my ($self, $command) = (shift, shift);
delete $self->{Folders}; delete $self->{Folders};
$a[-1] = $self->Massage($a[-1]) if @a; my $folder = $self->Massage(shift);
$self->_imap_uid_command(SUBSCRIBE => @a)
or return undef;
wantarray ? $self->History : $self->Results;
}
sub delete $self->_imap_command("$command $folder")
{ my ($self, @a) = @_; or return;
delete $self->{Folders};
$a[-1] = $self->Massage($a[-1]) if @a;
$self->_imap_uid_command(DELETE => @a)
or return undef;
wantarray ? $self->History : $self->Results;
}
sub myrights
{ my ($self, @a) = @_;
delete $self->{Folders};
$a[-1] = $self->Massage($a[-1]) if @a;
$self->_imap_uid_command(MYRIGHTS => @a)
or return undef;
wantarray ? $self->History : $self->Results; wantarray ? $self->History : $self->Results;
} }
sub subscribe($) { $_[0]->_imap_folder_command(SUBSCRIBE => $_[1]) }
sub unsubscribe($) { $_[0]->_imap_folder_command(UNSUBSCRIBE => $_[1]) }
sub delete($) { $_[0]->_imap_folder_command(DELETE => $_[1]) }
sub create($) { $_[0]->_imap_folder_command(CREATE => $_[1]) }
sub create # rfc2086
{ my ($self, @a) = @_; sub myrights($) { $_[0]->_imap_folder_command(MYRIGHTS => $_[1]) }
delete $self->{Folders};
$a[0] = $self->Massage($a[0]) if @a;
$self->_imap_uid_command(CREATE => @a)
or return undef;
wantarray ? $self->History : $self->Results;
}
sub close sub close
{ my $self = shift; { my $self = shift;
delete $self->{Folders}; delete $self->{Folders};
$self->_imap_uid_command('CLOSE') $self->_imap_command('CLOSE')
or return undef; or return undef;
wantarray ? $self->History : $self->Results; wantarray ? $self->History : $self->Results;
} }
@ -1817,10 +1796,10 @@ sub rename
sub status sub status
{ my ($self, $folder) = (shift, shift); { my ($self, $folder) = (shift, shift);
my $which = @_ ? join(" ", @_) : 'MESSAGES';
defined $folder or return; defined $folder or return;
my $which = @_ ? join(" ", @_) : 'MESSAGES';
my $box = $self->Massage($folder); my $box = $self->Massage($folder);
$self->_imap_command("STATUS $box ($which)") $self->_imap_command("STATUS $box ($which)")
or return undef; or return undef;
@ -1839,21 +1818,21 @@ sub flags
# Send command # Send command
$self->fetch($msg, "FLAGS") $self->fetch($msg, "FLAGS")
or return undef; or return;
my $u_f = $self->Uid; my $u_f = $self->Uid;
my $flagset = {}; my $flagset = {};
# Parse results, setting entry in result hash for each line # Parse results, setting entry in result hash for each line
foreach my $resultline ($self->Results) foreach my $line ($self->Results)
{ $self->_debug("flags: line = '$resultline'"); { $self->_debug("flags: line = '$line'");
if ( $resultline =~ if ( $line =~
/\*\s+(\d+)\s+FETCH\s+ # * nnn FETCH /\* \s+ (\d+) \s+ FETCH \s+ # * nnn FETCH
\( # open-paren \(
(?:\s?UID\s(\d+)\s?)? # optional: UID nnn <space> (?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn <space>
FLAGS\s?\((.*)\)\s? # FLAGS (\Flag1 \Flag2) <space> FLAGS \s* \( (.*?) \) \s* # FLAGS (\Flag1 \Flag2) <space>
(?:\s?UID\s(\d+))? # optional: UID nnn (?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn
\) # close-paren \)
/x /x
) )
{ my $mailid = $u_f ? ($2||$4) : $1; { my $mailid = $u_f ? ($2||$4) : $1;
@ -1883,16 +1862,6 @@ sub supported_flags(@)
grep { $sup->{ /^\\(\S+)/ ? lc $1 : ()} } @_; grep { $sup->{ /^\\(\S+)/ ? lc $1 : ()} } @_;
} }
# parse_headers modified to allow second param to also be a
# reference to a list of numbers. If this is a case, the headers
# are read from all the specified messages, and a reference to
# an hash of mail numbers to references to hashes, are returned.
# I found, with a mailbox of 300 messages, this was
# *significantly* faster against our mailserver (< 1 second
# vs. 20 seconds)
#
# 2000-03-22 Adrian Smith (adrian.smith@ucpag.com)
sub parse_headers sub parse_headers
{ my ($self, $msgspec, @fields) = @_; { my ($self, $msgspec, @fields) = @_;
my $fields = join ' ', @fields; my $fields = join ' ', @fields;
@ -1905,25 +1874,36 @@ sub parse_headers
my @raw = $self->fetch($string) my @raw = $self->fetch($string)
or return undef; or return undef;
my %headers; # HASH from message ids to headers my %headers; # message ids to headers
my $h; # HASH of fields for current msgid my $h; # fields for current msgid
my $field; # previous field name my $field; # previous field name, for unfolding
my %fieldmap = map { ( lc($_) => $_ ) } @fields; my %fieldmap = map { ( lc($_) => $_ ) } @fields;
my $msgid;
foreach my $header (map {split /\r?\n/} @raw) foreach my $header (map {split /\r?\n/} @raw)
{ { # little problem: Windows2003 has UID as body, not in header
if($header =~ s/^(?:\*|UID) \s+ (\d+) \s+ FETCH \s+ if($header =~ s/^\* \s+ (\d+) \s+ FETCH \s+
\( .*? BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix) \( (.*?) BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix)
{ # start new message header { # start new message header
$h = $headers{$1} = {}; ($msgid, my $msgattrs) = ($1, $2);
$h = {};
if($self->Uid) # undef when win2003
{ $msgid = $msgattrs =~ m/\b UID \s+ (\d+)/x ? $1 : undef }
$headers{$msgid} = $h if $msgid;
} }
$header =~ /\S/ or next; $header =~ /\S/ or next; # skip empty lines.
# ( for vi # ( for vi
if($header =~ /^\)/) # end of this message if($header =~ /^\)/) # end of this message
{ undef $h; # inbetween headers { undef $h; # inbetween headers
next; next;
} }
elsif(!$msgid && $header =~ /^\s*UID\s+(\d+)\s*\)/)
{ $headers{$1} = $h; # finally found msgid, win2003
undef $h;
next;
}
unless(defined $h) unless(defined $h)
{ last if $header =~ / OK /i; { last if $header =~ / OK /i;
@ -2067,7 +2047,7 @@ sub search
foreach ($self->History) foreach ($self->History)
{ chomp; { chomp;
s/\r\n?/ /g; s/\r\n?/ /g;
s/^\*\s+SEARCH\s+(?=.*\d.*)// or next; s/^\*\s+SEARCH\s+(?=.*?\d)// or next;
push @hits, grep /^\d+$/, split; push @hits, grep /^\d+$/, split;
} }
@ -2209,7 +2189,7 @@ sub namespace {
return undef; return undef;
} }
my $got = $self->_imap_command("NAMESPACE") or return (); my $got = $self->_imap_command("NAMESPACE") or return;
my @namespaces = map { /^\* NAMESPACE (.*)/ ? $1 : () } my @namespaces = map { /^\* NAMESPACE (.*)/ ? $1 : () }
$got->Results; $got->Results;
@ -2254,43 +2234,47 @@ sub is_parent
for(my $m = 0; $m < @$list; $m++) for(my $m = 0; $m < @$list; $m++)
{ return undef { return undef
if $list->[$m] =~ /NoInferior/i; if $list->[$m] =~ /\bNoInferior\b/i;
if($list->[$m] =~ s/(\{\d+\})\r\n$// ) if($list->[$m] =~ s/(\{\d+\})\r\n$// )
{ $list->[$m] .= $list->[$m+1]; { $list->[$m] .= $list->[$m+1];
$list->[$m+1] = ""; splice @$list, $m+1, 1;
} }
$line = $list->[$m] $line = $list->[$m]
if $list->[$m] =~ if $list->[$m] =~
/ ^\*\s+LIST # * LIST /^ \* \s+ LIST \s+ # * LIST
\s+\([^\)]*\)\s+ # (Flags) \([^\)]*\) \s+ # (Flags)
"[^"]*"\s+ # "delimiter" \"[^"]*\" \s+ # "delimiter"
(?:"([^"]*)"|(.*))\r\n$ # Name or "Folder name" (?:\"[^"]*\"|\S+) \s*$ # Name or "Folder name"
/x; /x;
} }
unless(length $line) unless(length $line)
{ $self->_debug("Warning: separator method found no correct o/p in:\n\t". { $self->_debug("Warning: separator method found no correct o/p in:\n\t".
join "\n\t", @$list); join "\n\t", @$list);
} return 0;
my $f = defined $line && $line =~ /^\*\s+LIST\s+\(([^\)]*)\s*\)/ ? $1 : undef;
return 1 if $f =~ /HasChildren/i;
return 0 if $f =~ /HasNoChildren/i;
unless($f =~ /\\/) # no flags at all unless there's a backslash
{ my $sep = $self->separator($folder) || $self->separator(undef);
my $lead = $folder . $sep;
my $len = length $lead;
return scalar grep {$lead eq substr($_, 0, $len)} $self->folders;
} }
0; # ??? $line =~ /^\*\s+LIST\s+ \( ([^\)]*) \s*\)/x
or return 0;
my $flags = $1;
return 1 if $flags =~ /HasChildren/i;
return 0 if $flags =~ /HasNoChildren/i;
return 0 if $flags =~ /\\/; # other flags found
# flag not supported, try via folders()
my $sep = $self->separator($folder) || $self->separator(undef);
my $lead = $folder . $sep;
my $len = length $lead;
scalar grep {$lead eq substr($_, 0, $len)} $self->folders;
} }
sub selectable sub selectable
{ my ($self, $f) = @_; { my ($self, $f) = @_;
not grep /NoSelect/i, $self->list("", $f); not( grep /NoSelect/i, $self->list("", $f) );
} }
sub append sub append
@ -2520,10 +2504,12 @@ sub authenticate
until($code) until($code)
{ my $output = $self->_read_line or return undef; { my $output = $self->_read_line or return undef;
foreach my $o (@$output) foreach my $o (@$output)
{ $self->_record($count,$o); { $self->_record($count, $o);
$code = $o->[DATA] =~ /^\+\s+(.*)$/ ? $1 : undef; $code = $o->[DATA] =~ /^\+\s+(\S+)\s*$/ ? $1
: $o->[DATA] =~ /^\+\s*$/ ? 'OK'
: undef;
if ($o->[DATA] =~ /^\*\s+BYE/) if($o->[DATA] =~ /^\*\s+BYE/)
{ $self->State(Unconnected); { $self->State(Unconnected);
return undef; return undef;
} }
@ -2536,9 +2522,36 @@ sub authenticate
if($scheme eq 'CRAM-MD5') if($scheme eq 'CRAM-MD5')
{ $response ||= sub { $response ||= sub
{ my ($code, $client) = @_; { my ($code, $client) = @_;
my $hmac = hmac_md5_hex(decode_base64($code), $client->Password); use Digest::HMAC_MD5;
my $hmac = Digest::HMAC_MD5::hmac_md5_hex(decode_base64($code), $client->Password);
encode_base64($client->User." ".$hmac); encode_base64($client->User." ".$hmac);
} };
}
elsif($scheme eq 'DIGEST-MD5')
{ $response ||= sub
{ my ($code, $client) = @_;
require Authen::SASL;
require Digest::MD5;
my $authname = $client->Authuser;
defined $authname or $authname = $client->User;
my $sasl = Authen::SASL->new
( mechanism => 'DIGEST-MD5'
, callback =>
{ user => $client->User
, pass => $client->Password
, authname => $authname
}
);
# client_new is an empty function for DIGEST-MD5
my $conn = $sasl->client_new('imap', 'localhost', '');
my $answer = $conn->client_step(decode_base64 $code);
encode_base64($response, '')
if defined $answer;
};
} }
elsif($scheme eq 'PLAIN') # PLAIN SASL elsif($scheme eq 'PLAIN') # PLAIN SASL
{ $response ||= sub { $response ||= sub
@ -2562,12 +2575,12 @@ sub authenticate
return undef; return undef;
} }
undef $code = $scheme eq 'PLAIN' ? 'OK' : undef; undef $code;
until($code) until($code)
{ my $output = $self->_read_line or return undef; { my $output = $self->_read_line or return undef;
foreach my $o (@$output) foreach my $o (@$output)
{ $self->_record($count, $o); { $self->_record($count, $o);
$code = $o->[DATA] =~ /^\+\s+(.*)$/ ? $1 : undef; $code = $o->[DATA] =~ /^\+\s+(.*?)\s*$/ ? $1 : undef;
if($code) if($code)
{ unless($self->_send_line($response->($code, $self))) { unless($self->_send_line($response->($code, $self)))
@ -2719,23 +2732,15 @@ sub quota_usage
( map { /.*STORAGE\s+(\d+)\s+\d+.*\n$/ ? $1 : () } $self->Results)[0]; ( map { /.*STORAGE\s+(\d+)\s+\d+.*\n$/ ? $1 : () } $self->Results)[0];
} }
sub Quote { sub Quote($) { $_[0]->Massage($_[1], NonFolderArg) }
my ($class, $arg) = @_;
return $class->Massage($arg, NonFolderArg);
}
sub Massage sub Massage($;$)
{ my ($self, $arg, $notFolder) = @_; { my ($self, $name, $notFolder) = @_;
$arg or return; $name =~ s/^\"(.*)\"$/$1/ unless $notFolder;
my $escaped_arg = $arg;
$escaped_arg =~ s/"/\\"/g;
$arg = substr($arg, 1, length($arg)-2) if $arg =~ /^".*"$/
&& ! ( $notFolder || $self->status(qq("$escaped_arg"), "MESSAGES"));
if($arg =~ /["\\]/) { $arg = "{".length($arg)."}\r\n$arg" } $name =~ /["\\]/ ? "{".length($name)."}\r\n$name"
elsif($arg =~ /[\s{}()]/) { $arg = qq("$arg") } : $name =~ /[\s{}()]/ ? qq["$name"]
: $name;
$arg;
} }
sub unseen_count sub unseen_count

50
Mail-IMAPClient-3.00/lib/Mail/IMAPClient.pod → Mail-IMAPClient-3.05/lib/Mail/IMAPClient.pod
View file

@ -41,7 +41,7 @@ object's status, see the section labeled L<"Status Methods">, below.
RFC2060 defines two commands for authenticating to an IMAP server: RFC2060 defines two commands for authenticating to an IMAP server:
LOGIN for plain text authentication and AUTHENTICATE for more secure LOGIN for plain text authentication and AUTHENTICATE for more secure
authentication mechanisms. Currently Mail::IMAPClient supports authentication mechanisms. Currently Mail::IMAPClient supports
CRAM-MD5, LOGIN, PLAIN (SASL), and NTLM authentication. DIGEST-MD5, CRAM-MD5, LOGIN, PLAIN (SASL), and NTLM authentication.
There are also a number of methods and parameters that you can use to There are also a number of methods and parameters that you can use to
build your own authentication mechanism. Since this topic is a source of build your own authentication mechanism. Since this topic is a source of
@ -161,16 +161,24 @@ call L<connect>, who will call L<login>. If B<login> sees that you've
set an I<Authmechanism> then it will call B<authenticate>, using your set an I<Authmechanism> then it will call B<authenticate>, using your
I<Authmechanism> and I<Authcallback> parameters as arguments. I<Authmechanism> and I<Authcallback> parameters as arguments.
=item Authuser
Normally you authenticate and log in with the username specified in
the User parameter. When you are using DIGEST-MD5 as I<Authmechanism>,
you can optionally specify a different username for the final log in.
This can be useful to mark messages as seen for the I<Authuser>
if you don't know the password of the user as the seen state
is often a per-user state.
=item Authcallback =item Authcallback
The I<Authcallback> parameter, if set, should contain a pointer The I<Authcallback> parameter, if set, should contain a pointer
to a subroutine. The L<login> method will use this as the callback to a subroutine. The L<login> method will use this as the callback
argument to the B<authenticate> method if the I<Authmechanism> and argument to the B<authenticate> method if the I<Authmechanism> and
I<Authcallback> parameters are both set. If you set I<Authmechanism> I<Authcallback> parameters are both set. If you set I<Authmechanism>
but not I<Authcallback> then the default callback for your mechanism but not I<Authcallback> then the default callback for your mechanism will
will be used. CRAM-MD5, PLAIN (SASL), and NTLM authentication mechanisms be used. All supported authentication mechanisms have a default callback;
have a default callback; in every other case not supplying the callback in every other case not supplying the callback results in an error.
results in an error.
Most advanced authentication mechanisms require a challenge-response Most advanced authentication mechanisms require a challenge-response
exchange. After the L<authenticate> method sends "<tag> AUTHENTICATE exchange. After the L<authenticate> method sends "<tag> AUTHENTICATE
@ -518,6 +526,21 @@ seconds since the epoch date. It returns an RFC2060 compliant date
string for that date (as required in date-related arguments to SEARCH, string for that date (as required in date-related arguments to SEARCH,
such as "since", "before", etc.). such as "since", "before", etc.).
=head2 Rfc2060_datetime
Example:
$date = $imap->Rfc2060_datetime($seconds);
# or:
$date = Mail::IMAPClient->Rfc2060_datetime($seconds);
The B<Rfc2060_datetime> method accepts one or two arguments: a obligatory
timestamp and an optional zone. The zone shall be formatted as
C<< [+-]\d{4} >>, and defaults to C<< +0000 >>. The timestamp follows the
definition of the output of the platforms specific C<time>, usually in
seconds since Jan 1st 1970. However, you have to correct the number
yourself for the zone.
=head2 Rfc822_date =head2 Rfc822_date
Example: Example:
@ -778,9 +801,8 @@ override parameter settings.
If you do not specify a second argument and you have not set the If you do not specify a second argument and you have not set the
I<Authcallback> parameter, then the first argument must be I<Authcallback> parameter, then the first argument must be
one of the authentication mechanisms for which B<Mail::IMAPClient> has one of the authentication mechanisms for which B<Mail::IMAPClient>
built in support. Currently there is only built in support for CRAM-MD5, has built in support.
but I hope to add more in future releases.
If you are interested in doing NTLM authentication then please see Mark If you are interested in doing NTLM authentication then please see Mark
Bush's L<Authen::NTLM>, which can work with B<Mail::IMAPClient> to Bush's L<Authen::NTLM>, which can work with B<Mail::IMAPClient> to
@ -1399,7 +1421,7 @@ B<has_capability>.
Example: Example:
my $idle = $imap->idle or warn "Couldn't idle: $@\n"; my $idle = $imap->idle or warn "Couldn't idle: $@\n";
&goDoOtherThings; goDoOtherThings();
$imap->done($idle) or warn "Error from done: $@\n"; $imap->done($idle) or warn "Error from done: $@\n";
The B<idle> method places the IMAP connection in an IDLE state. Your The B<idle> method places the IMAP connection in an IDLE state. Your
@ -1594,7 +1616,13 @@ B<login> is sometimes called automatically by L<connect>, which in turn
is sometimes called automatically by L<new>. You can predict this is sometimes called automatically by L<new>. You can predict this
behavior once you've read the section on the L<new> method. behavior once you've read the section on the L<new> method.
=cut Then Sun/iPlanet/Netscape IMAP servers to allow an administrative user to
masquerade as another user. The B<proxyauth> method uses the IMAP
PROXYAUTH client command provided like this:
$imap->login("admin", "password");
$imap->proxyauth("someuser");
=head2 logout =head2 logout
@ -3344,7 +3372,7 @@ Example:
=head2 Socket =head2 Socket
B<PLEASE NOT> B<PLEASE NOTE>
The semantics of this method has changed as of version 2.99_04 of this module. The semantics of this method has changed as of version 2.99_04 of this module.
If you need the old semantics, you now have to use L<RawSocket>. If you need the old semantics, you now have to use L<RawSocket>.

4
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/BodyStructure.pm → Mail-IMAPClient-3.05/lib/Mail/IMAPClient/BodyStructure.pm
View file

@ -2,8 +2,6 @@ use warnings;
use strict; use strict;
package Mail::IMAPClient::BodyStructure; package Mail::IMAPClient::BodyStructure;
our $VERSION = '0.0.4';
use Mail::IMAPClient::BodyStructure::Parse; use Mail::IMAPClient::BodyStructure::Parse;
# my has file scope, not limited to package! # my has file scope, not limited to package!
@ -177,7 +175,7 @@ BEGIN
package Mail::IMAPClient::BodyStructure::Address; package Mail::IMAPClient::BodyStructure::Address;
@ISA = qw/Mail::IMAPClient::BodyStructure/; our @ISA = qw/Mail::IMAPClient::BodyStructure/;
for my $datum ( qw(personalname mailboxname hostname sourcename) ) for my $datum ( qw(personalname mailboxname hostname sourcename) )
{ no strict 'refs'; { no strict 'refs';

185
Mail-IMAPClient-3.05/lib/Mail/IMAPClient/BodyStructure/Parse.grammar Executable file
View file

@ -0,0 +1,185 @@
# Directives
# ( none)
# Start-up Actions
{
my $mibs = "Mail::IMAPClient::BodyStructure";
my $subpartCount = 0;
my $partCount = 0;
sub take_optional_items($$@)
{ my ($r, $items) = (shift, shift);
foreach (@_)
{ my $opt = $_ .'(?)';
exists $items->{$opt} or next;
$r->{$_} = UNIVERSAL::isa($items->{$opt}, 'ARRAY')
? $items->{$opt}[0] : $items->{$opt};
}
}
sub merge_hash($$)
{ my $to = shift;
my $from = shift or return;
while( my($k,$v) = each %$from) { $to->{$k} = $v }
}
}
# Atoms
TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" }
PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" }
HTML: /"HTML"|HTML/i { $return = "HTML" }
MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE"}
RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" }
NIL: /^NIL/i { $return = "NIL" }
NUMBER: /^(\d+)/ { $return = $item[1] }
# Strings:
SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" { $return = $item{__PATTERN1__} }
DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' { $return = $item{__PATTERN1__} }
BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/
{ $return = $item{__PATTERN1__} }
STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING | BARESTRING
STRINGS: "(" STRING(s) ")" { $return = $item{'STRING(s)'} }
textlines: NIL | NUMBER
rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" }
bodysubtype: PLAIN | HTML | NIL | STRING
key: STRING
value: NIL | NUMBER | STRING | KVPAIRS
kvpair: ...!")" key value
{ $return = { $item{key} => $item{value} } }
KVPAIRS: "(" kvpair(s) ")"
{ $return = { map { (%$_) } @{$item{'kvpair(s)'}} } }
bodytype: STRING
bodyparms: NIL | KVPAIRS
bodydisp: NIL | KVPAIRS
bodyid: ...!/[()]/ NIL | STRING
bodydesc: ...!/[()]/ NIL | STRING
bodysize: ...!/[()]/ NIL | NUMBER
bodyenc: NIL | STRING | KVPAIRS
bodyMD5: NIL | STRING
bodylang: NIL | STRING | STRINGS
bodyextra: NIL | STRING | STRINGS
personalname: NIL | STRING
sourceroute: NIL | STRING
mailboxname: NIL | STRING
hostname: NIL | STRING
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
{ bless { personalname => $item{personalname}
, sourceroute => $item{sourceroute}
, mailboxname => $item{mailboxname}
, hostname => $item{hostname}
}, 'Mail::IMAPClient::BodyStructure::Address';
}
subject: NIL | STRING
inreplyto: NIL | STRING
messageid: NIL | STRING
date: NIL | STRING
ADDRESSES: NIL
| "(" addressstruct(s) ")" { $return = $item{'addressstruct(s)'} }
cc: ADDRESSES
bcc: ADDRESSES
from: ADDRESSES
replyto: ADDRESSES
sender: ADDRESSES
to: ADDRESSES
envelopestruct: "(" date subject from sender replyto to cc
bcc inreplyto messageid ")"
{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope";
$return->{$_} = $item{$_}
for qw/date subject from sender replyto to cc/
, qw/bcc inreplyto messageid/;
1;
}
basicfields: bodysubtype bodyparms(?) bodyid(?)
bodydesc(?) bodyenc(?) bodysize(?)
{ $return = { bodysubtype => $item{bodysubtype} };
take_optional_items($return, \%item,
qw/bodyparms bodyid bodydesc bodyenc bodysize/);
1;
}
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?)
bodydisp(?) bodylang(?) bodyextra(?)
{
$return = $item{basicfields} || {};
$return->{bodytype} = 'TEXT';
take_optional_items($return, \%item
, qw/textlines bodyMD5 bodydisp bodylang bodyextra/);
1;
}
othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?)
bodylang(?) bodyextra(?)
{ $return = { bodytype => $item{bodytype} };
take_optional_items($return, \%item
, qw/bodyparms bodydisp bodylang bodyextra/ );
merge_hash($return, $item{basicfields});
1;
}
nestedmessage: rfc822message <commit> bodyparms bodyid bodydesc bodyenc
# bodysize envelopestruct bodystructure textlines
bodysize envelopestruct(?) bodystructure(?) textlines(?)
bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?)
{
$return = {};
$return->{$_} = $item{$_}
for qw/bodyparms bodyid bodydesc bodyenc bodysize/;
# envelopestruct bodystructure textlines/;
take_optional_items($return, \%item
, qw/envelopestruct bodystructure textlines/
, qw/bodyMD5 bodydisp bodylang bodyextra/);
merge_hash($return, $item{bodystructure}[0]);
merge_hash($return, $item{basicfields});
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype} = "RFC822" ;
1;
}
multipart: subpart(s) <commit> basicfields
bodyparms(?) bodydisp(?) bodylang(?) bodyextra(?)
<defer: $subpartCount = 0>
{ $return = $item{basicfields};
$return->{bodytype} = 'MULTIPART';
$return->{bodystructure} = $item{'subpart(s)'};
take_optional_items($return, \%item
, qw/bodyparms bodydisp bodylang bodyextra/);
1;
}
subpart: "(" part ")" {$return = $item{part}} <defer: ++$subpartCount;>
part: multipart { $return = bless $item{multipart}, $mibs }
| textmessage { $return = bless $item{textmessage}, $mibs }
| nestedmessage { $return = bless $item{nestedmessage}, $mibs }
| othertypemessage { $return = bless $item{othertypemessage}, $mibs }
bodystructure: "(" part(s) ")"
{ $return = $item{'part(s)'} }
start: /.*?\(.*?BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
{ $return = $item{'part(1)'}[0] }
envelope: /.*?\(.*?ENVELOPE/ envelopestruct /.*\)/
{ $return = $item{envelopestruct} }

6838
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/BodyStructure/Parse.pm → Mail-IMAPClient-3.05/lib/Mail/IMAPClient/BodyStructure/Parse.pm
View file

File diff suppressed because it is too large Load diff

0
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/BodyStructure/Parse.pod → Mail-IMAPClient-3.05/lib/Mail/IMAPClient/BodyStructure/Parse.pod
View file

5
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/MessageSet.pm → Mail-IMAPClient-3.05/lib/Mail/IMAPClient/MessageSet.pm
View file

@ -5,7 +5,7 @@ package Mail::IMAPClient::MessageSet;
=head1 NAME =head1 NAME
Mail::IMAPClient::MessageSet -- ranges of message sequence nummers Mail::IMAPClient::MessageSet - ranges of message sequence nummers
=cut =cut
@ -26,6 +26,7 @@ sub new
sub str { overload::StrVal( ${$_[0]} ) } sub str { overload::StrVal( ${$_[0]} ) }
sub _unfold_range($) sub _unfold_range($)
# { my $x = shift; return if $x =~ m/[^0-9,:]$/; $x =~ s/\:/../g; eval $x; }
{ map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ } { map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ }
split /\,/, shift; split /\,/, shift;
} }
@ -33,7 +34,7 @@ sub _unfold_range($)
sub rem sub rem
{ my $self = shift; { my $self = shift;
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_; my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
$$self = $self->range(map {$delete{$_} ? () : $_ } $self->unfold); $$self = $self->range(grep {not $delete{$_}} $self->unfold);
$self; $self;
} }

0
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/Thread.grammar → Mail-IMAPClient-3.05/lib/Mail/IMAPClient/Thread.grammar
View file

34
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/Thread.pm → Mail-IMAPClient-3.05/lib/Mail/IMAPClient/Thread.pm
View file

@ -820,7 +820,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'hashname' => '__STRING1__', 'hashname' => '__STRING1__',
'description' => '\'(\'', 'description' => '\'(\'',
'lookahead' => 0, 'lookahead' => 0,
'line' => 274 'line' => 177
}, 'Parse::RecDescent::InterpLit' ), }, 'Parse::RecDescent::InterpLit' ),
bless( { bless( {
'subrule' => 'threadmember', 'subrule' => 'threadmember',
@ -831,19 +831,19 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'matchrule' => 0, 'matchrule' => 0,
'repspec' => 's', 'repspec' => 's',
'lookahead' => 0, 'lookahead' => 0,
'line' => 274 'line' => 177
}, 'Parse::RecDescent::Repetition' ), }, 'Parse::RecDescent::Repetition' ),
bless( { bless( {
'pattern' => ')', 'pattern' => ')',
'hashname' => '__STRING2__', 'hashname' => '__STRING2__',
'description' => '\')\'', 'description' => '\')\'',
'lookahead' => 0, 'lookahead' => 0,
'line' => 274 'line' => 177
}, 'Parse::RecDescent::InterpLit' ), }, 'Parse::RecDescent::InterpLit' ),
bless( { bless( {
'hashname' => '__ACTION1__', 'hashname' => '__ACTION1__',
'lookahead' => 0, 'lookahead' => 0,
'line' => 275, 'line' => 178,
'code' => '{ 'code' => '{
$return = $item{\'threadmember(s)\'}||undef; $return = $item{\'threadmember(s)\'}||undef;
}' }'
@ -854,7 +854,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
], ],
'name' => 'thread', 'name' => 'thread',
'vars' => '', 'vars' => '',
'line' => 274 'line' => 177
}, 'Parse::RecDescent::Rule' ), }, 'Parse::RecDescent::Rule' ),
'NUMBER' => bless( { 'NUMBER' => bless( {
'impcount' => 0, 'impcount' => 0,
@ -877,7 +877,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'description' => '/\\\\d+/', 'description' => '/\\\\d+/',
'lookahead' => 0, 'lookahead' => 0,
'rdelim' => '/', 'rdelim' => '/',
'line' => 267, 'line' => 170,
'mod' => '', 'mod' => '',
'ldelim' => '/' 'ldelim' => '/'
}, 'Parse::RecDescent::Token' ) }, 'Parse::RecDescent::Token' )
@ -887,7 +887,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
], ],
'name' => 'NUMBER', 'name' => 'NUMBER',
'vars' => '', 'vars' => '',
'line' => 265 'line' => 168
}, 'Parse::RecDescent::Rule' ), }, 'Parse::RecDescent::Rule' ),
'start' => bless( { 'start' => bless( {
'impcount' => 0, 'impcount' => 0,
@ -912,7 +912,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'description' => '/^\\\\* THREAD /i', 'description' => '/^\\\\* THREAD /i',
'lookahead' => 0, 'lookahead' => 0,
'rdelim' => '/', 'rdelim' => '/',
'line' => 280, 'line' => 183,
'mod' => 'i', 'mod' => 'i',
'ldelim' => '/' 'ldelim' => '/'
}, 'Parse::RecDescent::Token' ), }, 'Parse::RecDescent::Token' ),
@ -925,12 +925,12 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'matchrule' => 0, 'matchrule' => 0,
'repspec' => 's?', 'repspec' => 's?',
'lookahead' => 0, 'lookahead' => 0,
'line' => 280 'line' => 183
}, 'Parse::RecDescent::Repetition' ), }, 'Parse::RecDescent::Repetition' ),
bless( { bless( {
'hashname' => '__ACTION1__', 'hashname' => '__ACTION1__',
'lookahead' => 0, 'lookahead' => 0,
'line' => 280, 'line' => 183,
'code' => '{ 'code' => '{
$return=$item{\'thread(s?)\'}||undef; $return=$item{\'thread(s?)\'}||undef;
}' }'
@ -941,7 +941,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
], ],
'name' => 'start', 'name' => 'start',
'vars' => '', 'vars' => '',
'line' => 279 'line' => 182
}, 'Parse::RecDescent::Rule' ), }, 'Parse::RecDescent::Rule' ),
'threadmember' => bless( { 'threadmember' => bless( {
'impcount' => 0, 'impcount' => 0,
@ -967,12 +967,12 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'implicit' => undef, 'implicit' => undef,
'argcode' => undef, 'argcode' => undef,
'lookahead' => 0, 'lookahead' => 0,
'line' => 271 'line' => 174
}, 'Parse::RecDescent::Subrule' ), }, 'Parse::RecDescent::Subrule' ),
bless( { bless( {
'hashname' => '__ACTION1__', 'hashname' => '__ACTION1__',
'lookahead' => 0, 'lookahead' => 0,
'line' => 271, 'line' => 174,
'code' => '{ $return = $item{NUMBER} ; }' 'code' => '{ $return = $item{NUMBER} ; }'
}, 'Parse::RecDescent::Action' ) }, 'Parse::RecDescent::Action' )
], ],
@ -993,21 +993,21 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'implicit' => undef, 'implicit' => undef,
'argcode' => undef, 'argcode' => undef,
'lookahead' => 0, 'lookahead' => 0,
'line' => 272 'line' => 175
}, 'Parse::RecDescent::Subrule' ), }, 'Parse::RecDescent::Subrule' ),
bless( { bless( {
'hashname' => '__ACTION1__', 'hashname' => '__ACTION1__',
'lookahead' => 0, 'lookahead' => 0,
'line' => 272, 'line' => 175,
'code' => '{ $return = $item{thread} ; }' 'code' => '{ $return = $item{thread} ; }'
}, 'Parse::RecDescent::Action' ) }, 'Parse::RecDescent::Action' )
], ],
'line' => 271 'line' => 174
}, 'Parse::RecDescent::Production' ) }, 'Parse::RecDescent::Production' )
], ],
'name' => 'threadmember', 'name' => 'threadmember',
'vars' => '', 'vars' => '',
'line' => 269 'line' => 172
}, 'Parse::RecDescent::Rule' ) }, 'Parse::RecDescent::Rule' )
} }
}, 'Parse::RecDescent' ); }, 'Parse::RecDescent' );

0
Mail-IMAPClient-3.00/lib/Mail/IMAPClient/Thread.pod → Mail-IMAPClient-3.05/lib/Mail/IMAPClient/Thread.pod
View file

0
Mail-IMAPClient-3.00/prepare_dist → Mail-IMAPClient-3.05/prepare_dist
View file

0
Mail-IMAPClient-3.00/sample.perldb → Mail-IMAPClient-3.05/sample.perldb
View file

0
Mail-IMAPClient-3.00/t/basic.t → Mail-IMAPClient-3.05/t/basic.t
View file

30
Mail-IMAPClient-3.00/t/bodystructure.t → Mail-IMAPClient-3.05/t/bodystructure.t
View file

@ -2,8 +2,12 @@
use warnings; use warnings;
use strict; use strict;
use lib 'lib';
use Test::More tests => 8; use Test::More tests => 10;
use Data::Dumper;
$Data::Dumper::Indent=1;
use_ok('Mail::IMAPClient::BodyStructure'); use_ok('Mail::IMAPClient::BodyStructure');
@ -16,8 +20,9 @@ ok(defined $bsobj, 'parsed first');
is($bsobj->bodytype, 'TEXT', 'bodytype'); is($bsobj->bodytype, 'TEXT', 'bodytype');
is($bsobj->bodysubtype, 'PLAIN', 'bodysubtype'); is($bsobj->bodysubtype, 'PLAIN', 'bodysubtype');
my $bs2 = <<'END_OF_BS2'; 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)) (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 END_OF_BS2
$bsobj = Mail::IMAPClient::BodyStructure->new($bs2) ; $bsobj = Mail::IMAPClient::BodyStructure->new($bs2) ;
@ -26,4 +31,23 @@ is($bsobj->bodytype, 'MULTIPART', 'bodytype');
is($bsobj->bodysubtype, 'MIXED', 'bodysubtype'); is($bsobj->bodysubtype, 'MIXED', 'bodysubtype');
is(join("#",$bsobj->parts), is(join("#",$bsobj->parts),
"1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2", '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');

0
Mail-IMAPClient-3.00/t/messageset.t → Mail-IMAPClient-3.05/t/messageset.t
View file

0
Mail-IMAPClient-3.00/t/pod.t → Mail-IMAPClient-3.05/t/pod.t
View file

0
Mail-IMAPClient-3.00/t/thread.t → Mail-IMAPClient-3.05/t/thread.t
View file

0
Mail-IMAPClient-3.00/test_template.txt → Mail-IMAPClient-3.05/test_template.txt
View file

4
README
View file

@ -3,7 +3,7 @@ NAME
Synchronise mailboxes between two imap servers. Good at IMAP migration. Synchronise mailboxes between two imap servers. Good at IMAP migration.
More than 32 different IMAP server softwares supported with success. More than 32 different IMAP server softwares supported with success.
$Revision: 1.241 $ $Revision: 1.249 $
INSTALL INSTALL
imapsync works fine under any Unix OS with perl. imapsync works fine under any Unix OS with perl.
@ -333,5 +333,5 @@ SIMILAR SOFTWARES
Feedback (good or bad) will be always welcome. Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.241 2007/12/31 13:39:02 gilles Exp gilles $ $Id: imapsync,v 1.249 2008/03/19 02:14:24 gilles Exp $

7
TODO
View file

@ -1,6 +1,13 @@
TODO file for imapsync TODO file for imapsync
---------------------- ----------------------
Make "--delete 2" be a fatal error.
Start an imap internet scan project.
Explain howto change only the header with --regexmess
Start a wiki for imapsync.
Add a --pidfile option. Add a --pidfile option.
Add a --tmpfile option. Add a --tmpfile option.

2
VERSION
View file

@ -1 +1 @@
1.241 1.249

3768
bugs/lib/Mail/IMAPClient.pm
View file

File diff suppressed because it is too large Load diff

22
freshmeat_submition.inp
View file

@ -3,10 +3,10 @@
#RELEASE_FOCUS="Initial freshmeat announcement" #RELEASE_FOCUS="Initial freshmeat announcement"
#RELEASE_FOCUS="Documentation" #RELEASE_FOCUS="Documentation"
#RELEASE_FOCUS="Code cleanup" #RELEASE_FOCUS="Code cleanup"
#RELEASE_FOCUS="Minor feature enhancements" RELEASE_FOCUS="Minor feature enhancements"
#RELEASE_FOCUS="Major feature enhancements" #RELEASE_FOCUS="Major feature enhancements"
#RELEASE_FOCUS="Minor bugfixes" #RELEASE_FOCUS="Minor bugfixes"
RELEASE_FOCUS="Major bugfixes" #RELEASE_FOCUS="Major bugfixes"
#RELEASE_FOCUS="Minor security fixes" #RELEASE_FOCUS="Minor security fixes"
#RELEASE_FOCUS="Major security fixes" #RELEASE_FOCUS="Major security fixes"
@ -16,14 +16,12 @@ RELEASE_FOCUS="Major bugfixes"
#TEXT_BODY="Bug fix: rewrote the way to store messages to avoid freeze problems with some imap servers" #TEXT_BODY="Bug fix: rewrote the way to store messages to avoid freeze problems with some imap servers"
#TEXT_BODY="Bug fix: Allow long usernames with md5 authentification." #TEXT_BODY="Bug fix: Allow long usernames with md5 authentification."
TEXT_BODY="Bug fixes: TEXT_BODY="Bug fixes:
- Avoid infinite loop with bad hostname. - Turned on --syncinternaldates option by default.
- Works without patch on MSWin32 systems. - Set timezone TZ=GMT if no timezone is set (MSWindows "bug").
- Updated help message : avoid --authuser and --authmech1 SOMETHING - Ignore message when it has no header.
- Uppercase --authmech input. - Added message id in output warning when no header found.
- Date with minus %d-%b-%Y (RFC compliant) - Removed public freshmeat annoucement access since 1.241 was not mine (no problem) and not correct (problem).
- Added Date::Manip dependency. - Can run with IMAPClient_3.x.x without redefine any function (but 3.x.x is still buggy and to be avoided)
- Added Dovecot 1.0.0 [dest] success. - Started unit tests.
- Added Deerfield VisNetic MailServer 5.8.6 [from] success. - Many thanks to the freshmeat folk that correct my bad and poorly English !
- Turn to --nofastio1 --nofastio2 by default.
- Flags \Recent can be uppercase \RECENT now.
" "

274
imapsync
View file

@ -1,4 +1,4 @@
#!/usr/bin/perl -w #!/usr/bin/perl
=pod =pod
@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good
at IMAP migration. More than 32 different IMAP server softwares at IMAP migration. More than 32 different IMAP server softwares
supported with success. supported with success.
$Revision: 1.241 $ $Revision: 1.249 $
=head1 INSTALL =head1 INSTALL
@ -387,15 +387,17 @@ Entries for imapsync:
Feedback (good or bad) will be always welcome. Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.241 2007/12/31 13:39:02 gilles Exp gilles $ $Id: imapsync,v 1.249 2008/03/19 02:14:24 gilles Exp $
=cut =cut
use warnings;
++$|; ++$|;
use strict; use strict;
use Carp;
use Getopt::Long; use Getopt::Long;
use Mail::IMAPClient; use Mail::IMAPClient;
use Digest::MD5 qw(md5_base64); use Digest::MD5 qw(md5_base64);
@ -450,14 +452,14 @@ my(
use vars qw ($opt_G); # missing code for this will be option. use vars qw ($opt_G); # missing code for this will be option.
$rcs = ' $Id: imapsync,v 1.241 2007/12/31 13:39:02 gilles Exp gilles $ '; $rcs = ' $Id: imapsync,v 1.249 2008/03/19 02:14:24 gilles Exp $ ';
$rcs =~ m/,v (\d+\.\d+)/; $rcs =~ m/,v (\d+\.\d+)/;
$VERSION = ($1) ? $1 : "UNKNOWN"; $VERSION = ($1) ? $1 : "UNKNOWN";
my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION; my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION;
check_lib_version() or check_lib_version() or
die "imapsync needs perl lib Mail::IMAPClient release 2.2.9 exactly, future imapsync release may suppoort 3.0.x, but sorry not now\n"; die "imapsync needs perl lib Mail::IMAPClient release 2.2.9 exactly, future imapsync release may suppoort 3.0.x, but sorry not now. See file BUG_IMAPClient_3.xx\n";
$mess_size_total_trans = 0; $mess_size_total_trans = 0;
@ -467,15 +469,16 @@ $mess_trans = $mess_skipped = $mess_skipped_dry = 0;
sub check_lib_version { sub check_lib_version {
if ($VERSION_IMAPClient =~ m/(\d+)\.(\d+)\.(\d+)/) { $debug and print "VERSION_IMAPClient $1 $2 $3\n";
$debug and print "VERSION_IMAPClient $1 $2 $3\n"; if ($VERSION_IMAPClient eq '2.2.9') {
#my($major,$minor,$sub) = ($1, $2, $3); override_imapclient();
return(1);
return(1) if($VERSION_IMAPClient eq '2.2.9');
} }
else{ else{
return 0; # don't match regex => bad # 3.x.x is still buggy with imapsync.
# uncomment "return 1" if you want to check it.
#return 1;
return 0;
} }
} }
@ -483,8 +486,8 @@ $error=0;
my $banner = join("", my $banner = join("",
'$RCSfile: imapsync,v $ ', '$RCSfile: imapsync,v $ ',
'$Revision: 1.241 $ ', '$Revision: 1.249 $ ',
'$Date: 2007/12/31 13:39:02 $ ', '$Date: 2008/03/19 02:14:24 $ ',
"\n",localhost_info(), "\n",localhost_info(),
" and the module Mail::IMAPClient version used here is ", " and the module Mail::IMAPClient version used here is ",
$VERSION_IMAPClient,"\n", $VERSION_IMAPClient,"\n",
@ -510,11 +513,9 @@ $split1 ||= 1000;
$split2 ||= 1000; $split2 ||= 1000;
$host1 || missing_option("--host1") ; $host1 || missing_option("--host1") ;
# $port1 = (defined($port1)) ? $port1 : 143;
$port1 ||= defined $ssl1 ? 993 : 143; $port1 ||= defined $ssl1 ? 993 : 143;
$host2 || missing_option("--host2") ; $host2 || missing_option("--host2") ;
# $port2 = (defined($port2)) ? $port2 : 143;
$port2 ||= defined $ssl2 ? 993 : 143; $port2 ||= defined $ssl2 ? 993 : 143;
sub connect_imap { sub connect_imap {
@ -523,7 +524,7 @@ sub connect_imap {
$imap->Server($host); $imap->Server($host);
$imap->Port($port); $imap->Port($port);
$imap->Debug($debugimap); $imap->Debug($debugimap);
$imap->connect2() $imap->connect()
or die "Can not open imap connection on [$host] : $@\n"; or die "Can not open imap connection on [$host] : $@\n";
} }
@ -559,6 +560,28 @@ if ($justconnect) {
$user1 || missing_option("--user1"); $user1 || missing_option("--user1");
$user2 || missing_option("--user2"); $user2 || missing_option("--user2");
$syncinternaldates = defined($syncinternaldates) ? defined($syncinternaldates) : 1;
if ($syncinternaldates) {
print "Turned ON syncinternaldates, will set the internal dates on host2 same as host1.\n";
}else{
print "Turned OFF syncinternaldates\n";
}
if ($syncinternaldates) {
no warnings 'redefine';
local *Carp::confess = sub { return undef; };
require Date::Manip;
Date::Manip->import(qw(ParseDate Date_Cmp UnixDate Date_Init Date_TimeZone));
#print "Date_init : [", join(" ",Date_Init()), "]\n";
print "TimeZone :[", Date_TimeZone(), "]\n";
if (not (Date_TimeZone())) {
warn "TimeZone not defined, setting it to GMT";
Date_Init("TZ=GMT");
print "TimeZone : [", Date_TimeZone(), "]\n";
}
}
if(defined($authmd5) and not($authmd5)) { if(defined($authmd5) and not($authmd5)) {
$authmech1 ||= 'LOGIN'; $authmech1 ||= 'LOGIN';
$authmech2 ||= 'LOGIN'; $authmech2 ||= 'LOGIN';
@ -574,8 +597,8 @@ $authmech2 = uc($authmech2);
$authuser1 ||= $user1; $authuser1 ||= $user1;
$authuser2 ||= $user2; $authuser2 ||= $user2;
print "will try to use $authmech1 authentication on host1\n"; print "Will try to use $authmech1 authentication on host1\n";
print "will try to use $authmech2 authentication on host2\n"; print "Will try to use $authmech2 authentication on host2\n";
$syncacls = (defined($syncacls)) ? $syncacls : 0; $syncacls = (defined($syncacls)) ? $syncacls : 0;
$foldersizes = (defined($foldersizes)) ? $foldersizes : 1; $foldersizes = (defined($foldersizes)) ? $foldersizes : 1;
@ -584,6 +607,7 @@ $fastio1 = (defined($fastio1)) ? $fastio1 : 0;
$fastio2 = (defined($fastio2)) ? $fastio2 : 0; $fastio2 = (defined($fastio2)) ? $fastio2 : 0;
@useheader = ("ALL") unless (@useheader); @useheader = ("ALL") unless (@useheader);
print "From imap server [$host1] port [$port1] user [$user1]\n"; print "From imap server [$host1] port [$port1] user [$user1]\n";
@ -670,7 +694,7 @@ sub login_imap {
$imap->State(Mail::IMAPClient::Connected); $imap->State(Mail::IMAPClient::Connected);
} }
else { else {
$imap->connect2() $imap->connect()
or die "Can not open imap connection on [$host] with user [$user] : $@\n"; or die "Can not open imap connection on [$host] with user [$user] : $@\n";
} }
print "Banner : ", server_banner($imap); print "Banner : ", server_banner($imap);
@ -696,13 +720,13 @@ sub login_imap {
$imap->User($user); $imap->User($user);
$imap->Authuser($authuser); $imap->Authuser($authuser);
$imap->Password($password); $imap->Password($password);
unless ($imap->login2()) { unless ($imap->login()) {
print "Error login : [$host] with user [$user] auth [$authmech]: $@\n"; print "Error login : [$host] with user [$user] auth [$authmech]: $@\n";
die if ($authmech eq 'LOGIN'); die if ($authmech eq 'LOGIN');
die if $imap->IsUnconnected(); die if $imap->IsUnconnected();
print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n"; print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n";
$imap->Authmechanism(""); $imap->Authmechanism("");
$imap->login2() or $imap->login() or
die "Error login : [$host] with user [$user] auth [LOGIN] : $@"; die "Error login : [$host] with user [$user] auth [LOGIN] : $@";
} }
print "Success login on [$host] with user [$user] auth [$authmech]\n"; print "Success login on [$host] with user [$user] auth [$authmech]\n";
@ -1040,7 +1064,7 @@ sub foldersizes {
$smess = $imap->message_count(); $smess = $imap->message_count();
unless ($smess == 0) { unless ($smess == 0) {
#$imap->Ranges(1); #$imap->Ranges(1);
$imap->fetch_hash2("RFC822.SIZE",$hashref) or die "$@"; $imap->fetch_hash("RFC822.SIZE",$hashref) or die "$@";
#$imap->Ranges(0); #$imap->Ranges(0);
#print map {$hashref->{$_}->{"RFC822.SIZE"}, " "} keys %$hashref; #print map {$hashref->{$_}->{"RFC822.SIZE"}, " "} keys %$hashref;
map {$stot += $hashref->{$_}->{"RFC822.SIZE"}} keys %$hashref; map {$stot += $hashref->{$_}->{"RFC822.SIZE"}} keys %$hashref;
@ -1245,10 +1269,10 @@ FOLDER: foreach my $f_fold (@f_folders) {
last FOLDER if $from->IsUnconnected(); last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected(); last FOLDER if $to->IsUnconnected();
my $f_heads = $from->parse_headers2([@f_msgs], my $f_heads = $from->parse_headers([@f_msgs],
@useheader)if (@f_msgs) ; @useheader)if (@f_msgs) ;
$debug and print "Time headers: ", timenext(), " s\n"; $debug and print "Time headers: ", timenext(), " s\n";
my $f_fir = $from->fetch_hash2("FLAGS", my $f_fir = $from->fetch_hash("FLAGS",
"INTERNALDATE", "INTERNALDATE",
"RFC822.SIZE") if (@f_msgs); "RFC822.SIZE") if (@f_msgs);
$debug and print "Time fir : ", timenext(), " s\n"; $debug and print "Time fir : ", timenext(), " s\n";
@ -1262,10 +1286,10 @@ FOLDER: foreach my $f_fold (@f_folders) {
last FOLDER if $from->IsUnconnected(); last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected(); last FOLDER if $to->IsUnconnected();
my $t_heads = $to->parse_headers2([@t_msgs], my $t_heads = $to->parse_headers([@t_msgs],
@useheader) if (@t_msgs); @useheader) if (@t_msgs);
$debug and print "Time headers: ", timenext(), " s\n"; $debug and print "Time headers: ", timenext(), " s\n";
my $t_fir = $to->fetch_hash2("FLAGS", my $t_fir = $to->fetch_hash("FLAGS",
"INTERNALDATE", "INTERNALDATE",
"RFC822.SIZE") if (@t_msgs); "RFC822.SIZE") if (@t_msgs);
$debug and print "Time fir : ", timenext(), " s\n"; $debug and print "Time fir : ", timenext(), " s\n";
@ -1314,28 +1338,38 @@ FOLDER: foreach my $f_fold (@f_folders) {
# copy # copy
print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n"; print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
last FOLDER if $from->IsUnconnected(); last FOLDER if $from->IsUnconnected();
#my $string = $from->message_string($f_msg); my $string;
my $message_file = "tmp_imapsync_$$"; $string = $from->message_string($f_msg);
unlink($message_file); #print "AAAmessage_string[$string]ZZZ\n";
$from->message_to_file($message_file, $f_msg); #my $message_file = "tmp_imapsync_$$";
my $string = file_to_string($message_file); #$from->select($f_fold);
#unlink($message_file);
#$from->message_to_file($message_file, $f_msg) or do {
# warn "Could not put message #$f_msg to file $message_file",
# $from->LastError;
# $error++;
# $mess_size_total_error += $f_size;
# next MESS;
#};
#$string = file_to_string($message_file);
#print "AAA1[$string]ZZZ\n";
#unlink($message_file); #unlink($message_file);
if (@regexmess) { if (@regexmess) {
foreach my $regexmess (@regexmess) { foreach my $regexmess (@regexmess) {
$debug and print "eval \$string =~ $regexmess\n"; $debug and print "eval \$string =~ $regexmess\n";
eval("\$string =~ $regexmess"); eval("\$string =~ $regexmess");
} }
string_to_file($string, $message_file); #string_to_file($string, $message_file);
} }
$debug and print "F message content begin next line\n", $debug and print
$string, "=" x80, "\n",
"F message content ended on previous line\n"; "F message content begin next line\n",
$string,
"F message content ended on previous line\n", "=" x 80, "\n";
my $d = ""; my $d = "";
if ($syncinternaldates) { if ($syncinternaldates) {
$d = $f_idate; $d = $f_idate;
$debug and print "internal date from 1: [$d]\n"; $debug and print "internal date from 1: [$d]\n";
require Date::Manip;
Date::Manip->import(qw(ParseDate Date_Cmp UnixDate));
$d = UnixDate(ParseDate($d), "%d-%b-%Y %H:%M:%S %z"); $d = UnixDate(ParseDate($d), "%d-%b-%Y %H:%M:%S %z");
$d = "\"$d\""; $d = "\"$d\"";
$debug and print "internal date from 1: [$d] (fixed)\n"; $debug and print "internal date from 1: [$d] (fixed)\n";
@ -1355,7 +1389,10 @@ FOLDER: foreach my $f_fold (@f_folders) {
$new_id = $to->append_string($t_fold,$string, $flags_f, $d); $new_id = $to->append_string($t_fold,$string, $flags_f, $d);
} }
else { else {
$new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d); # just back to append_string since append_file 3.05 does not work.
#$new_id = $to->append_file($t_fold, $message_file, "", $flags_f, $d);
# append_string 3.05 does not work too.
$new_id = $to->append_string($t_fold,$string, $flags_f, $d);
} }
unless($new_id){ unless($new_id){
warn "Couldn't append msg #$f_msg (Subject:[". warn "Couldn't append msg #$f_msg (Subject:[".
@ -1382,7 +1419,7 @@ FOLDER: foreach my $f_fold (@f_folders) {
else{ else{
$mess_skipped_dry += 1; $mess_skipped_dry += 1;
} }
unlink($message_file); #unlink($message_file);
next MESS; next MESS;
} }
else{ else{
@ -1471,6 +1508,9 @@ FOLDER: foreach my $f_fold (@f_folders) {
print "Time : ", timenext(), " s\n"; print "Time : ", timenext(), " s\n";
} }
$from->logout(); $from->logout();
$to->logout(); $to->logout();
@ -1483,6 +1523,7 @@ stats();
exit(1) if($error); exit(1) if($error);
sub select_msgs { sub select_msgs {
@ -1633,7 +1674,7 @@ sub parse_header_msg1 {
my $head = $s_heads->{$m_uid}; my $head = $s_heads->{$m_uid};
my $headnum = scalar(keys(%$head)); my $headnum = scalar(keys(%$head));
$debug and print "Head NUM:", $headnum, "\n"; $debug and print "Head NUM:", $headnum, "\n";
unless($headnum) { print "Warning : no header used or found \n"; } unless($headnum) { print "Warning : no header used or found for message $m_uid\n"; }
my $headstr; my $headstr;
foreach my $h (sort keys(%$head)){ foreach my $h (sort keys(%$head)){
@ -1645,20 +1686,29 @@ sub parse_header_msg1 {
# and uppercase header keywords # and uppercase header keywords
# (dbmail and dovecot) # (dbmail and dovecot)
$val =~ s/^\s*(.+)$/$1/; $val =~ s/^\s*(.+)$/$1/;
my $H = uc($h);
#my $H = uc($h);
my $H = "$h: $val";
# show stuff in debug mode # show stuff in debug mode
$debug and print "${s}H $H:", $val, "\n"; $debug and print "${s}H $H:", $val, "\n";
if ($skipheader and $H =~ m/$skipheader/i) { if ($skipheader and $H =~ m/$skipheader/i) {
$debug and print "Skipping header $h\n"; $debug and print "Skipping header $H\n";
next; next;
} }
$headstr .= "$H:". $val; #$headstr .= "$H:". $val;
$headstr .= "$H";
} }
} }
#return unless ($headstr); #return unless ($headstr);
unless ($headstr){ unless ($headstr){
print "no header so taking everything\n"; # taking everything is too heavy,
$headstr = $imap->message_string($m_uid); # should take only 1 Ko
#print "no header so taking everything\n";
#$headstr = $imap->message_string($m_uid);
print "no header so we ignore this message\n";
return;
} }
my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"}; my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"};
my $flags = $s_fir->{$m_uid}->{"FLAGS"}; my $flags = $s_fir->{$m_uid}->{"FLAGS"};
@ -1791,7 +1841,8 @@ Several options are mandatory.
it will change in future releases. it will change in future releases.
--expunge1 : expunge messages on source account. --expunge1 : expunge messages on source account.
--expunge2 : expunge messages on target account. --expunge2 : expunge messages on target account.
--syncinternaldates : sets the internal dates on host2 same as host1 --syncinternaldates : sets the internal dates on host2 same as host1.
Turned on by default.
--buffersize <int> : sets the size of a block of I/O. --buffersize <int> : sets the size of a block of I/O.
--maxsize <int> : skip messages larger than <int> bytes --maxsize <int> : skip messages larger than <int> bytes
--maxage <int> : skip messages older than <int> days. --maxage <int> : skip messages older than <int> days.
@ -1863,27 +1914,24 @@ sub tests {
} }
} }
sub override_imapclient {
no warnings 'redefine';
no strict 'subs';
package Mail::IMAPClient; use constant Unconnected => 0;
use constant Connected => 1; # connected; not logged in
use constant Authenticated => 2; # logged in; no mailbox selected
use constant Selected => 3; # mailbox selected
use constant INDEX => 0; # Array index for output line number
use constant TYPE => 1; # Array index for line type
# (either OUTPUT, INPUT, or LITERAL)
use constant DATA => 2; # Array index for output line data
use constant NonFolderArg => 1; # Value to pass to Massage to
# indicate non-folder argument
sub Authuser {
my $self = shift;
if (@_) { $self->{AUTHUSER} = shift }
return $self->{AUTHUSER};
}
*Mail::IMAPClient::append_file = sub {
sub Split {
my $self = shift;
if (@_) { $self->{SPLIT} = shift }
return $self->{SPLIT};
}
# From IMAPClient.pm
sub append_file2 {
my $self = shift; my $self = shift;
my $folder = $self->Massage(shift); my $folder = $self->Massage(shift);
@ -1917,7 +1965,7 @@ sub append_file2 {
unless ($fh) { unless ($fh) {
$self->LastError("Unable to open $file: $!\n"); $self->LastError("Unable to open $file: $!\n");
$@ = "Unable to open $file: $!" ; $@ = "Unable to open $file: $!" ;
carp "unable to open $file: $!" if $^W; carp "unable to open $file: $!";
return undef; return undef;
} }
@ -1955,12 +2003,12 @@ sub append_file2 {
$self->_record($count,$o); # $o is already an array ref $self->_record($count,$o); # $o is already an array ref
($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i; ($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i;
if ($o->[DATA] =~ /^\*\s+BYE/) { if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W; carp $o->[DATA];
$self->State(Unconnected); $self->State(Unconnected);
$fh->close; $fh->close;
return undef ; return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W; carp $o->[DATA];
$fh->close; $fh->close;
return undef; return undef;
} }
@ -1980,7 +2028,7 @@ sub append_file2 {
$fh->close; $fh->close;
return undef; return undef;
} }
_debug $self, "control points to $$control\n" if ref($control) and $self->Debug; _debug($self, "control points to $$control\n") if ref($control) and $self->Debug;
$/ = ref($control) ? "\x0a" : $control ? $control : "\x0a"; $/ = ref($control) ? "\x0a" : $control ? $control : "\x0a";
while (defined($text = <$fh>)) { while (defined($text = <$fh>)) {
$text =~ s/\x0d?\x0a/\x0d\x0a/g; $text =~ s/\x0d?\x0a/\x0d\x0a/g;
@ -2018,12 +2066,12 @@ sub append_file2 {
# try to grab new msg's uid from o/p # try to grab new msg's uid from o/p
$o->[DATA] =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1; $o->[DATA] =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1;
if ($o->[DATA] =~ /^\*\s+BYE/) { if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W; carp $o->[DATA];
$self->State(Unconnected); $self->State(Unconnected);
$fh->close; $fh->close;
return undef ; return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W; carp $o->[DATA];
$fh->close; $fh->close;
return undef; return undef;
} }
@ -2037,10 +2085,12 @@ sub append_file2 {
return defined($uid) ? $uid : $self; return defined($uid) ? $uid : $self;
} };
# From IMAPClient.pm
sub fetch_hash2 {
*Mail::IMAPClient::fetch_hash = sub {
# taken from original lib, # taken from original lib,
# just added split code. # just added split code.
my $self = shift; my $self = shift;
@ -2110,14 +2160,13 @@ sub fetch_hash2 {
} }
} }
return wantarray ? %$hash : $hash; return wantarray ? %$hash : $hash;
} };
# From IMAPClient.pm
sub login2 { *Mail::IMAPClient::login = sub {
my $self = shift; my $self = shift;
return $self->authenticate2($self->Authmechanism,$self->Authcallback) return $self->authenticate($self->Authmechanism,$self->Authcallback)
if $self->{Authmechanism}; if $self->{Authmechanism};
my $id = $self->User; my $id = $self->User;
@ -2134,17 +2183,18 @@ sub login2 {
return undef; return undef;
}; };
return $self; return $self;
} };
# From IMAPClient.pm
sub parse_headers2 {
*Mail::IMAPClient::parse_headers = sub {
my($self,$msgspec_all,@fields) = @_; my($self,$msgspec_all,@fields) = @_;
my(%fieldmap) = map { ( lc($_),$_ ) } @fields; my(%fieldmap) = map { ( lc($_),$_ ) } @fields;
my $msg; my $string; my $field; my $msg; my $string; my $field;
unless(ref($msgspec_all) eq 'ARRAY') { unless(ref($msgspec_all) eq 'ARRAY') {
print "parse_headers2 want an ARRAY ref\n"; print "parse_headers want an ARRAY ref\n";
exit 1; exit 1;
} }
@ -2185,7 +2235,8 @@ sub parse_headers2 {
my $h = 0; # reference to hash of current msgid, or 0 between msgs my $h = 0; # reference to hash of current msgid, or 0 between msgs
for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) { for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) {
local($^W) = undef;
no warnings;
if ( $header =~ /^\*\s+\d+\s+FETCH\s+\(.*BODY\[HEADER(?:\]|\.FIELDS)/i) { if ( $header =~ /^\*\s+\d+\s+FETCH\s+\(.*BODY\[HEADER(?:\]|\.FIELDS)/i) {
if ($self->Uid) { if ($self->Uid) {
if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) { if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) {
@ -2222,9 +2273,12 @@ sub parse_headers2 {
if ($h != 0) { # do we expect this to be a header? if ($h != 0) { # do we expect this to be a header?
my $hdr = $header; my $hdr = $header;
chomp $hdr; chomp $hdr;
$hdr =~ s/\r$//; $hdr =~ s/\r$//;
if ($hdr =~ s/^(\S+):\s*//) { #print "W[$hdr]\n";
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
if (defined($hdr) and $hdr =~ s/^(\S+):\s*//) {
#print "X";
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
push @{$h->{$field}} , $hdr ; push @{$h->{$field}} , $hdr ;
} elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) { } elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) {
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
@ -2252,12 +2306,10 @@ sub parse_headers2 {
return $headers; return $headers;
} };
# From IMAPClient.pm *Mail::IMAPClient::authenticate = sub {
sub authenticate2 {
my $self = shift; my $self = shift;
my $scheme = shift; my $scheme = shift;
@ -2304,10 +2356,10 @@ sub authenticate2 {
if ('CRAM-MD5' eq $scheme && ! $response) { if ('CRAM-MD5' eq $scheme && ! $response) {
if ($Mail::IMAPClient::_CRAM_MD5_ERR) { if ($Mail::IMAPClient::_CRAM_MD5_ERR) {
$self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR); $self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR);
carp $Mail::IMAPClient::_CRAM_MD5_ERR if $^W; carp $Mail::IMAPClient::_CRAM_MD5_ERR;
} }
else { else {
$response = \&_cram_md5_2; $response = \&Mail::IMAPClient::_cram_md5;
} }
} }
@ -2343,17 +2395,21 @@ sub authenticate2 {
$code =~ /^OK/ and $self->State(Authenticated) ; $code =~ /^OK/ and $self->State(Authenticated) ;
return $code =~ /^OK/ ? $self : undef ; return $code =~ /^OK/ ? $self : undef ;
} };
sub _cram_md5_2 {
*Mail::IMAPClient::_cram_md5 = sub {
my ($code, $client) = @_; my ($code, $client) = @_;
my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($code), my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($code),
$client->Password()); $client->Password());
return MIME::Base64::encode($client->User() . " $hmac", ""); return MIME::Base64::encode($client->User() . " $hmac", "");
} };
sub connect2 {
*Mail::IMAPClient::connect = sub {
my $self = shift; my $self = shift;
$self->Port(143) $self->Port(143)
@ -2382,15 +2438,16 @@ sub connect2 {
#print "i03\n"; #print "i03\n";
$self->Socket($sock); $self->Socket($sock);
$self->State(Connected); $self->State(Connected);
#print "i04\n";
$sock->autoflush(1) ; $sock->autoflush(1) ;
my ($code, $output); my ($code, $output);
$output = ""; $output = "";
#print "i05\n";
until ( $code ) { until ( $code ) {
$output = $self->_read_line or return undef; $output = $self->_read_line or return undef;
#print "i06\n";
for my $o (@$output) { for my $o (@$output) {
$self->_debug("Connect: Received this from readline: " . $self->_debug("Connect: Received this from readline: " .
join("/",@$o) . "\n"); join("/",@$o) . "\n");
@ -2414,3 +2471,24 @@ sub connect2 {
} }
} }
}
package Mail::IMAPClient;
sub Authuser {
my $self = shift;
if (@_) { $self->{AUTHUSER} = shift }
return $self->{AUTHUSER};
}
sub Split {
my $self = shift;
if (@_) { $self->{SPLIT} = shift }
return $self->{SPLIT};
}

2384
imapsync2
View file

File diff suppressed because it is too large Load diff

743
t/01_connect_2.99_02.dump
View file

@ -1,743 +0,0 @@
82$ perl -d -I Mail-IMAPClient-2.99_02/lib t/01_connect
Loading DB routines from perl5db.pl version 1.28
Editor support available.
Enter h or `h h' for help, or `man perldebug' for more help.
main::(t/01_connect:6): $imap = Mail::IMAPClient->new(Debug => 1);
DB<1> t
Trace = on
DB<1> c
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:171):
171: { my $class = shift;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:172):
172: my $self =
173: { LastError => "",
174: , Uid => 1
175: , Count => 0
176: , Fast_io => 1
177: , Clear => 5
178: , Maxtemperrors => 'unlimited'
179: , State => Unconnected
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:181):
181: while(@_)
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:182):
182: { my $k = ucfirst lc shift;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:183):
183: $self->{$k} = shift;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:185):
185: bless $self, ref($class)||$class;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:187):
187: if($self->{Supportedflags}) # unpack into case-less HASH
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:192):
192: $self->{Debug_fh} ||= \*STDERR;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:193):
193: select((select($self->{Debug_fh}),$|++)[0]);
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:195):
195: $self->_debug("Using Mail::IMAPClient version $Mail::IMAPClient::VERSION " .
196: "and perl version " . (defined $^V ? join(".",unpack("CCC",$^V)) : "") .
197: " ($])\n") if $self->Debug;
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:40):
40: { my $self = shift;
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:41):
41: return unless $self->Debug;
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:42):
42: my $fh = $self->{Debug_fh} || \*STDERR;
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:43):
43: print $fh @_;
Using Mail::IMAPClient version 2.99_02 and perl version 5.8.8 (5.008008)
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:199):
199: if($self->{Socket}) { $self->Socket($self->{Socket}) }
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:202):
202: $self;
main::(t/01_connect:7): $imap->Debug(1);
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
main::(t/01_connect:8): $imap->Server('louloutte.dyndns.org');
Mail::IMAPClient::CODE(0x850e878)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
main::(t/01_connect:9): $imap->connect() or croak "Error connecting @!";
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:206):
206: { my $self = shift;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:207):
207: %$self = (%$self, @_);
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:209):
209: my $sock = IO::Socket::INET->new
210: ( PeerAddr => $self->Server
211: , PeerPort => ( $self->Port || 'imap(143)')
212: , Timeout => ($self->Timeout || 0)
213: , Proto => 'tcp'
214: , Debug => $self->Debug
215: );
Mail::IMAPClient::CODE(0x850e878)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::CODE(0x850e800)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::CODE(0x850ead0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
IO::Socket::INET::new(/usr/lib/perl/5.8/IO/Socket/INET.pm:30):
30: my $class = shift;
IO::Socket::INET::new(/usr/lib/perl/5.8/IO/Socket/INET.pm:31):
31: unshift(@_, "PeerAddr") if @_ == 1;
IO::Socket::INET::new(/usr/lib/perl/5.8/IO/Socket/INET.pm:32):
32: return $class->SUPER::new(@_);
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:41):
41: my($class,%arg) = @_;
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:42):
42: my $sock = $class->SUPER::new();
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:53):
53: my $class = ref($_[0]) || $_[0] || "IO::Handle";
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:54):
54: @_ == 1 or croak "usage: new $class";
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:55):
55: my $io = gensym;
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:23):
23: my $name = "GEN" . $genseq++;
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:24):
24: my $ref = \*{$genpkg . $name};
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:24):
24: my $ref = \*{$genpkg . $name};
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:25):
25: delete $$genpkg{$name};
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:26):
26: $ref;
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:56):
56: bless $io, $class;
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:44):
44: $sock->autoflush(1);
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:213):
213: my $old = new SelectSaver qualify($_[0], caller);
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:10):
10: @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:11):
11: my $fh = select;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:12):
12: my $self = bless \$fh, $_[0];
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:13):
13: select qualify($_[1], caller) if @_ > 1;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:14):
14: $self;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:214):
214: my $prev = $|;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:215):
215: $| = @_ > 1 ? $_[1] : 1;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:216):
216: $prev;
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:18):
18: my $self = $_[0];
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:19):
19: select $$self;
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:46):
46: ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:46):
46: ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:48):
48: return scalar(%arg) ? $sock->configure(\%arg)
49: : $sock;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:104):
104: my($sock,$arg) = @_;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:105):
105: my($lport,$rport,$laddr,$raddr,$proto,$type);
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:107):
107: $arg->{LocalAddr} = $arg->{LocalHost}
108: if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:110):
110: ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
111: $arg->{LocalPort},
112: $arg->{Proto})
113: or return _error($sock, $!, $@);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:36):
36: my($addr,$port,$proto) = @_;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:37):
37: my $origport = $port;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:38):
38: my @proto = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:39):
39: my @serv = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:41):
41: $port = $1
42: if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:44):
44: if(defined $proto && $proto =~ /\D/) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:45):
45: if(@proto = getprotobyname($proto)) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:46):
46: $proto = $proto[2] || undef;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:54):
54: if(defined $port) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:71):
71: return ($addr || undef,
72: $port || undef,
73: $proto || undef
74: );
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:115):
115: $laddr = defined $laddr ? inet_aton($laddr)
116: : INADDR_ANY;
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:216):
216: my($constname);
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:217):
217: ($constname = $AUTOLOAD) =~ s/.*:://;
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:218):
218: croak "&Socket::constant not defined" if $constname eq 'constant';
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:219):
219: my ($error, $val) = constant($constname);
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:220):
220: if ($error) {
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:224):
224: goto &$AUTOLOAD;
Socket::__ANON__[/usr/lib/perl/5.8/Socket.pm:223](/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:118):
118: return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
119: unless(defined $laddr);
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:121):
121: $arg->{PeerAddr} = $arg->{PeerHost}
122: if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:124):
124: unless(exists $arg->{Listen}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:125):
125: ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
126: $arg->{PeerPort},
127: $proto)
128: or return _error($sock, $!, $@);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:36):
36: my($addr,$port,$proto) = @_;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:37):
37: my $origport = $port;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:38):
38: my @proto = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:39):
39: my @serv = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:41):
41: $port = $1
42: if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:44):
44: if(defined $proto && $proto =~ /\D/) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:54):
54: if(defined $port) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:55):
55: my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:56):
56: my $pnum = ($port =~ m,^(\d+)$,)[0];
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:58):
58: @serv = getservbyname($port, $proto[0] || "")
59: if ($port =~ m,\D,);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:61):
61: $port = $serv[2] || $defport || $pnum;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:62):
62: unless (defined $port) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:67):
67: $proto = (getprotobyname($serv[3]))[2] || undef
68: if @serv && !$proto;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:71):
71: return ($addr || undef,
72: $port || undef,
73: $proto || undef
74: );
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:131):
131: $proto ||= (getprotobyname('tcp'))[2];
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:133):
133: my $pname = (getprotobynumber($proto))[0];
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:134):
134: $type = $arg->{Type} || $socket_type{lc $pname};
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:136):
136: my @raddr = ();
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:138):
138: if(defined $raddr) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:139):
139: @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:92):
92: my($sock,$addr_str, $multi) = @_;
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:93):
93: my @addr;
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:94):
94: if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:97):
97: my $h = inet_aton($addr_str);
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:98):
98: push(@addr, $h) if defined $h;
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:100):
100: @addr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:140):
140: return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
141: unless @raddr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:144):
144: while(1) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:146):
146: $sock->socket(AF_INET, $type, $proto) or
147: return _error($sock, $!, "$!");
Socket::CODE(0x84615a4)(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:77):
77: @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:78):
78: my($sock,$domain,$type,$protocol) = @_;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:80):
80: socket($sock,$domain,$type,$protocol) or
81: return undef;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:83):
83: ${*$sock}{'io_socket_domain'} = $domain;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:83):
83: ${*$sock}{'io_socket_domain'} = $domain;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:84):
84: ${*$sock}{'io_socket_type'} = $type;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:84):
84: ${*$sock}{'io_socket_type'} = $type;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:85):
85: ${*$sock}{'io_socket_proto'} = $protocol;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:85):
85: ${*$sock}{'io_socket_proto'} = $protocol;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:87):
87: $sock;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:149):
149: if (defined $arg->{Blocking}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:154):
154: if ($arg->{Reuse} || $arg->{ReuseAddr}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:159):
159: if ($arg->{ReusePort}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:164):
164: if ($arg->{Broadcast}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:169):
169: if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
Socket::CODE(0x86a3604)(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:174):
174: if(exists $arg->{Listen}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:181):
181: last unless exists($arg->{PeerAddr});
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:183):
183: $raddr = shift @raddr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:185):
185: return _error($sock, $EINVAL, 'Cannot determine remote port')
186: unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:189):
189: unless($type == SOCK_STREAM || defined $raddr);
Socket::CODE(0x8476f40)(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:191):
191: return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
192: unless defined $raddr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:197):
197: undef $@;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:198):
198: if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
IO::Socket::INET::connect(/usr/lib/perl/5.8/IO/Socket/INET.pm:220):
220: @_ == 2 || @_ == 3 or
221: croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
IO::Socket::INET::connect(/usr/lib/perl/5.8/IO/Socket/INET.pm:222):
222: my $sock = shift;
IO::Socket::INET::connect(/usr/lib/perl/5.8/IO/Socket/INET.pm:223):
223: return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:106):
106: @_ == 2 or croak 'usage: $sock->connect(NAME)';
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:107):
107: my $sock = shift;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:108):
108: my $addr = shift;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:109):
109: my $timeout = ${*$sock}{'io_socket_timeout'};
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:109):
109: my $timeout = ${*$sock}{'io_socket_timeout'};
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:110):
110: my $err;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:111):
111: my $blocking;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:113):
113: $blocking = $sock->blocking(0) if $timeout;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:114):
114: if (!connect($sock, $addr)) {
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:137):
137: $sock->blocking(1) if $blocking;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:139):
139: $! = $err if $err;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:141):
141: $err ? undef : $sock;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:200):
200: return $sock;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:217):
217: unless($sock)
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:222):
222: $self->Socket($sock);
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:97):
97: { my ($self, $sock) = @_;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:98):
98: defined $sock
99: or return $self->{Socket};
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:101):
101: delete $self->{_fcntl};
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:103):
103: $self->{_select} = IO::Select->new($_[1]);
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:24):
24: my $self = shift;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:25):
25: my $type = ref($self) || $self;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:27):
27: my $vec = bless [undef,0], $type;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:29):
29: $vec->add(@_)
30: if @_;
IO::Select::add(/usr/lib/perl/5.8/IO/Select.pm:37):
37: shift->_update('add', @_);
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:63):
63: my $vec = shift;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:64):
64: my $add = shift eq 'add';
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:66):
66: my $bits = $vec->[VEC_BITS];
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:67):
67: $bits = '' unless defined $bits;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:69):
69: my $count = 0;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:70):
70: my $f;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:71):
71: foreach $f (@_)
72: {
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:73):
73: my $fn = $vec->_fileno($f);
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:55):
55: my($self, $f) = @_;
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:56):
56: return unless defined $f;
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:57):
57: $f = $f->[0] if ref($f) eq 'ARRAY';
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:58):
58: ($f =~ /^\d+$/) ? $f : fileno($f);
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:74):
74: next unless defined $fn;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:75):
75: my $i = $fn + FIRST_FD;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:76):
76: if ($add) {
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:77):
77: if (defined $vec->[$i]) {
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:81):
81: $vec->[FD_COUNT]++;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:82):
82: vec($bits, $fn, 1) = 1;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:83):
83: $vec->[$i] = $f;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:90):
90: $count++;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:92):
92: $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:93):
93: $count;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:32):
32: $vec;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:223):
223: $self->State(Connected);
Mail::IMAPClient::CODE(0x850e764)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:224):
224: $sock->autoflush(1);
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:213):
213: my $old = new SelectSaver qualify($_[0], caller);
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:10):
10: @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:11):
11: my $fh = select;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:12):
12: my $self = bless \$fh, $_[0];
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:13):
13: select qualify($_[1], caller) if @_ > 1;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:14):
14: $self;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:214):
214: my $prev = $|;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:215):
215: $| = @_ > 1 ? $_[1] : 1;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:216):
216: $prev;
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:18):
18: my $self = $_[0];
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:19):
19: select $$self;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:226):
226: my $code;
227: LINE:
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:228):
228: while(my $output = $self->_read_line)
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1274):
1274: { my ($self, $literal_callback, $output_callback) = @_;
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1276):
1276: my $sh = $self->Socket;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:97):
97: { my ($self, $sock) = @_;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:98):
98: defined $sock
99: or return $self->{Socket};
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1277):
1277: unless($self->IsConnected && $self->Socket)
Mail::IMAPClient::IsConnected(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:2816):
2816: sub IsConnected { shift->State >= Connected }
Mail::IMAPClient::CODE(0x850e764)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:97):
97: { my ($self, $sock) = @_;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:98):
98: defined $sock
99: or return $self->{Socket};
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1278):
1278: { $self->LastError("NO Not connected.");
Mail::IMAPClient::LastError(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:60):
60: { my $self = shift;
Mail::IMAPClient::LastError(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:61):
61: $self->{LastError} = shift if @_;
Mail::IMAPClient::LastError(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:62):
62: $@ = $self->{LastError};
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1279):
1279: return undef;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:238):
238: $code or return undef;
Carp::croak(/usr/share/perl/5.8/Carp.pm:102):
102: sub croak { die shortmess @_ }
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:86):
86: local($@, $!);
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:86):
86: local($@, $!);
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:89):
89: require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:92):
92: my $call_pack = caller();
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:93):
93: local @CARP_NOT = caller();
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:94):
94: shortmess_heavy(@_);
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:177):
177: return longmess_heavy(@_) if $Verbose;
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:178):
178: return @_ if ref($_[0]); # don't break references as exceptions
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:179):
179: my $i = short_error_loc();
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:160):
160: my $cache;
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:161):
161: my $i = 1;
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:162):
162: my $lvl = $CarpLevel;
163: {
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:165):
165: my $caller = caller($i);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:166):
166: return 0 unless defined($caller); # What happened?
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:167):
167: redo if $Internal{$caller};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:168):
168: redo if $CarpInternal{$called};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:165):
165: my $caller = caller($i);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:166):
166: return 0 unless defined($caller); # What happened?
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:167):
167: redo if $Internal{$caller};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:168):
168: redo if $CarpInternal{$called};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:165):
165: my $caller = caller($i);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:166):
166: return 0 unless defined($caller); # What happened?
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:180):
180: if ($i) {
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:184):
184: longmess_heavy(@_);
Carp::longmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:115):
115: return @_ if ref($_[0]); # don't break references as exceptions
Carp::longmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:116):
116: my $i = long_error_loc();
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:91):
91: my $i;
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:92):
92: my $lvl = $CarpLevel;
93: {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:108):
108: redo unless 0 > --$lvl;
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:109):
109: redo if $Internal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:111):
111: return $i - 1;
Carp::longmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:117):
117: return ret_backtrace($i, @_);
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:123):
123: my ($i, @error) = @_;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:124):
124: my $mess;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:125):
125: my $err = join '', @error;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:126):
126: $i++;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:128):
128: my $tid_msg = '';
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:129):
129: if (defined &Thread::tid) {
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:134):
134: my %i = caller_info($i);
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:12):
12: my $i = shift(@_) + 1;
13: package DB;
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:73):
73: my $info = shift;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:74):
74: if (defined($info->{evaltext})) {
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:85):
85: return ($info->{sub} eq '(eval)') ? 'eval {...}' : $info->{sub};
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:39):
39: my $arg = shift;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:40):
40: if (ref($arg)) {
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:45):
45: $arg =~ s/'/\\'/g;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:46):
46: $arg = str_len_trim($arg, $MaxArgLen);
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:190):
190: my $str = shift;
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:191):
191: my $max = shift || 0;
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:192):
192: if (2 < $max and $max < length($str)) {
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:195):
195: return $str;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:49):
49: $arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:55):
55: or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:56):
56: return $arg;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:135):
135: $mess = "$err at $i{file} line $i{line}$tid_msg\n";
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:137):
137: while (my %i = caller_info(++$i)) {
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:12):
12: my $i = shift(@_) + 1;
13: package DB;
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:141):
141: return $mess;
Error connecting @! at t/01_connect line 9
at t/01_connect line 9
Debugged program terminated. Use q to quit or R to restart,
use o inhibit_exit to avoid stopping after program termination,
h q, h R or h o to get additional info.
DB<1> q
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
Config::DESTROY(/usr/lib/perl/5.8/Config.pm:62):
62: sub DESTROY { }
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
83$

6540
t/01_connect_2.99_02.dump_2
View file

File diff suppressed because it is too large Load diff

35
t/02_append_string Executable file
View file

@ -0,0 +1,35 @@
#!/usr/bin/perl -w
use Carp;
use Mail::IMAPClient;
$imap = Mail::IMAPClient->new();
$imap->Debug(0);
$imap->Server('louloutte.dyndns.org');
$imap->connect() or croak "Error connecting $@ !";
$imap->User('MarkOv@est.belle');
$imap->Password('emhj91ly');
$imap->login() or croak "Error login $@ !";
$imap->Uid(1) or croak "Error Uid $@ !";
print "[", $imap->folders, "]\n";
$imap->select('Inbox') or croak "Could not select: $@ !";
my @messages = $imap->messages or croak "Could not get message list: $@ !";
print "[@messages]\n";
$message = $messages[1];
print "[$message]\n";
my $string = $imap->message_string($message);
print $string;
#my $uid = $imap->append_string('INBOX.Trash', $string, '\Seen', "30-Oct-2006 01:34:14 +0100")
# or croak "Could not append_string: $@\n";
my $uid = $imap->append_string('INBOX.Trash', "$string", '\Seen', "")
or croak "Could not append_string: $@\n";
print "$uid\n";
$imap->logout();

53
t/03_message_to_file Executable file
View file

@ -0,0 +1,53 @@
#!/usr/bin/perl -w
use Carp;
use Mail::IMAPClient;
use strict;
my $imap1 = Mail::IMAPClient->new();
$imap1->Debug(0);
$imap1->Server('louloutte.dyndns.org');
$imap1->connect() or croak "Error connecting $@ !";
$imap1->User('MarkOv@est.belle');
$imap1->Password('emhj91ly');
$imap1->login() or croak "Error login $@ !";
$imap1->Uid(1) or croak "Error Uid $@ !";
my $imap2 = Mail::IMAPClient->new();
$imap2->Debug(0);
$imap2->Server('louloutte.dyndns.org');
$imap2->connect() or croak "Error connecting $@ !";
$imap2->User('MarkOv@est.belle');
$imap2->User('titi@est.belle');
$imap2->Password('HUwtEd');
$imap2->login() or croak "Error login $@ !";
$imap2->Uid(1) or croak "Error Uid $@ !";
print "[", $imap1->folders, "]\n";
$imap1->select('Inbox') or croak "Could not select: $@ !";
$imap2->select('Inbox') or croak "Could not select: $@ !";
my @msg_id_2 = $imap2->messages;
my $msg_id_2 = $msg_id_2[1];
my $msg_id_1 = ($imap1->messages)[0];
print "msg_id_1: $msg_id_1\n";
my $string_2 = $imap2->message_string($msg_id_2);
print $string_2;
my $message_file_1 = "tmp_message_to_file_${$}_1";
my $message_file_2 = "tmp_message_to_file_${$}_2";
unlink($message_file_1);
unlink($message_file_2);
$imap2->message_to_file($message_file_2, $msg_id_2) or croak "Could not message_to_file";
$imap1->message_to_file($message_file_1, $msg_id_1) or croak "Could not message_to_file";
$imap1->logout();
$imap2->logout();

91
t/03_message_to_file.dump Normal file
View file

@ -0,0 +1,91 @@
$RCSfile: imapsync,v $ $Revision: 1.244 $ $Date: 2008/02/29 22:43:22 $
Here is a [linux] system (Linux plume 2.6.20.3 #1 Sun Mar 25 06:07:36 CEST 2007 i686)
with perl 5.8.8 and the module Mail::IMAPClient version used here is 3.05
Command line used :
./imapsync --host1 localhost --user1 tata@est.belle --passfile1 /var/tmp/secret.tata --host2 localhost --user2 titi@est.belle --passfile2 /var/tmp/secret.titi --folder INBOX.Trash --syncinternaldates
will try to use CRAM-MD5 authentication on host1
will try to use CRAM-MD5 authentication on host2
From imap server [localhost] port [143] user [tata@est.belle]
To imap server [localhost] port [143] user [titi@est.belle]
Banner : * OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA AUTH=PLAIN CRAM-MD5 CRAM-SHA1 IDLE STARTTLS] Courier-IMAP ready. Copyright 1998-2005 Double Precision, Inc. See COPYING for distribution information.
Host localhost says it has CAPABILITY for AUTHENTICATE CRAM-MD5
Success login on [localhost] with user [tata@est.belle] auth [CRAM-MD5]
Banner : * OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA AUTH=PLAIN CRAM-MD5 CRAM-SHA1 IDLE STARTTLS] Courier-IMAP ready. Copyright 1998-2005 Double Precision, Inc. See COPYING for distribution information.
Host localhost says it has CAPABILITY for AUTHENTICATE CRAM-MD5
Success login on [localhost] with user [titi@est.belle] auth [CRAM-MD5]
From capability : QUOTA STARTTLS NAMESPACE CRAM-SHA1 IDLE AUTH=PLAIN THREAD=ORDEREDSUBJECT SORT UIDPLUS CHILDREN CRAM-MD5 IMAP4REV1 THREAD=REFERENCES
To capability : QUOTA STARTTLS NAMESPACE CRAM-SHA1 IDLE AUTH=PLAIN THREAD=ORDEREDSUBJECT SORT UIDPLUS CHILDREN CRAM-MD5 IMAP4REV1 THREAD=REFERENCES
From state Authenticated
To state Authenticated
From separator and prefix : [.][INBOX.]
To separator and prefix : [.][INBOX.]
++++ Calculating sizes ++++
From Folder [INBOX.Trash] Size: 1012 Messages: 1
Total size: 1012
Total messages: 1
Time : 1 s
++++ Calculating sizes ++++
To Folder [INBOX.Trash] Size: 0 Messages: 0
Total size: 0
Total messages: 0
Time : 0 s
++++ Listing folders ++++
From folders list : [INBOX.Trash]
To folders list : [INBOX.Trash]
++++ Looping on each folder ++++
From Folder [INBOX.Trash]
To Folder [INBOX.Trash]
++++ From [INBOX.Trash] Parse 1 ++++
++++ To [INBOX.Trash] Parse 1 ++++
++++ Verifying [INBOX.Trash] -> [INBOX.Trash] ++++
+ NO msg #2319 [1c8g+RBA0iMRz+/+c3pqXw:1012] in INBOX.Trash
+ Copying msg #2319:1012 to folder INBOX.Trash
AAAmessage_string[FCC: imap://tata%40est.belle@localhost/INBOX/Sent
X-Identity-Key: id2
Message-ID: <45454886.2030307@localhost>
Date: Mon, 30 Oct 2006 01:34:14 +0100
From: TATA <tata@localhost>
X-Mozilla-Draft-Info: internal/draft; vcard=0; receipt=0; uuencode=0
User-Agent: Thunderbird 1.5.0.4 (X11/20060722)
MIME-Version: 1.0
To: Gilles Lamiral <gilles@louloutte.dyndns.org>
Subject: Re: test:ophaifaibequahdu
References: <20030821153335.86EB6FCA2@louloutte.dyndns.org>
In-Reply-To: <20030821153335.86EB6FCA2@louloutte.dyndns.org>
Content-Type: text/html; charset=ISO-8859-1
Content-Transfer-Encoding: 7bit
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
</head>
<body bgcolor="#ffffff" text="#000000">
Gilles Lamiral wrote:
<blockquote cite="mid20030821153335.86EB6FCA2@louloutte.dyndns.org"
type="cite">
<pre wrap="">test:ophaifaibequahdu
</pre>
</blockquote>
<br>
</body>
</html>
]ZZZ
AAA1[]ZZZ
flags from : [\Seen]["30-Oct-2006 01:34:14 +0100"]
Time : 0 s
++++ Statistics ++++
Time : 2 sec
Messages transferred : 0
Messages skipped : 0
Total bytes transferred: 0
Total bytes skipped : 0
Total bytes error : 1012
Detected 1 errors
Please, rate imapsync at http://freshmeat.net/projects/imapsync/
?Happy with this free, open source and gratis GPL software?
Feel free to thank the author by giving him a book:
http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/
(or its paypal account gilles.lamiral@laposte.net)

21
t/04_parse_headers Executable file
View file

@ -0,0 +1,21 @@
#!/usr/bin/perl -w
use Carp;
use Mail::IMAPClient;
$imap = Mail::IMAPClient->new(Debug => 1);
$imap->Debug(1);
$imap->Server('louloutte.dyndns.org');
$imap->connect() or croak "Error connecting @!";
$imap->User('MarkOv@est.belle');
$imap->Password('emhj91ly');
$imap->login();
$imap->select('Inbox');
my @messages = $imap->messages();
my $headers = $imap->parse_headers([@messages]);
$imap->logout();

26
t/05_parse_headers_ssl Executable file
View file

@ -0,0 +1,26 @@
#!/usr/bin/perl -w
use Carp;
use Mail::IMAPClient;
use IO::Socket::SSL;
my $ssl = new IO::Socket::SSL("louloutte.dyndns.org:993");
my $imap = Mail::IMAPClient->new();
$imap->Socket($ssl);
$imap->Debug(1);
$imap->Server('louloutte.dyndns.org');
$imap->connect() or croak "Error connecting @!";
$imap->User('MarkOv@est.belle');
$imap->Password('emhj91ly');
$imap->login();
$imap->select('Inbox');
my @messages = $imap->messages();
my $headers = $imap->parse_headers([@messages]);
$imap->logout();

26
t/06_parse_headers_ssl_titi Executable file
View file

@ -0,0 +1,26 @@
#!/usr/bin/perl -w
use Carp;
use Mail::IMAPClient;
use IO::Socket::SSL;
my $ssl = new IO::Socket::SSL("louloutte.dyndns.org:993");
my $imap = Mail::IMAPClient->new();
$imap->Socket($ssl);
$imap->Debug(1);
$imap->Server('louloutte.dyndns.org');
$imap->connect() or croak "Error connecting @!";
$imap->User('titi@est.belle');
$imap->Password('HUwtEd');
$imap->login();
$imap->select('Inbox');
my @messages = $imap->messages();
my $headers = $imap->parse_headers([@messages]);
$imap->logout();

1230
tests.sh
View file

File diff suppressed because it is too large Load diff