mirror of
https://github.com/imapsync/imapsync.git
synced 2025-06-08 21:54:31 +02:00
1.249
This commit is contained in:
Nick Bebout
parent
32596eb877
commit
1c5b2411f6
61 changed files with 4403 additions and 18975 deletions
9
BUG_IMAPClient_3.xx
Normal file
9
BUG_IMAPClient_3.xx
Normal 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
17
CREDITS
|
|
@ -14,6 +14,23 @@ b) If you can read french, please use the following wishlist :
|
|||
|
||||
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
|
||||
Gave a patch to implement
|
||||
|
|
|
|||
41
ChangeLog
41
ChangeLog
|
|
@ -1,17 +1,50 @@
|
|||
|
||||
RCS file: RCS/imapsync,v
|
||||
Working file: imapsync
|
||||
head: 1.241
|
||||
head: 1.249
|
||||
branch:
|
||||
locks: strict
|
||||
gilles: 1.241
|
||||
access list:
|
||||
symbolic names:
|
||||
keyword substitution: kv
|
||||
total revisions: 241; selected revisions: 241
|
||||
total revisions: 249; selected revisions: 249
|
||||
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
|
||||
Bug fix. --exclude and remove_from_requested_folders()
|
||||
----------------------------
|
||||
|
|
|
|||
40
FAQ
40
FAQ
|
|
@ -3,6 +3,21 @@
|
|||
| 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 ?
|
||||
|
||||
|
|
@ -26,6 +41,20 @@ Q. Where I can find old imapsync releases ?
|
|||
|
||||
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
|
||||
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"
|
||||
|
||||
=======================================================================
|
||||
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,
|
||||
What can I do ?
|
||||
|
|
|
|||
10
INSTALL
10
INSTALL
|
|
@ -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
|
||||
# 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"'
|
||||
|
||||
New Mail-IMAPClient-3.xx doesn't work with imapsync for the moment.
|
||||
|
||||
- Perl Digest::MD5 module.
|
||||
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 :
|
||||
perl -mDigest::MD5 -e 'print $Digest::MD5::VERSION, "\n"'
|
||||
I use 2.20 (debian package)
|
||||
I use 2.36 (debian etch package)
|
||||
|
||||
- Term::ReadKey
|
||||
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 :
|
||||
|
||||
sh tests.sh
|
||||
sh -x tests.sh
|
||||
|
||||
The tests.sh script break on first failure ("set -e" directive).
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -3,6 +3,107 @@
|
|||
All changes from 2.99_01 upward are made by Mark Overmeer. The changes
|
||||
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
|
||||
|
||||
Fixes:
|
||||
|
|
@ -1,9 +1,10 @@
|
|||
--- #YAML:1.0
|
||||
name: Mail-IMAPClient
|
||||
version: 3.00
|
||||
version: 3.05
|
||||
abstract: IMAP4 client library
|
||||
license: ~
|
||||
generated_by: ExtUtils::MakeMaker version 6.36_01
|
||||
author: ~
|
||||
generated_by: ExtUtils::MakeMaker version 6.42
|
||||
distribution_type: module
|
||||
requires:
|
||||
Carp: 0
|
||||
|
|
@ -21,5 +22,5 @@ requires:
|
|||
Test::More: 0
|
||||
Test::Pod: 0
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||
version: 1.2
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.3.html
|
||||
version: 1.3
|
||||
|
|
@ -2,6 +2,8 @@ use ExtUtils::MakeMaker;
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
sub set_test_data();
|
||||
|
||||
WriteMakefile
|
||||
( NAME => 'Mail::IMAPClient',
|
||||
, ABSTRACT => 'IMAP4 client library'
|
||||
|
|
@ -28,8 +30,14 @@ WriteMakefile
|
|||
|
||||
set_test_data();
|
||||
|
||||
sub set_test_data {
|
||||
unless(-f "lib/Mail/IMAPClient.pm")
|
||||
exit 0;
|
||||
|
||||
###
|
||||
### HELPERS
|
||||
###
|
||||
|
||||
sub set_test_data()
|
||||
{ unless(-f "lib/Mail/IMAPClient.pm")
|
||||
{ warn "ERROR: not in installation directory\n";
|
||||
return;
|
||||
}
|
||||
|
|
@ -46,7 +54,7 @@ __INTRO
|
|||
my $yes = prompt "Do you want to run the extended tests? (n/y)";
|
||||
return if $yes !~ /^[Yy](?:[Ee]:[Ss]?)?$/ ;
|
||||
|
||||
unless(open TST,">./test.txt")
|
||||
unless(open TST, '>', "./test.txt")
|
||||
{ warn "ERROR: couldn't open ./test.txt: $!\n";
|
||||
return;
|
||||
}
|
||||
|
|
@ -2,7 +2,7 @@ use warnings;
|
|||
use strict;
|
||||
|
||||
package Mail::IMAPClient;
|
||||
our $VERSION = '3.00';
|
||||
our $VERSION = '3.05';
|
||||
|
||||
use Mail::IMAPClient::MessageSet;
|
||||
|
||||
|
|
@ -18,7 +18,6 @@ use Carp qw(carp);
|
|||
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
|
||||
use Errno qw/EAGAIN/;
|
||||
use List::Util qw/first min max sum/;
|
||||
use Digest::HMAC_MD5 qw/hmac_md5_hex/;
|
||||
use MIME::Base64;
|
||||
|
||||
use constant Unconnected => 0;
|
||||
|
|
@ -57,7 +56,7 @@ BEGIN {
|
|||
# set-up accessors
|
||||
foreach my $datum (
|
||||
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
|
||||
Supportedflags Proxy))
|
||||
{ no strict 'refs';
|
||||
|
|
@ -136,12 +135,13 @@ sub Rfc2060_date
|
|||
sprintf "%02d-%s-%04d", $date[3], $mnt[$date[4]], $date[5]+1900;
|
||||
}
|
||||
|
||||
sub Rfc2060_datetime
|
||||
{ my ($class, $stamp) = @_; # 11-Jan-2000 04:04:04
|
||||
sub Rfc2060_datetime($;$)
|
||||
{ my ($class, $stamp, $zone) = @_; # 11-Jan-2000 04:04:04 +0000
|
||||
$zone ||= '+0000';
|
||||
my @date = gmtime $stamp;
|
||||
|
||||
sprintf "%02d-%s-%04d %02d:%02d:%02d", $date[3], $mnt[$date[4]]
|
||||
, $date[5]+1900, $date[2], $date[1], $date[0];
|
||||
sprintf "%02d-%s-%04d %02d:%02d:%02d %s", $date[3], $mnt[$date[4]]
|
||||
, $date[5]+1900, $date[2], $date[1], $date[0], $zone;
|
||||
}
|
||||
|
||||
# Change CRLF into \n
|
||||
|
|
@ -177,9 +177,12 @@ sub Clear
|
|||
$oldclear;
|
||||
}
|
||||
|
||||
# read-only access to the transaction number:
|
||||
# read-only access to the transaction number
|
||||
sub Transaction { shift->Count };
|
||||
|
||||
# remove doubles from list
|
||||
sub _remove_doubles(@) { my %seen; grep { ! $seen{$_}++ } @_ }
|
||||
|
||||
# the constructor:
|
||||
sub new
|
||||
{ my $class = shift;
|
||||
|
|
@ -311,6 +314,11 @@ sub login
|
|||
if $auth ne 'LOGIN';
|
||||
|
||||
my $passwd = $self->Password;
|
||||
if($passwd =~ m/\W/) # need to quote
|
||||
{ $passwd =~ s/(["\\])/\\$1/g;
|
||||
$passwd = qq{"$passwd"};
|
||||
}
|
||||
|
||||
my $id = $self->User;
|
||||
$id = qq{"$id"} if $id !~ /^".*"$/;
|
||||
|
||||
|
|
@ -321,6 +329,11 @@ sub login
|
|||
$self;
|
||||
}
|
||||
|
||||
sub proxyauth
|
||||
{ my ($self, $user) = @_;
|
||||
$self->_imap_command("PROXYAUTH $user") ? $self->Results : undef;
|
||||
}
|
||||
|
||||
sub separator
|
||||
{ my ($self, $target) = @_;
|
||||
unless(defined $target)
|
||||
|
|
@ -414,10 +427,7 @@ sub subscribed
|
|||
/ix;
|
||||
}
|
||||
|
||||
# for my $f (@folders) { $f =~ s/^\\FOLDER LITERAL:://;}
|
||||
# remove doubles
|
||||
my @clean; my %memory;
|
||||
foreach (@folders) { push @clean, $_ unless $memory{$_}++ }
|
||||
my @clean = _remove_doubles @folders;
|
||||
wantarray ? @clean : \@clean;
|
||||
}
|
||||
|
||||
|
|
@ -597,8 +607,9 @@ sub message_to_file
|
|||
my $string = "$trans ${uid}FETCH $msgs $cmd";
|
||||
|
||||
$self->_record($trans, [0, "INPUT", $string] );
|
||||
|
||||
print "string [$string]\n";
|
||||
my $feedback = $self->_send_line($string);
|
||||
print "feedback [$feedback]\n";
|
||||
unless($feedback)
|
||||
{ $self->LastError("Error sending '$string' to IMAP: $!");
|
||||
return undef;
|
||||
|
|
@ -610,9 +621,11 @@ sub message_to_file
|
|||
until($code)
|
||||
{ my $output = $self->_read_line($handle)
|
||||
or return undef;
|
||||
|
||||
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);
|
||||
|
||||
$code = $o->[DATA] =~ /^$trans\s+(OK|BAD|NO)/mi ? $1 : undef;
|
||||
|
|
@ -1099,8 +1112,7 @@ sub _imap_command
|
|||
}
|
||||
|
||||
sub _imap_uid_command
|
||||
{ my $self = shift;
|
||||
my $cmd = shift;
|
||||
{ my ($self, $cmd) = (shift, shift);
|
||||
my $args = @_ ? join(" ", '', @_) : '';
|
||||
my $uid = $self->Uid ? 'UID ' : '';
|
||||
$self->_imap_command("$uid$cmd$args");
|
||||
|
|
@ -1256,7 +1268,7 @@ sub _send_line
|
|||
|
||||
# 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
|
||||
# be a filehandle, coderef, or undef.
|
||||
#
|
||||
|
|
@ -1284,8 +1296,8 @@ sub _read_line
|
|||
my $fast_io = $self->Fast_io;
|
||||
|
||||
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:
|
||||
)
|
||||
{ my $transno = $self->Transaction;
|
||||
|
|
@ -1328,19 +1340,17 @@ sub _read_line
|
|||
|
||||
while($iBuffer =~ s/^(.*?\r?\n)//) # consume line
|
||||
{ my $current_line = $1;
|
||||
|
||||
# This part handles IMAP "Literals",
|
||||
# which according to rfc2060 look something like this:
|
||||
# [tag]|* BLAH BLAH {nnn}\r\n
|
||||
# [nnn bytes of literally transmitted stuff]
|
||||
# [part of line that follows literal data]\r\n
|
||||
|
||||
if($current_line !~ s/\s*\{(\d+)\}\r\n$//)
|
||||
{ push @$oBuffer, [$index++, "OUTPUT" , $current_line];
|
||||
if($current_line !~ s/\s*\{(\d+)\}\r?\n$//)
|
||||
{ push @$oBuffer, [$index++, 'OUTPUT' , $current_line];
|
||||
next;
|
||||
}
|
||||
|
||||
push @$oBuffer, [$index++, 'OUTPUT', $current_line];
|
||||
|
||||
## 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;
|
||||
|
||||
|
|
@ -1349,7 +1359,15 @@ sub _read_line
|
|||
"retrieve from the " . length($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)
|
||||
{ if($timeout)
|
||||
|
|
@ -1366,7 +1384,7 @@ sub _read_line
|
|||
{ 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};
|
||||
|
||||
my $ret = $self->_sysread($socket, \$litstring
|
||||
|
|
@ -1390,12 +1408,7 @@ sub _read_line
|
|||
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) { ; }
|
||||
elsif(UNIVERSAL::isa($literal_callback, 'GLOB'))
|
||||
|
|
@ -1411,31 +1424,8 @@ sub _read_line
|
|||
. "invalid callback; must be a filehandle or CODE");
|
||||
}
|
||||
|
||||
$self->Fast_io($fast_io) if $fast_io;
|
||||
|
||||
# Now let's make sure there are no IMAP server output lines
|
||||
# (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string
|
||||
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;
|
||||
$self->Fast_io($fast_io) if $fast_io; # ???
|
||||
push @$oBuffer, [$index++, 'LITERAL', $litstring];
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1518,47 +1508,46 @@ sub logout
|
|||
$self;
|
||||
}
|
||||
|
||||
sub folders
|
||||
sub folders($)
|
||||
{ my ($self, $what) = @_;
|
||||
|
||||
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 @list = $self->list(undef,($what ? $what.$self->separator($what)."*" : undef ) );
|
||||
push @list, $self->list(undef, $what)
|
||||
if $what && $self->exists($what);
|
||||
|
||||
for(my $m = 0; $m < scalar(@list); $m++ )
|
||||
for(my $m = 0; $m < @list; $m++ )
|
||||
{ if($list[$m] && $list[$m] !~ /\r\n$/ )
|
||||
{ $self->_debug("folders: concatenating $list[$m] and $list[$m+1]");
|
||||
$list[$m] .= $list[$m+1];
|
||||
$list[$m+1] = "";
|
||||
$list[$m] .= "\r\n" unless $list[$m] =~ /\r\n$/;
|
||||
splice @list, $m+1, 1;
|
||||
}
|
||||
|
||||
$list[$m] =~ / ^\*\s+LIST # * LIST
|
||||
\s+\([^\)]*\)\s+ # (Flags)
|
||||
(?:"[^"]*"|NIL)\s+ # "delimiter" or NIL
|
||||
(?:"([^"]*)"|(.*))\r\n$ # Name or "Folder name"
|
||||
$list[$m] =~ / ^\* \s+ LIST \s+ \([^\)]*\) \s+ # * LIST (Flags)
|
||||
(?:\" [^"]* \" | NIL ) \s+ # "delimiter" or NIL
|
||||
(?:\"([^"]*)\" | (\S+)) \s*$ # "name" or name
|
||||
/ix
|
||||
or next;
|
||||
|
||||
my $folder = $1 || $2;
|
||||
$folder = qq("$folder")
|
||||
if $1 && !$self->exists($folder);
|
||||
|
||||
push @folders, $folder
|
||||
push @folders, $1 || $2;
|
||||
}
|
||||
|
||||
my (@clean, %memory);
|
||||
foreach my $f (@folders) { push @clean, $f unless $memory{$f}++ }
|
||||
my @clean = _remove_doubles @folders;
|
||||
$self->{Folders} = \@clean unless $what;
|
||||
|
||||
wantarray ? @clean : \@clean;
|
||||
}
|
||||
|
||||
|
||||
sub exists
|
||||
{ my ($self, $folder) = @_;
|
||||
$self->status($folder) ? $self : undef;
|
||||
|
|
@ -1580,11 +1569,12 @@ sub get_bodystructure
|
|||
}
|
||||
else
|
||||
{ $self->_debug("get_bodystructure: reassembling original response");
|
||||
my $start = 0;
|
||||
foreach my $o ($self->Results)
|
||||
my $started = 0;
|
||||
my $output = '';
|
||||
foreach my $o ($self->_transaction)
|
||||
{ next unless $self->_is_output_or_literal($o);
|
||||
next unless $start or
|
||||
$o->[DATA] =~ /BODYSTRUCTURE \(/i and ++$start; # Hi, vi! ;-)
|
||||
$started++ if $o->[DATA] =~ /BODYSTRUCTURE \(/i; ; # Hi, vi! ;-)
|
||||
$started or next;
|
||||
|
||||
if(length $output && $self->_is_literal($o) )
|
||||
{ my $data = $o->[DATA];
|
||||
|
|
@ -1612,24 +1602,30 @@ sub get_envelope
|
|||
return undef;
|
||||
}
|
||||
|
||||
my @out = $self->fetch($msg,"ENVELOPE");
|
||||
my @out = $self->fetch($msg, 'ENVELOPE');
|
||||
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$/ )
|
||||
{ eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) };
|
||||
}
|
||||
else
|
||||
{ $self->_debug("get_envelope: reassembling original response");
|
||||
my $start = 0;
|
||||
foreach my $o ($self->Results)
|
||||
my $started = 0;
|
||||
$output = '';
|
||||
foreach my $o ($self->_transaction)
|
||||
{ next unless $self->_is_output_or_literal($o);
|
||||
$self->_debug("o->[DATA] is $o->[DATA]");
|
||||
|
||||
next unless $start or
|
||||
$o->[DATA] =~ /ENVELOPE \(/i and ++$start;
|
||||
# Hi, vi! ;-)
|
||||
$started++ if $o->[DATA] =~ /ENVELOPE \(/i; # Hi, vi! ;-)
|
||||
$started or next;
|
||||
|
||||
if ( length($output) and $self->_is_literal($o) ) {
|
||||
if(length($output) && $self->_is_literal($o) ) {
|
||||
my $data = $o->[DATA];
|
||||
$data =~ s/"/\\"/g;
|
||||
$data =~ s/\(/\\\(/g;
|
||||
|
|
@ -1658,7 +1654,7 @@ sub fetch
|
|||
: $what;
|
||||
|
||||
$self->_imap_uid_command(FETCH => $take, @_)
|
||||
or return ();
|
||||
or return;
|
||||
|
||||
wantarray ? $self->History : $self->Results;
|
||||
}
|
||||
|
|
@ -1735,46 +1731,29 @@ sub store
|
|||
wantarray ? $self->History : $self->Results;
|
||||
}
|
||||
|
||||
sub subscribe
|
||||
{ my ($self, @a) = @_;
|
||||
sub _imap_folder_command($$)
|
||||
{ my ($self, $command) = (shift, shift);
|
||||
delete $self->{Folders};
|
||||
$a[-1] = $self->Massage($a[-1]) if @a;
|
||||
$self->_imap_uid_command(SUBSCRIBE => @a)
|
||||
or return undef;
|
||||
my $folder = $self->Massage(shift);
|
||||
|
||||
$self->_imap_command("$command $folder")
|
||||
or return;
|
||||
|
||||
wantarray ? $self->History : $self->Results;
|
||||
}
|
||||
|
||||
sub delete
|
||||
{ my ($self, @a) = @_;
|
||||
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 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 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;
|
||||
}
|
||||
|
||||
sub create
|
||||
{ my ($self, @a) = @_;
|
||||
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;
|
||||
}
|
||||
# rfc2086
|
||||
sub myrights($) { $_[0]->_imap_folder_command(MYRIGHTS => $_[1]) }
|
||||
|
||||
sub close
|
||||
{ my $self = shift;
|
||||
delete $self->{Folders};
|
||||
$self->_imap_uid_command('CLOSE')
|
||||
$self->_imap_command('CLOSE')
|
||||
or return undef;
|
||||
wantarray ? $self->History : $self->Results;
|
||||
}
|
||||
|
|
@ -1817,10 +1796,10 @@ sub rename
|
|||
|
||||
sub status
|
||||
{ my ($self, $folder) = (shift, shift);
|
||||
my $which = @_ ? join(" ", @_) : 'MESSAGES';
|
||||
|
||||
defined $folder or return;
|
||||
|
||||
my $which = @_ ? join(" ", @_) : 'MESSAGES';
|
||||
|
||||
my $box = $self->Massage($folder);
|
||||
$self->_imap_command("STATUS $box ($which)")
|
||||
or return undef;
|
||||
|
|
@ -1839,21 +1818,21 @@ sub flags
|
|||
|
||||
# Send command
|
||||
$self->fetch($msg, "FLAGS")
|
||||
or return undef;
|
||||
or return;
|
||||
|
||||
my $u_f = $self->Uid;
|
||||
my $flagset = {};
|
||||
|
||||
# Parse results, setting entry in result hash for each line
|
||||
foreach my $resultline ($self->Results)
|
||||
{ $self->_debug("flags: line = '$resultline'");
|
||||
if ( $resultline =~
|
||||
foreach my $line ($self->Results)
|
||||
{ $self->_debug("flags: line = '$line'");
|
||||
if ( $line =~
|
||||
/\* \s+ (\d+) \s+ FETCH \s+ # * nnn FETCH
|
||||
\( # open-paren
|
||||
(?:\s?UID\s(\d+)\s?)? # optional: UID nnn <space>
|
||||
FLAGS\s?\((.*)\)\s? # FLAGS (\Flag1 \Flag2) <space>
|
||||
(?:\s?UID\s(\d+))? # optional: UID nnn
|
||||
\) # close-paren
|
||||
\(
|
||||
(?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn <space>
|
||||
FLAGS \s* \( (.*?) \) \s* # FLAGS (\Flag1 \Flag2) <space>
|
||||
(?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn
|
||||
\)
|
||||
/x
|
||||
)
|
||||
{ my $mailid = $u_f ? ($2||$4) : $1;
|
||||
|
|
@ -1883,16 +1862,6 @@ sub supported_flags(@)
|
|||
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
|
||||
{ my ($self, $msgspec, @fields) = @_;
|
||||
my $fields = join ' ', @fields;
|
||||
|
|
@ -1905,25 +1874,36 @@ sub parse_headers
|
|||
my @raw = $self->fetch($string)
|
||||
or return undef;
|
||||
|
||||
my %headers; # HASH from message ids to headers
|
||||
my $h; # HASH of fields for current msgid
|
||||
my $field; # previous field name
|
||||
my %headers; # message ids to headers
|
||||
my $h; # fields for current msgid
|
||||
my $field; # previous field name, for unfolding
|
||||
my %fieldmap = map { ( lc($_) => $_ ) } @fields;
|
||||
my $msgid;
|
||||
|
||||
foreach my $header (map {split /\r?\n/} @raw)
|
||||
{
|
||||
if($header =~ s/^(?:\*|UID) \s+ (\d+) \s+ FETCH \s+
|
||||
\( .*? BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix)
|
||||
{ # little problem: Windows2003 has UID as body, not in header
|
||||
if($header =~ s/^\* \s+ (\d+) \s+ FETCH \s+
|
||||
\( (.*?) BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix)
|
||||
{ # 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
|
||||
if($header =~ /^\)/) # end of this message
|
||||
{ undef $h; # inbetween headers
|
||||
next;
|
||||
}
|
||||
elsif(!$msgid && $header =~ /^\s*UID\s+(\d+)\s*\)/)
|
||||
{ $headers{$1} = $h; # finally found msgid, win2003
|
||||
undef $h;
|
||||
next;
|
||||
}
|
||||
|
||||
unless(defined $h)
|
||||
{ last if $header =~ / OK /i;
|
||||
|
|
@ -2067,7 +2047,7 @@ sub search
|
|||
foreach ($self->History)
|
||||
{ chomp;
|
||||
s/\r\n?/ /g;
|
||||
s/^\*\s+SEARCH\s+(?=.*\d.*)// or next;
|
||||
s/^\*\s+SEARCH\s+(?=.*?\d)// or next;
|
||||
push @hits, grep /^\d+$/, split;
|
||||
}
|
||||
|
||||
|
|
@ -2209,7 +2189,7 @@ sub namespace {
|
|||
return undef;
|
||||
}
|
||||
|
||||
my $got = $self->_imap_command("NAMESPACE") or return ();
|
||||
my $got = $self->_imap_command("NAMESPACE") or return;
|
||||
my @namespaces = map { /^\* NAMESPACE (.*)/ ? $1 : () }
|
||||
$got->Results;
|
||||
|
||||
|
|
@ -2254,43 +2234,47 @@ sub is_parent
|
|||
|
||||
for(my $m = 0; $m < @$list; $m++)
|
||||
{ return undef
|
||||
if $list->[$m] =~ /NoInferior/i;
|
||||
if $list->[$m] =~ /\bNoInferior\b/i;
|
||||
|
||||
if($list->[$m] =~ s/(\{\d+\})\r\n$// )
|
||||
{ $list->[$m] .= $list->[$m+1];
|
||||
$list->[$m+1] = "";
|
||||
splice @$list, $m+1, 1;
|
||||
}
|
||||
|
||||
$line = $list->[$m]
|
||||
if $list->[$m] =~
|
||||
/ ^\*\s+LIST # * LIST
|
||||
\s+\([^\)]*\)\s+ # (Flags)
|
||||
"[^"]*"\s+ # "delimiter"
|
||||
(?:"([^"]*)"|(.*))\r\n$ # Name or "Folder name"
|
||||
/^ \* \s+ LIST \s+ # * LIST
|
||||
\([^\)]*\) \s+ # (Flags)
|
||||
\"[^"]*\" \s+ # "delimiter"
|
||||
(?:\"[^"]*\"|\S+) \s*$ # Name or "Folder name"
|
||||
/x;
|
||||
}
|
||||
|
||||
unless(length $line)
|
||||
{ $self->_debug("Warning: separator method found no correct o/p in:\n\t".
|
||||
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);
|
||||
$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;
|
||||
return scalar grep {$lead eq substr($_, 0, $len)} $self->folders;
|
||||
}
|
||||
|
||||
0; # ???
|
||||
scalar grep {$lead eq substr($_, 0, $len)} $self->folders;
|
||||
}
|
||||
|
||||
sub selectable
|
||||
{ my ($self, $f) = @_;
|
||||
not grep /NoSelect/i, $self->list("", $f);
|
||||
not( grep /NoSelect/i, $self->list("", $f) );
|
||||
}
|
||||
|
||||
sub append
|
||||
|
|
@ -2521,7 +2505,9 @@ sub authenticate
|
|||
{ my $output = $self->_read_line or return undef;
|
||||
foreach my $o (@$output)
|
||||
{ $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/)
|
||||
{ $self->State(Unconnected);
|
||||
|
|
@ -2536,9 +2522,36 @@ sub authenticate
|
|||
if($scheme eq 'CRAM-MD5')
|
||||
{ $response ||= sub
|
||||
{ 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);
|
||||
};
|
||||
}
|
||||
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
|
||||
{ $response ||= sub
|
||||
|
|
@ -2562,12 +2575,12 @@ sub authenticate
|
|||
return undef;
|
||||
}
|
||||
|
||||
undef $code = $scheme eq 'PLAIN' ? 'OK' : undef;
|
||||
undef $code;
|
||||
until($code)
|
||||
{ my $output = $self->_read_line or return undef;
|
||||
foreach my $o (@$output)
|
||||
{ $self->_record($count, $o);
|
||||
$code = $o->[DATA] =~ /^\+\s+(.*)$/ ? $1 : undef;
|
||||
$code = $o->[DATA] =~ /^\+\s+(.*?)\s*$/ ? $1 : undef;
|
||||
|
||||
if($code)
|
||||
{ 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];
|
||||
}
|
||||
|
||||
sub Quote {
|
||||
my ($class, $arg) = @_;
|
||||
return $class->Massage($arg, NonFolderArg);
|
||||
}
|
||||
sub Quote($) { $_[0]->Massage($_[1], NonFolderArg) }
|
||||
|
||||
sub Massage
|
||||
{ my ($self, $arg, $notFolder) = @_;
|
||||
$arg or return;
|
||||
my $escaped_arg = $arg;
|
||||
$escaped_arg =~ s/"/\\"/g;
|
||||
$arg = substr($arg, 1, length($arg)-2) if $arg =~ /^".*"$/
|
||||
&& ! ( $notFolder || $self->status(qq("$escaped_arg"), "MESSAGES"));
|
||||
sub Massage($;$)
|
||||
{ my ($self, $name, $notFolder) = @_;
|
||||
$name =~ s/^\"(.*)\"$/$1/ unless $notFolder;
|
||||
|
||||
if($arg =~ /["\\]/) { $arg = "{".length($arg)."}\r\n$arg" }
|
||||
elsif($arg =~ /[\s{}()]/) { $arg = qq("$arg") }
|
||||
|
||||
$arg;
|
||||
$name =~ /["\\]/ ? "{".length($name)."}\r\n$name"
|
||||
: $name =~ /[\s{}()]/ ? qq["$name"]
|
||||
: $name;
|
||||
}
|
||||
|
||||
sub unseen_count
|
||||
|
|
@ -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:
|
||||
LOGIN for plain text authentication and AUTHENTICATE for more secure
|
||||
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
|
||||
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
|
||||
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
|
||||
|
||||
The I<Authcallback> parameter, if set, should contain a pointer
|
||||
to a subroutine. The L<login> method will use this as the callback
|
||||
argument to the B<authenticate> method if the I<Authmechanism> and
|
||||
I<Authcallback> parameters are both set. If you set I<Authmechanism>
|
||||
but not I<Authcallback> then the default callback for your mechanism
|
||||
will be used. CRAM-MD5, PLAIN (SASL), and NTLM authentication mechanisms
|
||||
have a default callback; in every other case not supplying the callback
|
||||
results in an error.
|
||||
but not I<Authcallback> then the default callback for your mechanism will
|
||||
be used. All supported authentication mechanisms have a default callback;
|
||||
in every other case not supplying the callback results in an error.
|
||||
|
||||
Most advanced authentication mechanisms require a challenge-response
|
||||
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,
|
||||
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
|
||||
|
||||
Example:
|
||||
|
|
@ -778,9 +801,8 @@ override parameter settings.
|
|||
|
||||
If you do not specify a second argument and you have not set the
|
||||
I<Authcallback> parameter, then the first argument must be
|
||||
one of the authentication mechanisms for which B<Mail::IMAPClient> has
|
||||
built in support. Currently there is only built in support for CRAM-MD5,
|
||||
but I hope to add more in future releases.
|
||||
one of the authentication mechanisms for which B<Mail::IMAPClient>
|
||||
has built in support.
|
||||
|
||||
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
|
||||
|
|
@ -1399,7 +1421,7 @@ B<has_capability>.
|
|||
Example:
|
||||
|
||||
my $idle = $imap->idle or warn "Couldn't idle: $@\n";
|
||||
&goDoOtherThings;
|
||||
goDoOtherThings();
|
||||
$imap->done($idle) or warn "Error from done: $@\n";
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
|
|
@ -3344,7 +3372,7 @@ Example:
|
|||
|
||||
=head2 Socket
|
||||
|
||||
B<PLEASE NOT>
|
||||
B<PLEASE NOTE>
|
||||
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>.
|
||||
|
||||
|
|
@ -2,8 +2,6 @@ use warnings;
|
|||
use strict;
|
||||
|
||||
package Mail::IMAPClient::BodyStructure;
|
||||
our $VERSION = '0.0.4';
|
||||
|
||||
use Mail::IMAPClient::BodyStructure::Parse;
|
||||
|
||||
# my has file scope, not limited to package!
|
||||
|
|
@ -177,7 +175,7 @@ BEGIN
|
|||
|
||||
|
||||
package Mail::IMAPClient::BodyStructure::Address;
|
||||
@ISA = qw/Mail::IMAPClient::BodyStructure/;
|
||||
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
|
||||
|
||||
for my $datum ( qw(personalname mailboxname hostname sourcename) )
|
||||
{ no strict 'refs';
|
||||
185
Mail-IMAPClient-3.05/lib/Mail/IMAPClient/BodyStructure/Parse.grammar
Executable file
185
Mail-IMAPClient-3.05/lib/Mail/IMAPClient/BodyStructure/Parse.grammar
Executable 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} }
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -5,7 +5,7 @@ package Mail::IMAPClient::MessageSet;
|
|||
|
||||
=head1 NAME
|
||||
|
||||
Mail::IMAPClient::MessageSet -- ranges of message sequence nummers
|
||||
Mail::IMAPClient::MessageSet - ranges of message sequence nummers
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -26,6 +26,7 @@ sub new
|
|||
sub str { overload::StrVal( ${$_[0]} ) }
|
||||
|
||||
sub _unfold_range($)
|
||||
# { my $x = shift; return if $x =~ m/[^0-9,:]$/; $x =~ s/\:/../g; eval $x; }
|
||||
{ map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ }
|
||||
split /\,/, shift;
|
||||
}
|
||||
|
|
@ -33,7 +34,7 @@ sub _unfold_range($)
|
|||
sub rem
|
||||
{ my $self = shift;
|
||||
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
|
||||
$$self = $self->range(map {$delete{$_} ? () : $_ } $self->unfold);
|
||||
$$self = $self->range(grep {not $delete{$_}} $self->unfold);
|
||||
$self;
|
||||
}
|
||||
|
||||
|
|
@ -820,7 +820,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
'hashname' => '__STRING1__',
|
||||
'description' => '\'(\'',
|
||||
'lookahead' => 0,
|
||||
'line' => 274
|
||||
'line' => 177
|
||||
}, 'Parse::RecDescent::InterpLit' ),
|
||||
bless( {
|
||||
'subrule' => 'threadmember',
|
||||
|
|
@ -831,19 +831,19 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
'matchrule' => 0,
|
||||
'repspec' => 's',
|
||||
'lookahead' => 0,
|
||||
'line' => 274
|
||||
'line' => 177
|
||||
}, 'Parse::RecDescent::Repetition' ),
|
||||
bless( {
|
||||
'pattern' => ')',
|
||||
'hashname' => '__STRING2__',
|
||||
'description' => '\')\'',
|
||||
'lookahead' => 0,
|
||||
'line' => 274
|
||||
'line' => 177
|
||||
}, 'Parse::RecDescent::InterpLit' ),
|
||||
bless( {
|
||||
'hashname' => '__ACTION1__',
|
||||
'lookahead' => 0,
|
||||
'line' => 275,
|
||||
'line' => 178,
|
||||
'code' => '{
|
||||
$return = $item{\'threadmember(s)\'}||undef;
|
||||
}'
|
||||
|
|
@ -854,7 +854,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
],
|
||||
'name' => 'thread',
|
||||
'vars' => '',
|
||||
'line' => 274
|
||||
'line' => 177
|
||||
}, 'Parse::RecDescent::Rule' ),
|
||||
'NUMBER' => bless( {
|
||||
'impcount' => 0,
|
||||
|
|
@ -877,7 +877,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
'description' => '/\\\\d+/',
|
||||
'lookahead' => 0,
|
||||
'rdelim' => '/',
|
||||
'line' => 267,
|
||||
'line' => 170,
|
||||
'mod' => '',
|
||||
'ldelim' => '/'
|
||||
}, 'Parse::RecDescent::Token' )
|
||||
|
|
@ -887,7 +887,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
],
|
||||
'name' => 'NUMBER',
|
||||
'vars' => '',
|
||||
'line' => 265
|
||||
'line' => 168
|
||||
}, 'Parse::RecDescent::Rule' ),
|
||||
'start' => bless( {
|
||||
'impcount' => 0,
|
||||
|
|
@ -912,7 +912,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
'description' => '/^\\\\* THREAD /i',
|
||||
'lookahead' => 0,
|
||||
'rdelim' => '/',
|
||||
'line' => 280,
|
||||
'line' => 183,
|
||||
'mod' => 'i',
|
||||
'ldelim' => '/'
|
||||
}, 'Parse::RecDescent::Token' ),
|
||||
|
|
@ -925,12 +925,12 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
'matchrule' => 0,
|
||||
'repspec' => 's?',
|
||||
'lookahead' => 0,
|
||||
'line' => 280
|
||||
'line' => 183
|
||||
}, 'Parse::RecDescent::Repetition' ),
|
||||
bless( {
|
||||
'hashname' => '__ACTION1__',
|
||||
'lookahead' => 0,
|
||||
'line' => 280,
|
||||
'line' => 183,
|
||||
'code' => '{
|
||||
$return=$item{\'thread(s?)\'}||undef;
|
||||
}'
|
||||
|
|
@ -941,7 +941,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
],
|
||||
'name' => 'start',
|
||||
'vars' => '',
|
||||
'line' => 279
|
||||
'line' => 182
|
||||
}, 'Parse::RecDescent::Rule' ),
|
||||
'threadmember' => bless( {
|
||||
'impcount' => 0,
|
||||
|
|
@ -967,12 +967,12 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
'implicit' => undef,
|
||||
'argcode' => undef,
|
||||
'lookahead' => 0,
|
||||
'line' => 271
|
||||
'line' => 174
|
||||
}, 'Parse::RecDescent::Subrule' ),
|
||||
bless( {
|
||||
'hashname' => '__ACTION1__',
|
||||
'lookahead' => 0,
|
||||
'line' => 271,
|
||||
'line' => 174,
|
||||
'code' => '{ $return = $item{NUMBER} ; }'
|
||||
}, 'Parse::RecDescent::Action' )
|
||||
],
|
||||
|
|
@ -993,21 +993,21 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
|
|||
'implicit' => undef,
|
||||
'argcode' => undef,
|
||||
'lookahead' => 0,
|
||||
'line' => 272
|
||||
'line' => 175
|
||||
}, 'Parse::RecDescent::Subrule' ),
|
||||
bless( {
|
||||
'hashname' => '__ACTION1__',
|
||||
'lookahead' => 0,
|
||||
'line' => 272,
|
||||
'line' => 175,
|
||||
'code' => '{ $return = $item{thread} ; }'
|
||||
}, 'Parse::RecDescent::Action' )
|
||||
],
|
||||
'line' => 271
|
||||
'line' => 174
|
||||
}, 'Parse::RecDescent::Production' )
|
||||
],
|
||||
'name' => 'threadmember',
|
||||
'vars' => '',
|
||||
'line' => 269
|
||||
'line' => 172
|
||||
}, 'Parse::RecDescent::Rule' )
|
||||
}
|
||||
}, 'Parse::RecDescent' );
|
||||
|
|
@ -2,8 +2,12 @@
|
|||
|
||||
use warnings;
|
||||
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');
|
||||
|
||||
|
|
@ -16,8 +20,9 @@ ok(defined $bsobj, 'parsed first');
|
|||
is($bsobj->bodytype, 'TEXT', 'bodytype');
|
||||
is($bsobj->bodysubtype, 'PLAIN', 'bodysubtype');
|
||||
|
||||
|
||||
my $bs2 = <<'END_OF_BS2';
|
||||
(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL))
|
||||
(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL))
|
||||
END_OF_BS2
|
||||
|
||||
$bsobj = Mail::IMAPClient::BodyStructure->new($bs2) ;
|
||||
|
|
@ -26,4 +31,23 @@ is($bsobj->bodytype, 'MULTIPART', 'bodytype');
|
|||
is($bsobj->bodysubtype, 'MIXED', 'bodysubtype');
|
||||
|
||||
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');
|
||||
4
README
4
README
|
|
@ -3,7 +3,7 @@ NAME
|
|||
Synchronise mailboxes between two imap servers. Good at IMAP migration.
|
||||
More than 32 different IMAP server softwares supported with success.
|
||||
|
||||
$Revision: 1.241 $
|
||||
$Revision: 1.249 $
|
||||
|
||||
INSTALL
|
||||
imapsync works fine under any Unix OS with perl.
|
||||
|
|
@ -333,5 +333,5 @@ SIMILAR SOFTWARES
|
|||
|
||||
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
7
TODO
|
|
@ -1,6 +1,13 @@
|
|||
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 --tmpfile option.
|
||||
|
|
|
|||
2
VERSION
2
VERSION
|
|
@ -1 +1 @@
|
|||
1.241
|
||||
1.249
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -3,10 +3,10 @@
|
|||
#RELEASE_FOCUS="Initial freshmeat announcement"
|
||||
#RELEASE_FOCUS="Documentation"
|
||||
#RELEASE_FOCUS="Code cleanup"
|
||||
#RELEASE_FOCUS="Minor feature enhancements"
|
||||
RELEASE_FOCUS="Minor feature enhancements"
|
||||
#RELEASE_FOCUS="Major feature enhancements"
|
||||
#RELEASE_FOCUS="Minor bugfixes"
|
||||
RELEASE_FOCUS="Major bugfixes"
|
||||
#RELEASE_FOCUS="Major bugfixes"
|
||||
#RELEASE_FOCUS="Minor 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: Allow long usernames with md5 authentification."
|
||||
TEXT_BODY="Bug fixes:
|
||||
- Avoid infinite loop with bad hostname.
|
||||
- Works without patch on MSWin32 systems.
|
||||
- Updated help message : avoid --authuser and --authmech1 SOMETHING
|
||||
- Uppercase --authmech input.
|
||||
- Date with minus %d-%b-%Y (RFC compliant)
|
||||
- Added Date::Manip dependency.
|
||||
- Added Dovecot 1.0.0 [dest] success.
|
||||
- Added Deerfield VisNetic MailServer 5.8.6 [from] success.
|
||||
- Turn to --nofastio1 --nofastio2 by default.
|
||||
- Flags \Recent can be uppercase \RECENT now.
|
||||
- Turned on --syncinternaldates option by default.
|
||||
- Set timezone TZ=GMT if no timezone is set (MSWindows "bug").
|
||||
- Ignore message when it has no header.
|
||||
- Added message id in output warning when no header found.
|
||||
- Removed public freshmeat annoucement access since 1.241 was not mine (no problem) and not correct (problem).
|
||||
- Can run with IMAPClient_3.x.x without redefine any function (but 3.x.x is still buggy and to be avoided)
|
||||
- Started unit tests.
|
||||
- Many thanks to the freshmeat folk that correct my bad and poorly English !
|
||||
"
|
||||
|
|
|
|||
264
imapsync
264
imapsync
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl -w
|
||||
#!/usr/bin/perl
|
||||
|
||||
=pod
|
||||
|
||||
|
|
@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good
|
|||
at IMAP migration. More than 32 different IMAP server softwares
|
||||
supported with success.
|
||||
|
||||
$Revision: 1.241 $
|
||||
$Revision: 1.249 $
|
||||
|
||||
=head1 INSTALL
|
||||
|
||||
|
|
@ -387,15 +387,17 @@ Entries for imapsync:
|
|||
|
||||
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
|
||||
|
||||
|
||||
use warnings;
|
||||
++$|;
|
||||
use strict;
|
||||
use Carp;
|
||||
use Getopt::Long;
|
||||
use Mail::IMAPClient;
|
||||
use Digest::MD5 qw(md5_base64);
|
||||
|
|
@ -450,14 +452,14 @@ my(
|
|||
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+)/;
|
||||
$VERSION = ($1) ? $1 : "UNKNOWN";
|
||||
|
||||
my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION;
|
||||
|
||||
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;
|
||||
|
|
@ -467,15 +469,16 @@ $mess_trans = $mess_skipped = $mess_skipped_dry = 0;
|
|||
|
||||
|
||||
sub check_lib_version {
|
||||
if ($VERSION_IMAPClient =~ m/(\d+)\.(\d+)\.(\d+)/) {
|
||||
$debug and print "VERSION_IMAPClient $1 $2 $3\n";
|
||||
#my($major,$minor,$sub) = ($1, $2, $3);
|
||||
|
||||
return(1) if($VERSION_IMAPClient eq '2.2.9');
|
||||
|
||||
if ($VERSION_IMAPClient eq '2.2.9') {
|
||||
override_imapclient();
|
||||
return(1);
|
||||
}
|
||||
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("",
|
||||
'$RCSfile: imapsync,v $ ',
|
||||
'$Revision: 1.241 $ ',
|
||||
'$Date: 2007/12/31 13:39:02 $ ',
|
||||
'$Revision: 1.249 $ ',
|
||||
'$Date: 2008/03/19 02:14:24 $ ',
|
||||
"\n",localhost_info(),
|
||||
" and the module Mail::IMAPClient version used here is ",
|
||||
$VERSION_IMAPClient,"\n",
|
||||
|
|
@ -510,11 +513,9 @@ $split1 ||= 1000;
|
|||
$split2 ||= 1000;
|
||||
|
||||
$host1 || missing_option("--host1") ;
|
||||
# $port1 = (defined($port1)) ? $port1 : 143;
|
||||
$port1 ||= defined $ssl1 ? 993 : 143;
|
||||
|
||||
$host2 || missing_option("--host2") ;
|
||||
# $port2 = (defined($port2)) ? $port2 : 143;
|
||||
$port2 ||= defined $ssl2 ? 993 : 143;
|
||||
|
||||
sub connect_imap {
|
||||
|
|
@ -523,7 +524,7 @@ sub connect_imap {
|
|||
$imap->Server($host);
|
||||
$imap->Port($port);
|
||||
$imap->Debug($debugimap);
|
||||
$imap->connect2()
|
||||
$imap->connect()
|
||||
or die "Can not open imap connection on [$host] : $@\n";
|
||||
}
|
||||
|
||||
|
|
@ -559,6 +560,28 @@ if ($justconnect) {
|
|||
$user1 || missing_option("--user1");
|
||||
$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)) {
|
||||
$authmech1 ||= 'LOGIN';
|
||||
$authmech2 ||= 'LOGIN';
|
||||
|
|
@ -574,8 +597,8 @@ $authmech2 = uc($authmech2);
|
|||
$authuser1 ||= $user1;
|
||||
$authuser2 ||= $user2;
|
||||
|
||||
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 $authmech1 authentication on host1\n";
|
||||
print "Will try to use $authmech2 authentication on host2\n";
|
||||
|
||||
$syncacls = (defined($syncacls)) ? $syncacls : 0;
|
||||
$foldersizes = (defined($foldersizes)) ? $foldersizes : 1;
|
||||
|
|
@ -584,6 +607,7 @@ $fastio1 = (defined($fastio1)) ? $fastio1 : 0;
|
|||
$fastio2 = (defined($fastio2)) ? $fastio2 : 0;
|
||||
|
||||
|
||||
|
||||
@useheader = ("ALL") unless (@useheader);
|
||||
|
||||
print "From imap server [$host1] port [$port1] user [$user1]\n";
|
||||
|
|
@ -670,7 +694,7 @@ sub login_imap {
|
|||
$imap->State(Mail::IMAPClient::Connected);
|
||||
}
|
||||
else {
|
||||
$imap->connect2()
|
||||
$imap->connect()
|
||||
or die "Can not open imap connection on [$host] with user [$user] : $@\n";
|
||||
}
|
||||
print "Banner : ", server_banner($imap);
|
||||
|
|
@ -696,13 +720,13 @@ sub login_imap {
|
|||
$imap->User($user);
|
||||
$imap->Authuser($authuser);
|
||||
$imap->Password($password);
|
||||
unless ($imap->login2()) {
|
||||
unless ($imap->login()) {
|
||||
print "Error login : [$host] with user [$user] auth [$authmech]: $@\n";
|
||||
die if ($authmech eq 'LOGIN');
|
||||
die if $imap->IsUnconnected();
|
||||
print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n";
|
||||
$imap->Authmechanism("");
|
||||
$imap->login2() or
|
||||
$imap->login() or
|
||||
die "Error login : [$host] with user [$user] auth [LOGIN] : $@";
|
||||
}
|
||||
print "Success login on [$host] with user [$user] auth [$authmech]\n";
|
||||
|
|
@ -1040,7 +1064,7 @@ sub foldersizes {
|
|||
$smess = $imap->message_count();
|
||||
unless ($smess == 0) {
|
||||
#$imap->Ranges(1);
|
||||
$imap->fetch_hash2("RFC822.SIZE",$hashref) or die "$@";
|
||||
$imap->fetch_hash("RFC822.SIZE",$hashref) or die "$@";
|
||||
#$imap->Ranges(0);
|
||||
#print map {$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 $to->IsUnconnected();
|
||||
|
||||
my $f_heads = $from->parse_headers2([@f_msgs],
|
||||
my $f_heads = $from->parse_headers([@f_msgs],
|
||||
@useheader)if (@f_msgs) ;
|
||||
$debug and print "Time headers: ", timenext(), " s\n";
|
||||
my $f_fir = $from->fetch_hash2("FLAGS",
|
||||
my $f_fir = $from->fetch_hash("FLAGS",
|
||||
"INTERNALDATE",
|
||||
"RFC822.SIZE") if (@f_msgs);
|
||||
$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 $to->IsUnconnected();
|
||||
|
||||
my $t_heads = $to->parse_headers2([@t_msgs],
|
||||
my $t_heads = $to->parse_headers([@t_msgs],
|
||||
@useheader) if (@t_msgs);
|
||||
$debug and print "Time headers: ", timenext(), " s\n";
|
||||
my $t_fir = $to->fetch_hash2("FLAGS",
|
||||
my $t_fir = $to->fetch_hash("FLAGS",
|
||||
"INTERNALDATE",
|
||||
"RFC822.SIZE") if (@t_msgs);
|
||||
$debug and print "Time fir : ", timenext(), " s\n";
|
||||
|
|
@ -1314,28 +1338,38 @@ FOLDER: foreach my $f_fold (@f_folders) {
|
|||
# copy
|
||||
print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
|
||||
last FOLDER if $from->IsUnconnected();
|
||||
#my $string = $from->message_string($f_msg);
|
||||
my $message_file = "tmp_imapsync_$$";
|
||||
unlink($message_file);
|
||||
$from->message_to_file($message_file, $f_msg);
|
||||
my $string = file_to_string($message_file);
|
||||
my $string;
|
||||
$string = $from->message_string($f_msg);
|
||||
#print "AAAmessage_string[$string]ZZZ\n";
|
||||
#my $message_file = "tmp_imapsync_$$";
|
||||
#$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);
|
||||
if (@regexmess) {
|
||||
foreach my $regexmess (@regexmess) {
|
||||
$debug and print "eval \$string =~ $regexmess\n";
|
||||
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
|
||||
"=" x80, "\n",
|
||||
"F message content begin next line\n",
|
||||
$string,
|
||||
"F message content ended on previous line\n";
|
||||
"F message content ended on previous line\n", "=" x 80, "\n";
|
||||
my $d = "";
|
||||
if ($syncinternaldates) {
|
||||
$d = $f_idate;
|
||||
$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 = "\"$d\"";
|
||||
$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);
|
||||
}
|
||||
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){
|
||||
warn "Couldn't append msg #$f_msg (Subject:[".
|
||||
|
|
@ -1382,7 +1419,7 @@ FOLDER: foreach my $f_fold (@f_folders) {
|
|||
else{
|
||||
$mess_skipped_dry += 1;
|
||||
}
|
||||
unlink($message_file);
|
||||
#unlink($message_file);
|
||||
next MESS;
|
||||
}
|
||||
else{
|
||||
|
|
@ -1471,6 +1508,9 @@ FOLDER: foreach my $f_fold (@f_folders) {
|
|||
|
||||
print "Time : ", timenext(), " s\n";
|
||||
}
|
||||
|
||||
|
||||
|
||||
$from->logout();
|
||||
$to->logout();
|
||||
|
||||
|
|
@ -1483,6 +1523,7 @@ stats();
|
|||
|
||||
|
||||
|
||||
|
||||
exit(1) if($error);
|
||||
|
||||
sub select_msgs {
|
||||
|
|
@ -1633,7 +1674,7 @@ sub parse_header_msg1 {
|
|||
my $head = $s_heads->{$m_uid};
|
||||
my $headnum = scalar(keys(%$head));
|
||||
$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;
|
||||
|
||||
foreach my $h (sort keys(%$head)){
|
||||
|
|
@ -1645,20 +1686,29 @@ sub parse_header_msg1 {
|
|||
# and uppercase header keywords
|
||||
# (dbmail and dovecot)
|
||||
$val =~ s/^\s*(.+)$/$1/;
|
||||
my $H = uc($h);
|
||||
|
||||
#my $H = uc($h);
|
||||
my $H = "$h: $val";
|
||||
# show stuff in debug mode
|
||||
$debug and print "${s}H $H:", $val, "\n";
|
||||
|
||||
if ($skipheader and $H =~ m/$skipheader/i) {
|
||||
$debug and print "Skipping header $h\n";
|
||||
$debug and print "Skipping header $H\n";
|
||||
next;
|
||||
}
|
||||
$headstr .= "$H:". $val;
|
||||
#$headstr .= "$H:". $val;
|
||||
$headstr .= "$H";
|
||||
}
|
||||
}
|
||||
#return unless ($headstr);
|
||||
unless ($headstr){
|
||||
print "no header so taking everything\n";
|
||||
$headstr = $imap->message_string($m_uid);
|
||||
# taking everything is too heavy,
|
||||
# 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 $flags = $s_fir->{$m_uid}->{"FLAGS"};
|
||||
|
|
@ -1791,7 +1841,8 @@ Several options are mandatory.
|
|||
it will change in future releases.
|
||||
--expunge1 : expunge messages on source 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.
|
||||
--maxsize <int> : skip messages larger than <int> bytes
|
||||
--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};
|
||||
}
|
||||
|
||||
|
||||
sub Split {
|
||||
my $self = shift;
|
||||
|
||||
if (@_) { $self->{SPLIT} = shift }
|
||||
return $self->{SPLIT};
|
||||
}
|
||||
|
||||
# From IMAPClient.pm
|
||||
sub append_file2 {
|
||||
*Mail::IMAPClient::append_file = sub {
|
||||
|
||||
my $self = shift;
|
||||
my $folder = $self->Massage(shift);
|
||||
|
|
@ -1917,7 +1965,7 @@ sub append_file2 {
|
|||
unless ($fh) {
|
||||
$self->LastError("Unable to open $file: $!\n");
|
||||
$@ = "Unable to open $file: $!" ;
|
||||
carp "unable to open $file: $!" if $^W;
|
||||
carp "unable to open $file: $!";
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
|
@ -1955,12 +2003,12 @@ sub append_file2 {
|
|||
$self->_record($count,$o); # $o is already an array ref
|
||||
($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i;
|
||||
if ($o->[DATA] =~ /^\*\s+BYE/) {
|
||||
carp $o->[DATA] if $^W;
|
||||
carp $o->[DATA];
|
||||
$self->State(Unconnected);
|
||||
$fh->close;
|
||||
return undef ;
|
||||
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
|
||||
carp $o->[DATA] if $^W;
|
||||
carp $o->[DATA];
|
||||
$fh->close;
|
||||
return undef;
|
||||
}
|
||||
|
|
@ -1980,7 +2028,7 @@ sub append_file2 {
|
|||
$fh->close;
|
||||
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";
|
||||
while (defined($text = <$fh>)) {
|
||||
$text =~ s/\x0d?\x0a/\x0d\x0a/g;
|
||||
|
|
@ -2018,12 +2066,12 @@ sub append_file2 {
|
|||
# try to grab new msg's uid from o/p
|
||||
$o->[DATA] =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1;
|
||||
if ($o->[DATA] =~ /^\*\s+BYE/) {
|
||||
carp $o->[DATA] if $^W;
|
||||
carp $o->[DATA];
|
||||
$self->State(Unconnected);
|
||||
$fh->close;
|
||||
return undef ;
|
||||
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
|
||||
carp $o->[DATA] if $^W;
|
||||
carp $o->[DATA];
|
||||
$fh->close;
|
||||
return undef;
|
||||
}
|
||||
|
|
@ -2037,10 +2085,12 @@ sub append_file2 {
|
|||
|
||||
|
||||
return defined($uid) ? $uid : $self;
|
||||
}
|
||||
};
|
||||
|
||||
# From IMAPClient.pm
|
||||
sub fetch_hash2 {
|
||||
|
||||
|
||||
|
||||
*Mail::IMAPClient::fetch_hash = sub {
|
||||
# taken from original lib,
|
||||
# just added split code.
|
||||
my $self = shift;
|
||||
|
|
@ -2110,14 +2160,13 @@ sub fetch_hash2 {
|
|||
}
|
||||
}
|
||||
return wantarray ? %$hash : $hash;
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
# From IMAPClient.pm
|
||||
|
||||
sub login2 {
|
||||
*Mail::IMAPClient::login = sub {
|
||||
my $self = shift;
|
||||
return $self->authenticate2($self->Authmechanism,$self->Authcallback)
|
||||
return $self->authenticate($self->Authmechanism,$self->Authcallback)
|
||||
if $self->{Authmechanism};
|
||||
|
||||
my $id = $self->User;
|
||||
|
|
@ -2134,17 +2183,18 @@ sub login2 {
|
|||
return undef;
|
||||
};
|
||||
return $self;
|
||||
}
|
||||
};
|
||||
|
||||
# From IMAPClient.pm
|
||||
|
||||
sub parse_headers2 {
|
||||
|
||||
|
||||
*Mail::IMAPClient::parse_headers = sub {
|
||||
my($self,$msgspec_all,@fields) = @_;
|
||||
my(%fieldmap) = map { ( lc($_),$_ ) } @fields;
|
||||
my $msg; my $string; my $field;
|
||||
|
||||
unless(ref($msgspec_all) eq 'ARRAY') {
|
||||
print "parse_headers2 want an ARRAY ref\n";
|
||||
print "parse_headers want an ARRAY ref\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
|
|
@ -2185,7 +2235,8 @@ sub parse_headers2 {
|
|||
my $h = 0; # reference to hash of current msgid, or 0 between msgs
|
||||
|
||||
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 ($self->Uid) {
|
||||
if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) {
|
||||
|
|
@ -2223,7 +2274,10 @@ sub parse_headers2 {
|
|||
my $hdr = $header;
|
||||
chomp $hdr;
|
||||
$hdr =~ s/\r$//;
|
||||
if ($hdr =~ s/^(\S+):\s*//) {
|
||||
#print "W[$hdr]\n";
|
||||
|
||||
if (defined($hdr) and $hdr =~ s/^(\S+):\s*//) {
|
||||
#print "X";
|
||||
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
|
||||
push @{$h->{$field}} , $hdr ;
|
||||
} elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) {
|
||||
|
|
@ -2252,12 +2306,10 @@ sub parse_headers2 {
|
|||
|
||||
return $headers;
|
||||
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
# From IMAPClient.pm
|
||||
|
||||
sub authenticate2 {
|
||||
*Mail::IMAPClient::authenticate = sub {
|
||||
|
||||
my $self = shift;
|
||||
my $scheme = shift;
|
||||
|
|
@ -2304,10 +2356,10 @@ sub authenticate2 {
|
|||
if ('CRAM-MD5' eq $scheme && ! $response) {
|
||||
if ($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 {
|
||||
$response = \&_cram_md5_2;
|
||||
$response = \&Mail::IMAPClient::_cram_md5;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -2343,17 +2395,21 @@ sub authenticate2 {
|
|||
$code =~ /^OK/ and $self->State(Authenticated) ;
|
||||
return $code =~ /^OK/ ? $self : undef ;
|
||||
|
||||
}
|
||||
};
|
||||
|
||||
sub _cram_md5_2 {
|
||||
|
||||
|
||||
*Mail::IMAPClient::_cram_md5 = sub {
|
||||
my ($code, $client) = @_;
|
||||
my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($code),
|
||||
$client->Password());
|
||||
return MIME::Base64::encode($client->User() . " $hmac", "");
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
sub connect2 {
|
||||
|
||||
|
||||
*Mail::IMAPClient::connect = sub {
|
||||
my $self = shift;
|
||||
|
||||
$self->Port(143)
|
||||
|
|
@ -2382,15 +2438,16 @@ sub connect2 {
|
|||
#print "i03\n";
|
||||
$self->Socket($sock);
|
||||
$self->State(Connected);
|
||||
|
||||
#print "i04\n";
|
||||
$sock->autoflush(1) ;
|
||||
|
||||
my ($code, $output);
|
||||
$output = "";
|
||||
|
||||
#print "i05\n";
|
||||
until ( $code ) {
|
||||
|
||||
$output = $self->_read_line or return undef;
|
||||
#print "i06\n";
|
||||
for my $o (@$output) {
|
||||
$self->_debug("Connect: Received this from readline: " .
|
||||
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};
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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$
|
||||
|
||||
File diff suppressed because it is too large
Load diff
35
t/02_append_string
Executable file
35
t/02_append_string
Executable 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
53
t/03_message_to_file
Executable 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
91
t/03_message_to_file.dump
Normal 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
21
t/04_parse_headers
Executable 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
26
t/05_parse_headers_ssl
Executable 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
26
t/06_parse_headers_ssl_titi
Executable 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();
|
||||
|
||||
|
||||
90
tests.sh
90
tests.sh
|
|
@ -1,6 +1,6 @@
|
|||
#!/bin/sh
|
||||
|
||||
# $Id: tests.sh,v 1.69 2007/12/31 13:38:37 gilles Exp gilles $
|
||||
# $Id: tests.sh,v 1.71 2008/03/19 02:13:55 gilles Exp $
|
||||
|
||||
#### Shell pragmas
|
||||
|
||||
|
|
@ -124,7 +124,7 @@ locallocal() {
|
|||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
--passfile2 /var/tmp/secret.titi \
|
||||
--passfile2 /var/tmp/secret.titi
|
||||
else
|
||||
:
|
||||
fi
|
||||
|
|
@ -215,7 +215,7 @@ ll_internaldate() {
|
|||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
sendtestmessage
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -233,7 +233,7 @@ ll_internaldate() {
|
|||
ll_folder_rev() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 titi@est.belle \
|
||||
--passfile1 /var/tmp/secret.titi \
|
||||
--host2 localhost --user2 tata@est.belle \
|
||||
|
|
@ -248,7 +248,7 @@ ll_subscribed()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -264,7 +264,7 @@ ll_subscribe()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -279,7 +279,7 @@ ll_justconnect()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host2 localhost \
|
||||
--host1 localhost \
|
||||
--justconnect
|
||||
|
|
@ -292,7 +292,7 @@ ll_justfoldersizes()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -309,7 +309,7 @@ ll_authmd5()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -324,7 +324,7 @@ ll_noauthmd5()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -341,7 +341,7 @@ ll_maxage()
|
|||
sendtestmessage
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -359,7 +359,7 @@ ll_maxsize()
|
|||
sendtestmessage
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -375,7 +375,7 @@ ll_skipsize()
|
|||
sendtestmessage
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -391,7 +391,7 @@ ll_skipheader()
|
|||
sendtestmessage
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -409,7 +409,7 @@ ll_include()
|
|||
sendtestmessage
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -425,7 +425,7 @@ ll_exclude()
|
|||
sendtestmessage
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -443,7 +443,7 @@ ll_regextrans2()
|
|||
sendtestmessage
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -458,7 +458,7 @@ ll_sep2()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -472,7 +472,7 @@ ll_sep2()
|
|||
|
||||
ll_bad_login()
|
||||
{
|
||||
! ./imapsync \
|
||||
! $CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 toto@est.belle \
|
||||
--passfile1 /var/tmp/secret1 \
|
||||
--host2 localhost --user2 notiti@est.belle \
|
||||
|
|
@ -482,7 +482,7 @@ ll_bad_login()
|
|||
|
||||
ll_bad_host()
|
||||
{
|
||||
! ./imapsync \
|
||||
! $CMD_PERL ./imapsync \
|
||||
--host1 badhost --user1 toto@est.belle \
|
||||
--passfile1 /var/tmp/secret1 \
|
||||
--host2 badhost --user2 titi@est.belle \
|
||||
|
|
@ -492,7 +492,7 @@ ll_bad_host()
|
|||
|
||||
ll_bad_host_ssl()
|
||||
{
|
||||
! ./imapsync \
|
||||
! $CMD_PERL ./imapsync \
|
||||
--host1 badhost --user1 toto@est.belle \
|
||||
--passfile1 /var/tmp/secret1 \
|
||||
--host2 badhost --user2 titi@est.belle \
|
||||
|
|
@ -505,7 +505,7 @@ ll_justfoldersizes()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -522,7 +522,7 @@ ll_useheader()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -541,7 +541,7 @@ ll_regexmess()
|
|||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -556,12 +556,31 @@ ll_regexmess()
|
|||
fi
|
||||
}
|
||||
|
||||
ll_regexmess_scwchu()
|
||||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
$CMD_PERL ./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.scwchu \
|
||||
--regexmess 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nReceived: From; $2}gxms' \
|
||||
--skipsize --skipheader 'Received: From;' \
|
||||
--debug
|
||||
echo 'rm /home/vmail/titi/.scwchu/cur/*'
|
||||
else
|
||||
:
|
||||
fi
|
||||
}
|
||||
|
||||
|
||||
ll_flags()
|
||||
{
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -579,7 +598,7 @@ ll_regex_flag()
|
|||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -597,7 +616,7 @@ ll_regex_flag()
|
|||
ll_ssl() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -611,7 +630,7 @@ ll_ssl() {
|
|||
ll_authmech_PLAIN() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -626,7 +645,7 @@ ll_authmech_PLAIN() {
|
|||
ll_authuser() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -644,7 +663,7 @@ ll_authuser() {
|
|||
ll_authmech_LOGIN() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -659,7 +678,7 @@ ll_authmech_LOGIN() {
|
|||
ll_authmech_CRAMMD5() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -674,7 +693,7 @@ ll_authmech_CRAMMD5() {
|
|||
ll_delete2() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -689,7 +708,7 @@ ll_delete2() {
|
|||
ll_bigmail() {
|
||||
if test X`hostname` = X"plume"; then
|
||||
echo3 Here is plume
|
||||
./imapsync \
|
||||
$CMD_PERL ./imapsync \
|
||||
--host1 localhost --user1 tata@est.belle \
|
||||
--passfile1 /var/tmp/secret.tata \
|
||||
--host2 localhost --user2 titi@est.belle \
|
||||
|
|
@ -716,7 +735,7 @@ msw() {
|
|||
big_transfert()
|
||||
{
|
||||
date1=`date`
|
||||
{ ./imapsync \
|
||||
{ $CMD_PERL ./imapsync \
|
||||
--host1 louloutte --user1 gilles \
|
||||
--passfile1 /var/tmp/secret \
|
||||
--host2 plume --user2 tete@est.belle \
|
||||
|
|
@ -733,7 +752,7 @@ big_transfert()
|
|||
big_transfert_sizes_only()
|
||||
{
|
||||
date1=`date`
|
||||
{ ./imapsync \
|
||||
{ $CMD_PERL ./imapsync \
|
||||
--host1 louloutte --user1 gilles \
|
||||
--passfile1 /var/tmp/secret \
|
||||
--host2 plume --user2 tete@est.belle \
|
||||
|
|
@ -966,6 +985,7 @@ test $# -eq 0 && run_tests \
|
|||
ll_justfoldersizes \
|
||||
ll_useheader \
|
||||
ll_regexmess \
|
||||
ll_regexmess_scwchu \
|
||||
ll_flags \
|
||||
ll_regex_flag \
|
||||
ll_ssl \
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue